unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Printers, WinSpool;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure GetBinnames( 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; // default printer
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
GetBinnames(ListBox1.Items);
end;
end. |
|
