Printer bin selection not working

Hi all,

I'm trying to let my program select the paper tray for printing using
the global Printer object. Reading the API documentation and finding
code samples on the internet i make some functions that i hoped would
be able to do this. The code does not give any error messages, but
doesn't select the correct paper tray either; it remains on automatic
selection (which is the default).

The testing code is below this message.

The results returned by PrinterBinList and PrinterBinGetIndex are
correct. I am also certain that 'Lade 2' is the one i want; i tested
this from Word. I'm also sure that the printer index is correct, since
the program does print the page on the correct printer, though not from
the correct paper tray.

The SetPrinter in PrinterBinSelect with DevMode zero was suggested
somewhere on the internet; it doesn't seem to have any effect though.

Does anyone know what may be wrong with the PrinterBinSelect procedure?

Tanks in advance.


uses
  Printers, WinSpool;

procedure PrinterBinList(const PrinterName: string; Bins: TStrings);
const
  BIN_NAME_LENGTH = 24;
var
  BinName: string;
  Buffer: PChar;
  Count, I: Integer;
begin
  Count := DeviceCapabilities(PChar(PrinterName), nil, DC_BINNAMES,
nil,
    nil);
  Win32Check(Count >= 0);

  GetMem(Buffer, Count * BIN_NAME_LENGTH);
  try
    Count := DeviceCapabilities(PChar(PrinterName), nil, DC_BINNAMES,

      Buffer, nil);
    Win32Check(Count >= 0);

    for I := 0 to Count - 1 do
    begin
      SetString(BinName, Buffer + I * BIN_NAME_LENGTH, BIN_NAME_LENGTH);
      SetLength(BinName, StrLen(PChar(BinName)));
      Bins.Add(BinName);
    end;
  finally
    FreeMem(Buffer);
  end;
end;

function PrinterBinGetIndex(const PrinterName, BinName: string):
  SmallInt;
var
  Count, I: Integer;
  Names: TStringList;
  Numbers: array of SmallInt;
begin
  Names := TStringList.Create;
  try
    PrinterBinList(PrinterName, Names);

    SetLength(Numbers, Names.Count);
    Count := DeviceCapabilities(PChar(PrinterName), nil, DC_BINS,
      @Numbers[1], nil);
    Win32Check(Count >= 0);

    Result := DMBIN_AUTO;
    for I := 0 to Names.Count - 1 do
      if BinName = Names[I] then
      begin
        Result := Numbers[I];
        Break;
      end;
  finally
    Names.Free;
  end;
end;

procedure PrinterBinSelect(Printer: TPrinter; const BinName: string);
var
  Device, Driver, Port: array[0..MAX_PATH] of Char;
  DeviceMode: PDeviceModeA;
  DevMode: HGLOBAL;
  Number: SmallInt;
begin
  Printer.GetPrinter(@Device, @Driver, @Port, DevMode);
  Printer.SetPrinter(@Device, @Driver, @Port, 0);
  Printer.GetPrinter(@Device, @Driver, @Port, DevMode);

  Number := PrinterBinGetIndex(Device, BinName);
  if Number < 0 then
    raise Exception.CreateFmt('Cannot find printer tray: "%s" on ' +
       'printer "%s"', [BinName, Device]);

  DeviceMode := GlobalLock(DevMode);
  try
    DeviceMode^.dmFields := DeviceMode^.dmFields or DM_DEFAULTSOURCE;
    DeviceMode^.dmDefaultSource := Number;
  finally
    GlobalUnlock(DevMode);
  end;

  Printer.SetPrinter(@Device, @Driver, @Port, DevMode);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Printer.PrinterIndex := 1;
  PrinterBinSelect(Printer, 'Lade 2');

  Printer.BeginDoc;
  try
    Printer.Canvas.TextOut(0, 0, 'Testing paper tray selection');
  finally
    Printer.EndDoc;
  end;
end;