{ Übergabe des gewünschten Druckernamens als zweiten parameter; PrnterName: String}
procedure GetPaperBins(sl: TStrings; PrinterName:
String);
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
{ den gewünschten Drucker setzen
==============================}
for numBins := 0
to Printer.Printers.Count -1
do begin
if Printer.Printers [numBins] = PrinterName
then
Printer.PrinterIndex := numBins ;
end;
{ weiter mit orig Code}
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];
{ Schachtname und Schachtnummer( als String) mit '=' verknüpft zurückgeben,
dazu den orig. Code auskommentieren....
=======================================}
// sl.addObject(pBinNames^[i], TObject(temp));
{ .... und neue Rückgabe basteln
===============================}
sl.AddObject(pBinNames^[i] [i]+'
='+ IntToStr( pBins^[i])[/i], TObject(temp));
end;
{weiter mit orig Code ohne weitere Änderungen}
finally
FreeMem(pBinNames);
if pBins <>
nil then
FreeMem(pBins);
end;
end;
end;