如何取得当前打印机所用的纸张Form名称?

Question

如下可取得印表机所有纸张格式名称:procedure GetPrinterPapers(vStrs: TStrings);
var
  Device, Driver, Port: array[0..255] of Char;
  hDevMode: THandle;
  j, numPaperformats: Integer;
  pPaperFormats: PPapernameArray;
  vPrinter: TPrinter;
begin
  vPrinter := TPrinter.Create;
  vPrinter.PrinterIndex := -1;
  vPrinter.GetPrinter(Device, Driver, Port, hDevmode);
  numPaperformats :=
    WinSpool.DeviceCapabilities(Device, Port, DC_PAPERNAMES, nil, nil);
  if numPaperformats > 0 then
  begin
    GetMem(pPaperformats,
      numPaperformats * Sizeof(TPapername));
    vStrs.clear;
    try
      WinSpool.DeviceCapabilities
        (Device, Port, DC_PAPERNAMES,
        Pchar(pPaperFormats), nil);
      for j := 1 to numPaperformats do
        vStrs.add(pPaperformats^[j]);
    finally
      FreeMem(pPaperformats);
    end;
  end;
end;
但我该如何取得当前印表机选的纸张格式名称是A4、B5、自订或其它的自订名例如"测试" ?
目前只有想到遍历每一种纸张取得其大小，如果和当前印表机纸张大小符合即可能是当前选中项目，
但这有一个问题就是假使有2种自定义纸张叫"自定义1"、"自定义2"，且它们的纸张大小都设成相同，
此时便无法判断当前选择的是哪一个了?
是否有其他方式或API可以直接取得的呢?谢谢

Answer 1

或是请问如何跳过PrintDialog的画面
直接开启印表机驱动所提供的设定页面? 
例如Foxit Reader它的列印介面就不是用Windows的Dialog
进去后点Properties可以显示印表机驱动的设定页
那个Properties按钮所做的事如何实现?

Answer 2

首先，“假使有2种自定义纸张叫"自定义1"、"自定义2"，且它们的纸张大小都设成相同”，既然相同了，选哪一个都无所谓！
其次，关于打印方面的api函数，有位仁兄的博客中，列出十分详尽：http://www.02t.cn/article.asp?id=191

Answer 3

因为用户若透过printerdialog改变了纸张名称
在我的应用程序中也要做对应
如果它选中自定义2
但我的程序上显示自定义1
那也显得奇怪因此才想找到取得当前所使用的纸张定义名称
谢谢

Answer 4

var
  DeviceMode: PDeviceMode;
  ADeviceMode: THandle;
  ADevice, ADriver, APort: PAnsiChar;
begin
  ADevice := StrAlloc(255);
  ADriver := StrAlloc(255);
  APort := StrAlloc(255);
  Printer.GetPrinter(ADevice, ADriver, APort, ADeviceMode);
  if ADeviceMode <> 0 then
    DeviceMode := GlobalLock(ADeviceMode);
 //DeviceMode.dmFormName就是纸张名称
end;
//如果以上方法获取不到DeviceMode也可以用下面方法
var
    HPrt:THandle;
    dwNeeded:Cardinal;
    PrtInfo2:PPrinterInfo2;
begin
    OpenPrinter(pchar(Printer.Printers[Printer.PrinterIndex]), HPrt, nil);//第一个参数是打印机名称
    GetPrinter(HPrt, 2, PrtInfo2, 0, @dwNeeded); //获取打印机
    ReAllocMem(PrtInfo2, dwNeeded);
    GetPrinter(HPrt, 2, PrtInfo2, dwNeeded, @dwNeeded);
    //PrtInfo2.pDevMode.dmFormName：纸张名称
end;

Answer 5

//打印首选项对话框
var
ADevice,ADriver, APort:Array[0..255] of char;
PDMode:     PDEVMODE;
DeviceHandle,hPrinter:THandle;
begin
  Printer.GetPrinter(ADevice,ADriver, APort, DeviceHandle);
  pDMode := GlobalLock(DeviceHandle);
  WinSpool.OpenPrinter(ADevice,hPrinter,nil);
  DocumentProperties(Self.Handle,hPrinter,ADevice,pDMode^,pDMode^,DM_IN_PROMPT or DM_OUT_BUFFER or DM_IN_BUFFER);
  ClosePrinter(hPrinter);
