...get all paper bins?

Author: P. Below
Homepage: http://www.teamb.com

Category: Printing

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, nilnil);
  numBins     := WinSpool.DeviceCapabilities(Device, Port, DC_BINS, nilnil);
  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;

 

printed from
www.swissdelphicenter.ch
developers knowledge base