Print To Different Tray/Bin Not Working

Message Topic Search Topic Options Post Reply Create New Topic Printable Version Translate Topic

   Before printing, you can set the paper box that the printer will use in advance.The following example achieves a more flexible function: changing the paper box used during the printing process. If you only need to set up the paper box before printing, you can modify the code yourself.
==============================
code:

Printer.BeginDoc;
    //dosomething...print

    //--------- Changing Trays .... -----------------
    Printer.GetPrinter(device, driver, port, hDMode);
    if (hDMode <> 0) then
    begin
      pDMode := GlobalLock(hDMode);
      if Assigned(pDMode) then
      begin         
          pDMode.dmFields := pDMode.dmFields or DMBIN_MANUAL;
          pDMode.dmDefaultSource :=GetTraysID(); 
         winapi.Windows.EndPage( Printer.Handle );   
         If ResetDC( Printer.canvas.Handle, pDMode^ ) = 0 Then
                showmessage( 'ResetDC failed, '+SysErrorMessage(GetLastError));
         GlobalUnlock( hDMode );
         winapi.Windows.StartPage( Printer.Handle );
         Printer.Canvas.Refresh;
      end;
    //--------------------------------------------------

    //dosomething...print
    Printer.EndDoc;
    end;

 function GetTraysID()(TraysName: string; adevice, aport: PWideChar): Word;  var
    i, rslt: Integer;
    tBinNames: array of Tbinname;
    BinCodes: array of Word;
  begin
    Result := DM_DEFAULTSOURCE;
    rslt := devicecapabilitiesW(adevice, aport, dc_binnames, nil, nil);
    if rslt > 0 then
    begin
      setlength(tBinNames, rslt);
      setlength(BinCodes, rslt);
      try
        if devicecapabilitiesW(adevice, aport, dc_binnames, @tBinNames[0],
          nil) = -1 then
        begin
          setlength(BinCodes, 0);
          setlength(tBinNames, 0);
          raise exception.Create('error tbinnames');
        end;
        if devicecapabilitiesW(adevice, aport, DC_BINS, @BinCodes[0], nil) = -1
        then
        begin
          setlength(BinCodes, 0);
          setlength(tBinNames, 0);
          raise exception.Create('error  BinCodes');
        end;

        for i := 0 to rslt - 1 do
        begin
          if TraysName = tBinNames then
          begin
            Result := BinCodes;
            Break;
          end;
        end;
      finally
        setlength(BinCodes, 0);
        setlength(tBinNames, 0);
      end;
    end;
  end;