delphi同时控制多台打印机

unit uni_2;

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.