在quickrep中打印使用指定打印机如何实现!(100分)

  • 主题发起人 主题发起人 fwqdelphi
  • 开始时间 开始时间
F

fwqdelphi

Unregistered / Unconfirmed
GUEST, unregistred user!
我已经检索了以前的问题同样也有人提问,但是小弟比较愚笨,按照大下门的方法,要么
觉得很简单,没有办法实验,要么实验时编译错误。在使用
use printers
var
prtcount :Tstrings;
i:integer;
...
prtcount:=printer.Printers;
for i:=0 to prtcount.Count -1do
begin
if prtcount.Strings='指定打印机' then
break;
end;
quickrep.printer.printerindex :=i;// 此句编译通过,执行时报无效访问地址,程序退出!
quickrep.print;
求教各位如何修改,或用其它办法!感激不尽!!!!100大分相送!
 
这几个函数完全能解决你的问题。
{-----------------------------}
procedure GetPrinterNames(pnl:TStringList);
var
buffer: TPrinterBuffer;
currPos: integer;
printerName: string;
begin
pnl.Clear;
if GetProfileString(PChar('PrinterPorts'), nil, '', buffer, MAXPRINTERBUFFER) > 0 then
begin
currPos := 0;
while (true)do
begin
printerName := ParseNames(buffer, currPos);
if printerName <> '' then
pnl.Add(printerName)
else
break;
end;
end;
end;

function ParseNames(const namebuffer: TPrinterBuffer;var startPos: integer): string;
var
i, j, NameLength: integer;
str: string;
begin
result := '';
if (startPos > High(namebuffer)) or (namebuffer[startPos] = Chr(0)) then
exit;
for i := startPos to High(namebuffer)do
begin
if namebuffer = Chr(0) then
begin
nameLength := i - startPos;
SetLength(str, nameLength);
for j := 0 to nameLength - 1do
str[j+1] := namebuffer[startPos + j];
result := str;
startPos := i + 1;
break;
end;
end;
end;

function SetPrinter(const PrinterName: String): boolean;
var
s2 : string;
dum1 : Pchar;
xx, qq : integer;
const
cs1 : pchar = 'Windows';
cs2 : pchar = 'Device';
cs3 : pchar = 'Devices';
cs4 : pchar = #0;
begin
xx := 254;
GetMem( dum1, xx);
Result := False;
try
qq := GetProfileString( cs3, pchar( printerName ), #0, dum1, xx);
if (qq > 0) and (trim( strpas( dum1 )) <> '') then
begin
s2 := PrinterName + ',' + strpas( dum1 );
while GetProfileString( cs1, cs2, cs4, dum1, xx) > 0do
WriteProfileString( cs1, cs2, #0);
WriteProfileString( cs1, cs2, pchar( s2 ));
case Win32Platform of
VER_PLATFORM_WIN32_NT :
// SendMessage( HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(cs1));
// VER_PLATFORM_WIN32_WINDOWS :
// SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0, LongInt(cs1));
end;
Result := True;
end;
finally
FreeMem( dum1 );
end;
end;

function GetDefaultPrinter: string;
var
ResStr: array[0..255] of Char;
begin
GetProfileString('Windows', 'device', '', ResStr, 255);
Result := leftstr(trim(StrPas(ResStr)),pos(',',trim(StrPas(ResStr)))-1);
end;
{----------------------------------}
 
测试元代吗:
一个窗体,一个listbox两个钮。演示取得pinger列表,取得当前printer,设置当前printer为特定名字的那个打印机。
Uunit umain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, StrUtils;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
ListBox1: TListBox;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
PrinterNames:TStringList;
Form1: TForm1;
implementation
uses hxbox;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
GetPrinterNames(PrinterNames);
Listbox1.Items.AddStrings(PrinterNames);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
x : integer;
begin
try
for x := 0 to PrinterNames.Count -1do
begin
If ListBox1.Selected[x] then
begin
if (SetPrinter(ListBox1.Items.Strings[x]))
then
label1.Caption := 'Printer set to ' + ListBox1.Items.Strings[x]
else
label1.Caption := 'Printer not set';
end;
end;
except
label1.Caption := 'An error occured while setting the printer';
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Label1.Caption:='Current Default Printer is: '+GetDefaultPrinter;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
PrinterNames:=TStringList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
PrinterNames.Free;
regesterwindowmessage
end;

end.
 
后退
顶部