您所在位置：主题：同时控制多台打印机
danlong
[专家分：770] 发布于 2003-10-14 12:30:00
■ 同时控制多台打印机
————————————————以下为程序代码—————————————
unit unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
ListBox3: TListBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure ListBox2Click(Sender: TObject);
procedure ListBox3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure GetTheListOfPrinters;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
type
PdcArray = ^TdcArray;
TdcArray = array[0..0] of hdc;
procedure TForm1.GetTheListOfPrinters;
var
p : pChar;
p2 : pChar;
i : integer;
sDriver : string;
sPort : string;
begin
{从win.ini文件中得到打印机名称列表；想一想，为什么是32767}
GetMem(p, 32767);
p2 := p;
{列表是字符串格式的，使用空字符隔离，用两个空字符表示列表的结束}
if GetProfileString('devices', nil, '',p, 32767) <> 0 then begin
{loop though the null terminated strings. We know we}
{have reached the end when p2 equals a null character}
while p2^ <> #0 do
begin
ListBox1.Items.Add(StrPas(p2));
{跳过空字符得到下一个字符串}
p2 := @p2[lStrLen(p2) + 1];
end;
end;
GetMem(p2, 32767);
{得到每一个打印机的驱动和端口名称}
for i := 0 to (ListBox1.Items.Count - 1) do begin
StrPCopy(p2, ListBox1.Items[i]);
if GetProfileString('devices', p2, '',p, 32767) <> 0 then begin
sDriver := StrPas(p);
sPort := sDriver;
{端口的字符串前后各有个逗号，前面的逗号前是驱动名称}
Delete(sDriver, Pos(',', sDriver), Length(sDriver));
Delete(sPort, 1, Pos(',', sPort));
ListBox2.Items.Add(sDriver);
ListBox3.Items.Add(sPort);
end;
end;
FreeMem(p2, 32767);
FreeMem(p, 32767);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
GetTheListOfPrinters;
{允许用户多选打印机}
ListBox1.MultiSelect := true;
ListBox2.MultiSelect := true;
ListBox3.MultiSelect := true;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
i : integer;
begin
{让ListBoxs 2 and 3 的选择同 Listbox1相同}
for i := 0 to ListBox1.Items.Count - 1 do begin
ListBox2.Selected[i] := ListBox1.Selected[i];
ListBox3.Selected[i] := ListBox1.Selected[i]
end;
end;
procedure TForm1.ListBox2Click(Sender: TObject);
var
i : integer;
begin
{让ListBoxs 1 and 3 的选择同 Listbox2相同}
for i := 0 to ListBox2.Items.Count - 1 do begin
ListBox1.Selected[i] := ListBox2.Selected[i];
ListBox3.Selected[i] := ListBox2.Selected[i]
end;
end;
procedure TForm1.ListBox3Click(Sender: TObject);
var
i : integer;
begin
{让ListBoxs 1 and 2 的选择同 Listbox3相同}
for i := 0 to ListBox3.Items.Count - 1 do begin
ListBox1.Selected[i] := ListBox3.Selected[i];
ListBox2.Selected[i] := ListBox3.Selected[i]
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
dcs : PdcArray; { hdc数组（指针）}
dcsCount : integer; {hdc数量}
dc : hdc; {测试hdc}
i : integer;
pPrinter : pChar; {指向打印机名称}
pDriver : pChar; {指向打印机驱动文件名}
pPort : pChar; {指向打印机端口}
DocInfo: TDocInfo; {打印的信息}
{$IFDEF WIN32}
osv : TOSVERSIONINFO; {测试是否在Windows NT下}
{$ENDIF}
begin
{如果没有选择打印机就终止}
if ListBox1.SelCount = 0 then exit;
{如果DELPHI的Range Checking 是打开的记得要把它关上}
{这是为了允许跳过 dcs[i] 数组的空元素，而没有编译错误或者运行时错误}
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}
{为dcs分配空间}
GetMem(dcs, sizeof(hdc) * ListBox1.SelCount);
dcsCount := 0;
{得到选择的每一个打印机并为每个打印机分配设备句柄}
for i := 0 to (ListBox1.Items.Count - 1) do begin
{通过 list box 得到被选择的打印机}
if ListBox1.Selected[i] then begin
GetMem(pPrinter, Length(ListBox1.Items[i]) + 1);
GetMem(pDriver, Length(ListBox2.Items[i]) + 1);
GetMem(pPort, Length(ListBox3.Items[i]) + 1);
StrPCopy(pPrinter, ListBox1.Items[i]);
StrPCopy(pDriver, ListBox2.Items[i]);
StrPCopy(pPort, ListBox3.Items[i]);
{在win32和winNT分配设备句柄CreateDc 的参数是不同的}
GetVersionEx(osv);
if osv.dwPlatformId = VER_PLATFORM_WIN32_NT then
dc := CreateDc(pDriver, pPrinter, nil, nil) else
dc := CreateDc(nil, pPrinter, nil, nil);
FreeMem(pPrinter, Length(ListBox1.Items[i]));
FreeMem(pDriver, Length(ListBox2.Items[i]));
FreeMem(pPort, Length(ListBox3.Items[i]));
{如果设备dc存在，那么保存它 }
if dc <> 0 then begin
dcs^[dcsCount] := dc;
inc(dcsCOunt);
end;
end;
end;
{现在打印试试吧}
if dcsCount > 0 then begin
{为每个打印机分配一个文档}
GetMem(DocInfo.lpszDocName, 32);
for i := 0 to (dcsCount - 1) do begin
DocInfo.cbSize := SizeOf(DocInfo);
StrPCopy(DocInfo.lpszDocName, 'Test Doc' + IntToStr(i));
StartDoc(dcs^[i], DocInfo);
end;
FreeMem(DocInfo.lpszDocName, 32);
{准备让每个打印机打印一页}
for i := 0 to (dcsCount - 1) do
StartPage(dcs^[i]);
{开始打印‘这是打印测试！’}
for i := 0 to (dcsCount - 1) do
TextOut(dcs^[i], 200, 200, '这是打印测试！', 4);
{结束一页}
for i := 0 to (dcsCount - 1) do
EndPage(dcs^[i]);
{退出打印}
for i := 0 to (dcsCount - 1) do
EndDoc(dcs^[i]);
{删除打印机}
for i := 0 to (dcsCount - 1) do
DeleteDc(dcs^[i]);
end;
FreeMem(dcs, sizeof(hdc) * ListBox1.SelCount);
{如果DELPHI的Range Checking 开始时是打开的，现在把它恢复}
{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
end;
end.
————————————————以下为程序代码—————————————
unit unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
ListBox3: TListBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure ListBox2Click(Sender: TObject);
procedure ListBox3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure GetTheListOfPrinters;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
type
PdcArray = ^TdcArray;
TdcArray = array[0..0] of hdc;
procedure TForm1.GetTheListOfPrinters;
var
p : pChar;
p2 : pChar;
i : integer;
sDriver : string;
sPort : string;
begin
{从win.ini文件中得到打印机名称列表；想一想，为什么是32767}
GetMem(p, 32767);
p2 := p;
{列表是字符串格式的，使用空字符隔离，用两个空字符表示列表的结束}
if GetProfileString('devices', nil, '',p, 32767) <> 0 then begin
{loop though the null terminated strings. We know we}
{have reached the end when p2 equals a null character}
while p2^ <> #0 do
begin
ListBox1.Items.Add(StrPas(p2));
{跳过空字符得到下一个字符串}
p2 := @p2[lStrLen(p2) + 1];
end;
end;
GetMem(p2, 32767);
{得到每一个打印机的驱动和端口名称}
for i := 0 to (ListBox1.Items.Count - 1) do begin
StrPCopy(p2, ListBox1.Items[i]);
if GetProfileString('devices', p2, '',p, 32767) <> 0 then begin
sDriver := StrPas(p);
sPort := sDriver;
{端口的字符串前后各有个逗号，前面的逗号前是驱动名称}
Delete(sDriver, Pos(',', sDriver), Length(sDriver));
Delete(sPort, 1, Pos(',', sPort));
ListBox2.Items.Add(sDriver);
ListBox3.Items.Add(sPort);
end;
end;
FreeMem(p2, 32767);
FreeMem(p, 32767);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
GetTheListOfPrinters;
{允许用户多选打印机}
ListBox1.MultiSelect := true;
ListBox2.MultiSelect := true;
ListBox3.MultiSelect := true;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
i : integer;
begin
{让ListBoxs 2 and 3 的选择同 Listbox1相同}
for i := 0 to ListBox1.Items.Count - 1 do begin
ListBox2.Selected[i] := ListBox1.Selected[i];
ListBox3.Selected[i] := ListBox1.Selected[i]
end;
end;
procedure TForm1.ListBox2Click(Sender: TObject);
var
i : integer;
begin
{让ListBoxs 1 and 3 的选择同 Listbox2相同}
for i := 0 to ListBox2.Items.Count - 1 do begin
ListBox1.Selected[i] := ListBox2.Selected[i];
ListBox3.Selected[i] := ListBox2.Selected[i]
end;
end;
procedure TForm1.ListBox3Click(Sender: TObject);
var
i : integer;
begin
{让ListBoxs 1 and 2 的选择同 Listbox3相同}
for i := 0 to ListBox3.Items.Count - 1 do begin
ListBox1.Selected[i] := ListBox3.Selected[i];
ListBox2.Selected[i] := ListBox3.Selected[i]
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
dcs : PdcArray; { hdc数组（指针）}
dcsCount : integer; {hdc数量}
dc : hdc; {测试hdc}
i : integer;
pPrinter : pChar; {指向打印机名称}
pDriver : pChar; {指向打印机驱动文件名}
pPort : pChar; {指向打印机端口}
DocInfo: TDocInfo; {打印的信息}
{$IFDEF WIN32}
osv : TOSVERSIONINFO; {测试是否在Windows NT下}
{$ENDIF}
begin
{如果没有选择打印机就终止}
if ListBox1.SelCount = 0 then exit;
{如果DELPHI的Range Checking 是打开的记得要把它关上}
{这是为了允许跳过 dcs[i] 数组的空元素，而没有编译错误或者运行时错误}
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}
{为dcs分配空间}
GetMem(dcs, sizeof(hdc) * ListBox1.SelCount);
dcsCount := 0;
{得到选择的每一个打印机并为每个打印机分配设备句柄}
for i := 0 to (ListBox1.Items.Count - 1) do begin
{通过 list box 得到被选择的打印机}
if ListBox1.Selected[i] then begin
GetMem(pPrinter, Length(ListBox1.Items[i]) + 1);
GetMem(pDriver, Length(ListBox2.Items[i]) + 1);
GetMem(pPort, Length(ListBox3.Items[i]) + 1);
StrPCopy(pPrinter, ListBox1.Items[i]);
StrPCopy(pDriver, ListBox2.Items[i]);
StrPCopy(pPort, ListBox3.Items[i]);
{在win32和winNT分配设备句柄CreateDc 的参数是不同的}
GetVersionEx(osv);
if osv.dwPlatformId = VER_PLATFORM_WIN32_NT then
dc := CreateDc(pDriver, pPrinter, nil, nil) else
dc := CreateDc(nil, pPrinter, nil, nil);
FreeMem(pPrinter, Length(ListBox1.Items[i]));
FreeMem(pDriver, Length(ListBox2.Items[i]));
FreeMem(pPort, Length(ListBox3.Items[i]));
{如果设备dc存在，那么保存它 }
if dc <> 0 then begin
dcs^[dcsCount] := dc;
inc(dcsCOunt);
end;
end;
end;
{现在打印试试吧}
if dcsCount > 0 then begin
{为每个打印机分配一个文档}
GetMem(DocInfo.lpszDocName, 32);
for i := 0 to (dcsCount - 1) do begin
DocInfo.cbSize := SizeOf(DocInfo);
StrPCopy(DocInfo.lpszDocName, 'Test Doc' + IntToStr(i));
StartDoc(dcs^[i], DocInfo);
end;
FreeMem(DocInfo.lpszDocName, 32);
{准备让每个打印机打印一页}
for i := 0 to (dcsCount - 1) do
StartPage(dcs^[i]);
{开始打印‘这是打印测试！’}
for i := 0 to (dcsCount - 1) do
TextOut(dcs^[i], 200, 200, '这是打印测试！', 4);
{结束一页}
for i := 0 to (dcsCount - 1) do
EndPage(dcs^[i]);
{退出打印}
for i := 0 to (dcsCount - 1) do
EndDoc(dcs^[i]);
{删除打印机}
for i := 0 to (dcsCount - 1) do
DeleteDc(dcs^[i]);
end;
FreeMem(dcs, sizeof(hdc) * ListBox1.SelCount);
{如果DELPHI的Range Checking 开始时是打开的，现在把它恢复}
{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
end;
end.