1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:

procedure GetBinnames(aStringList: TStrings);
type
  TBinName = array [0..23] of Char;
  TBinNameArray = array [1..99] of TBinName;
  PBinnameArray = ^TBinNameArray;
  TBinArray = array [1..99] of Word;
  PBinArray = ^TBinArray;
var
  szDevice, szDriver, szPort : array[0..255] of Char;
  hDevMode                   : THandle;
  i, iBinNames, iBins        : Integer;
  pBinNames                  : PBinnameArray;
  pBins                      : PBinArray;
begin
  Printer.PrinterIndex := -1;
  Printer.GetPrinter(szDevice, szDriver, szPort, hDevmode);
  iBinNames := DeviceCapabilities(szDevice, szPort, DC_BINNAMES, nil, nil);
  if iBinNames > 0 then
  begin
    pBins := nil;
    GetMem(pBinNames, iBinNames * Sizeof(TBinname));
    GetMem(pBins, iBins * Sizeof(Word));
    try
      DeviceCapabilities(szDevice, szPort, DC_BINNAMES, PChar(pBinNames), nil);
      DeviceCapabilities(szDevice, szPort, DC_BINS, PChar(pBins), nil);
      aStringList.Clear;
      for i:= 1 to iBinNames do
        aStringList.Add(Format('%s (%d)',[pBinNames^[i], pBins^[i]]));
    finally
      FreeMem(pBinNames );
      if pBins <> nil then
        FreeMem(pBins);
    end;
  end;
end;