Delphi World - Вывести все способы подачи бумаги для печати
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Вывести все способы подачи бумаги для печати

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

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;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования