Вывести все способы подачи бумаги для печати

uses

   WinSpool, Printers;

 procedure
 GetPaperBins(sl: TStrings);
 type

   TBinName      = array
 [0..23] of
 Char;
   TBinNameArray = array
 [1..High(Integer) div
 SizeOf(TBinName)] of
 TBinName;
   PBinnameArray = ^TBinNameArray;
   TBinArray     = array
 [1..High(Integer) div
 SizeOf(Word)] of
 Word;
   PBinArray     = ^TBinArray;
 var

   Device, Driver, Port: array
 [0..255] of
 Char;
   hDevMode: THandle;
   i, numBinNames, numBins, temp: Integer;
   pBinNames: PBinnameArray;
   pBins: PBinArray;
 begin

   Printer.PrinterIndex := -1;
   Printer.GetPrinter(Device, Driver, Port, hDevmode);
   numBinNames := WinSpool.DeviceCapabilities(Device, Port, DC_BINNAMES, nil
, nil
);
   numBins     := WinSpool.DeviceCapabilities(Device, Port, DC_BINS, nil
, nil
);
   if
 numBins <> numBinNames then

   begin

     raise
 Exception.Create('DeviceCapabilities reports different number of bins and bin names!');
   end
;
   if
 numBinNames > 0 then

   begin

     pBins := nil
;
     GetMem(pBinNames, numBinNames * SizeOf(TBinname));
     GetMem(pBins, numBins * SizeOf(Word));
     try

       WinSpool.DeviceCapabilities(Device, Port, DC_BINNAMES, PChar(pBinNames), nil
);
       WinSpool.DeviceCapabilities(Device, Port, DC_BINS, PChar(pBins), nil
);
       sl.Clear;
       for
 i := 1 to
 numBinNames do

       begin

         temp := pBins^[i];
         sl.addObject(pBinNames^[i], TObject(temp));
       end
;
     finally

       FreeMem(pBinNames);
       if
 pBins <> nil
 then

         FreeMem(pBins);
     end
;
   end
;
 end
;


 procedure
 TForm1.Button1Click(Sender: TObject);
 begin

   GetPaperBins(Listbox1.Items);
 end
;

Другое по теме:

• Escape код PASSTHROUGH
• Вместо печати графики использовать резидентный шрифт принтера
• Вывести список установленных принтеров и подробную информацию о каждом