end;

Answer 6

最后漏了句
GlobalUnlock(DeviceHandle);另Delphi7的Printers单元有个小BUG，就是更改了打印机后DEVMODE结构没有更新需要自己来操作Printer.PrinterIndex:=X;  //选择打印机
Printer.GetPrinter(ADevice,ADriver, APort, DeviceHandle); //获取打印机名/端口 
Printer.SetPrinter(ADevice,ADriver, APort, 0); //最后个参数为0表示从系统获取默认打印机DEVMODE结构

Answer 7

请问为什么用了
//打印首选项对话框
var
ADevice,ADriver, APort:Array[0..255] of char;
PDMode: PDEVMODE;
DeviceHandle,hPrinter:THandle;
begin
  Printer.GetPrinter(ADevice,ADriver, APort, DeviceHandle);
  pDMode := GlobalLock(DeviceHandle);
  WinSpool.OpenPrinter(ADevice,hPrinter,nil);
  DocumentProperties(Self.Handle,hPrinter,ADevice,pDMode^,pDMode^,DM_IN_PROMPT or DM_OUT_BUFFER or DM_IN_BUFFER);
  ClosePrinter(hPrinter);
end;之后这个就取不到FormName了
var
  DeviceMode: PDeviceMode;
  ADeviceMode: THandle;
  ADevice, ADriver, APort: PAnsiChar;
begin
  ADevice := StrAlloc(255);
  ADriver := StrAlloc(255);
  APort := StrAlloc(255);
  Printer.GetPrinter(ADevice, ADriver, APort, ADeviceMode);
  if ADeviceMode <> 0 then
    DeviceMode := GlobalLock(ADeviceMode);
 //DeviceMode.dmFormName就是纸张名称
end;谢谢

Answer 8

好像是加了这两句后
Printer.GetPrinter(ADevice,ADriver, APort, DeviceHandle); //获取打印机名/端口 
Printer.SetPrinter(ADevice,ADriver, APort, 0); //最后个参数为0表示从系统获取默认打印机DEVMODE结构
才能够取到预设的FormName
但有一台针式印表机的仍不能取得(有取到pDeviceMode)
除非先开启PrintDialog.Execute后
才能取得它的FormName
不知道为什么?

Answer 9

QQ也就是说如果在SetPrinterIndex的最后加上
Printer.GetPrinter(ADevice,ADriver, APort, DeviceHandle); //获取打印机名/端口  
Printer.SetPrinter(ADevice,ADriver, APort, 0); //最后个参数为0表示从系统获取默认打印机DEVMODE结构
直接取String( Printer.DevMode.dmFormName)就是纸张Form名了
但其它Printer都没问题
只有那台连续纸张表机的dmFormName每一byte都是#0
令人纳闷的是
PrintDialog显示的FormName却是正确的
难道Delphi 7 的Printer.pas在取devMode的时候是有bug的?
还是有其它取FormName的办法呢?(目前所知只有Printer.GetPrinter)谢谢

Answer 10

我放弃了… 后来改成背景自动点击PrinterSetupDialog来获取及设定FormName…><"

Answer 11

uses Printers, WinSpool;type
  TPointWord = packed record
    X: LongWord;
    Y: LongWord;
  end;  TPaperName = array[0..63] of Char;
  PPaperInfo = ^TPaperInfo;
  TPaperInfo = packed record
    papername: TPapername; { display name of the paper }
    paperID: Smallint; { DMPAPER_* ID }
    papersize: TPoint; { Size in 0.1 mm }
  end;
  TPaperInfos = array of TPaperInfo;
  TPaperSizes = array of TPoint;
  TPrinterResolutions= array of TPointWord;procedure GetPapernames(sl: TStrings; index: Integer);
