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

    

   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;