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;