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

[dkjfsoman]

如下可取得印表机所有纸张格式名称:

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可以直接取得的呢?谢谢

[dkjfsoman]

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

[广州佬]

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

[dkjfsoman]

因为用户若透过printerdialog改变了纸张名称
在我的应用程序中也要做对应
如果它选中自定义2
但我的程序上显示自定义1
那也显得奇怪

因此才想找到取得当前所使用的纸张定义名称
谢谢

[浩南_哥]

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;

[SonicX]

//打印首选项对话框
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;

[dkjfsoman]

请问为什么用了
//打印首选项对话框
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;

谢谢

[SonicX]

最后漏了句
GlobalUnlock(DeviceHandle);

另Delphi7的Printers单元有个小BUG，就是更改了打印机后DEVMODE结构没有更新需要自己来操作

Printer.PrinterIndex:=X; //选择打印机
Printer.GetPrinter(ADevice,ADriver, APort, DeviceHandle); //获取打印机名/端口
Printer.SetPrinter(ADevice,ADriver, APort, 0); //最后个参数为0表示从系统获取默认打印机DEVMODE结构

[dkjfsoman]

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

[dkjfsoman]

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)

谢谢

[浩南_哥]

[Quote=引用 8 楼 dkjfsoman 的回复:]

好像是加了这两句后
Printer.GetPrinter(ADevice,ADriver, APort, DeviceHandle); //获取打印机名/端口
Printer.SetPrinter(ADevice,ADriver, APort, 0); //最后个参数为0表示从系统获取默认打印机DEVMODE结构
才能够取到预设的FormName
但有一台针式印表机的仍不能取得(有取到……
[/Quote]
手头仅有的两个针式打印机木有出现你说的情况。。。。。。。

[dkjfsoman]

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

[SonicX]

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;