uses Printers, WinSpool; 
 
type 
  sName = array[0..23] of Char; 
  sArray = array[1..99] of smallint; 
  sNameArray = array[1..99] of sName; 
 
var 
  aDevice, aDriver, aPort: array[0..255] of Char; 
  hDMode: THandle; 
 
procedure TForm1.ListBox1DblClick(Sender: TObject); 
var 
  PDMode: PDeviceModeA; 
begin 
  with TListbox(Sender) do begin 
    Printer.GetPrinter(aDevice, aDriver, aPort, hDMode); 
    if hDMode <> 0 then begin 
      pDMode := GlobalLock(hDMode); 
      if pDMode <> nil then begin 
        pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE; 
        pDMode^.dmPaperSize := DMPAPER_A4; 
        pDMode^.dmFields := pDMode^.dmFields or DM_DEFAULTSOURCE; 
        pDMode^.dmDefaultSource := smallint(items.objects[itemindex]); 
        GlobalUnlock(hDMode); 
      end; 
    end; 
  end; 
  with Printer do 
  begin 
    BeginDoc; 
    Canvas.TextOut(100, 100, 'Das ist ein Test'); 
    EndDoc; 
  end; 
end; 
 
procedure Schaechte(gefunden: TStrings); 
var 
  pNames: ^sNameArray; 
  i, iNames: Integer; 
  p: ^sArray; 
begin 
  Printer.GetPrinter(aDevice, aDriver, aPort, hDMode); 
  iNames := DeviceCapabilities(aDevice, aPort, DC_BINNAMES, nil, nil); 
  if iNames > 0 then 
  begin 
    GetMem(pNames, iNames * Sizeof(sName)); 
    GetMem(p, iNames * Sizeof(smallint)); 
    try 
      DeviceCapabilities(aDevice, aPort, DC_BINNAMES, PChar(pNames), nil); 
      DeviceCapabilities(aDevice, aPort, DC_BINS, PChar(p), nil); 
      gefunden.Clear; 
      for i := 1 to iNames do 
        gefunden.addobject(pNames^[i], TObject(p^[i])); 
    finally 
      FreeMem(pNames); 
      if p <> nil then 
        FreeMem(p); 
    end; 
  end; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  schaechte(Listbox1.items); 
end;