type
  TPaperNameArray = array[1..High(Integer) div Sizeof(TPaperName)] of TPaperName;
  PPapernameArray = ^TPaperNameArray;
  TPaperArray = array[1..High(Integer) div Sizeof(Word)] of Word;
  PPaperArray = ^TPaperArray;
var
  Device, Driver, Port: array[0..255] of Char;
  hDevMode: THandle;
  i, numPaperNames, numPapers, temp: Integer;
  pPaperNames: PPapernameArray;
  pPapers: PPaperArray;
begin
  Assert(Assigned(sl));
  Printer.PrinterIndex := index;
  Printer.GetPrinter(Device, Driver, Port, hDevmode);
  numPaperNames := WinSpool.DeviceCapabilities(Device, Port, DC_PAPERNAMES, nil, nil);
  numPapers := WinSpool.DeviceCapabilities(Device, Port, DC_PAPERS, nil, nil);
  if numPapers <> numPaperNames then
  begin
    raise Exception.Create('DeviceCapabilities reports different number of papers and '+ ' paper names!');
  end;
  if numPaperNames > 0 then
  begin
    GetMem(pPaperNames, numPaperNames * Sizeof(TPapername));
    GetMem(pPapers, numPapers * Sizeof(Word));
    try
      WinSpool.DeviceCapabilities(Device, Port, DC_PAPERNAMES, Pchar(pPaperNames), nil);
      WinSpool.DeviceCapabilities(Device, Port, DC_PAPERS, Pchar(pPapers), nil);
      sl.clear;
      for i := 1 to numPaperNames do
      begin
        temp := pPapers^[i];
        sl.addObject(pPaperNames^[i], TObject(temp));
      end;
    finally
      FreeMem(pPaperNames);
      if pPapers <> nil then
        FreeMem(pPapers);
    end;
  end;
end;procedure GetPapersizes(var sizes: TPaperSizes; index: Integer);
var
  Device, Driver, Port: array[0..255] of Char;
  hDevMode: THandle;
  numPapers: Integer;
begin
  Printer.PrinterIndex := index;
  Printer.GetPrinter(Device, Driver, Port, hDevmode);
  numPapers := WinSpool.DeviceCapabilities(Device, Port, DC_PAPERS, nil, nil);
  SetLength(sizes, numPapers);
  if numPapers > 0 then
    WinSpool.DeviceCapabilities(Device, Port, DC_PAPERSIZE, PChar(@sizes[0]), nil);
end;procedure GetPaperInfo(var infos: TPaperInfos; index: Integer);
var
  sizes: TPaperSizes;
  sl: TStringlist;
  i: Integer;
begin
  sl := Tstringlist.Create;
  try
    GetPaperNames(sl, index);
    GetPaperSizes(sizes, index);
    Assert(sl.count = Length(sizes));
    SetLength(infos, sl.count);
    for i := 0 to sl.count - 1 do
    begin
      StrPLCopy(infos[i].papername, sl[i], Sizeof(TPapername) - 1);
      infos[i].paperID := LoWord(Longword(sl.Objects[i]));
      infos[i].papersize := sizes[i];
    end;
  finally
    sl.Free;
  end;
end;//实现过程
var
 ADevice,ADriver, APort:array[0..255] of char;
 infos: TPaperInfos;
 DeviceHandle,hPrinter:THandle;
 PDMode:     PDEVMODE;
 P:Pchar;
 i,iIndex:integer;
begin
 GetPaperInfo(infos, Printer.PrinterIndex);  //获取纸张列表
 Printer.GetPrinter(ADevice,ADriver, APort, DeviceHandle); //取打印机数据
 pDMode := GlobalLock(DeviceHandle);
 ListBox1.Items.Clear;
 for i:=low(infos) to high(infos) do begin
    GetMem(P, sizeof(TPaperInfo));
    move(infos[i], p^, sizeof(TPaperInfo));
    iIndex:=ListBox1.Items.AddObject(infos[i].papername, Tobject(P));
    if pDMode^.dmPaperSize=infos[i].paperID then begin //关键就是对比dmPaperSize参数
      ListBox1.ItemIndex := iIndex
    end;
 end;
 GlobalUnlock(DeviceHandle);
end;