Mega Code Archive

 
Categories / Delphi / System
 

Get all paper bins

Title: get all paper bins? 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;