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;
|
