rm_prdlg.pas

report machine 2.3 功能强大

{******************************************}
{                                          }
{           Report Machine v2.0            }
{              Print dialog                }
{                                          }
{                                          }
{******************************************}

unit RM_prdlg;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, WinSpool, Printers, RM_Common;

type
  TRMPrintForm = class(TForm)
    GroupBox2: TGroupBox;
    rdbPrintAll: TRadioButton;
    rbdPrintCurPage: TRadioButton;
    rbdPrintPapges: TRadioButton;
    edtPages: TEdit;
    Label2: TLabel;
    btnOK: TButton;
    btnCancel: TButton;
    GroupBox1: TGroupBox;
    cmbPrinters: TComboBox;
    btnPrinterProp: TButton;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    edtCopies: TEdit;
    chkCollate: TCheckBox;
    Label4: TLabel;
    Label5: TLabel;
    Image1: TImage;
    cmbPrintAll: TComboBox;
    UpDown1: TUpDown;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    imgCollate: TImage;
    lblStatus: TLabel;
    lblType: TLabel;
    lblPosition: TLabel;
    lblCommon: TLabel;
    Image3: TImage;
    Image2: TImage;
    chkTaoda: TCheckBox;
    GroupBox4: TGroupBox;
    Label3: TLabel;
    cmbScalePapers: TComboBox;
    lblScale: TLabel;
    edtScale: TEdit;
    procedure cmbPrintersDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
    procedure btnPrinterPropClick(Sender: TObject);
    procedure E2Click(Sender: TObject);
    procedure rbdPrintPapgesClick(Sender: TObject);
    procedure chkCollateClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cmbPrintersChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FOldIndex: Integer;
    FScale: TRMUpDown;

    procedure Localize;
    procedure UpdateCollationSettings;
    procedure UpdatePrinterSettings;
		procedure FillScalePapers;
    procedure OnScaleClickEvent(Sender: TObject; Button: TUDBtnType);
    function GetScale: Integer;
  public
    { Public declarations }
		procedure GetPageInfo(var	aPaperWidth, aPaperHeight, apgSize: Integer);
    property Scale: Integer read GetScale;
  end;

implementation

{$R *.DFM}

uses RM_Const, RM_Prntr, RM_Utils;

procedure TRMPrintForm.Localize;
begin
	Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  Caption := RMLoadStr(rmRes + 040);
  GroupBox1.Caption := RMLoadStr(rmRes + 041);
  btnPrinterProp.Caption := RMLoadStr(rmRes + 042);
  GroupBox3.Caption := RMLoadStr(rmRes + 043);
  GroupBox2.Caption := RMLoadStr(rmRes + 044);
  rdbPrintAll.Caption := RMLoadStr(rmRes + 045);
  rbdPrintCurPage.Caption := RMLoadStr(rmRes + 046);
  rbdPrintPapges.Caption := RMLoadStr(rmRes + 047);
  Label2.Caption := RMLoadStr(rmRes + 048);
  Label4.Caption := RMLoadStr(rmRes + 049);
  Label1.Caption := RMLoadStr(rmRes + 050);
  chkCollate.Caption := RMLoadStr(rmRes + 051);
  Label5.Caption := RMLoadStr(rmRes + 052);
  btnOK.Caption := RMLoadStr(SOk);
  btnCancel.Caption := RMLoadStr(SCancel);
  Label6.Caption := RMLoadStr(rmRes + 56);
  Label7.Caption := RMLoadStr(rmRes + 57);
  Label8.Caption := RMLoadStr(rmRes + 58);
	Label9.Caption := RMLoadStr(rmRes + 1831);
  chkTaoda.Caption := RMLoadStr(rmRes + 375);
  GroupBox4.Caption := RMLoadStr(rmRes + 1860);
  Label3.Caption := RMLoadStr(rmRes + 1861);
	lblScale.Caption := RMLoadStr(rmRes + 1863);

  cmbPrintAll.Items.Add(RMLoadStr(rmRes + 53));
  cmbPrintAll.Items.Add(RMLoadStr(rmRes + 54));
  cmbPrintAll.Items.Add(RMLoadStr(rmRes + 55));
end;

procedure TRMPrintForm.GetPageInfo(var	aPaperWidth, aPaperHeight, apgSize: Integer);
var
  liPrintInfo: TRMPrinterInfo;
begin
	if cmbScalePapers.ItemIndex < 1 then
  begin
  	apgSize := -1;
  end
  else
  begin
  	liPrintInfo := RMPrinters.PrinterInfo[cmbPrinters.ItemIndex];
    apgSize := liPrintInfo.PaperSizes[cmbScalePapers.ItemIndex - 1];
    aPaperWidth := liPrintInfo.PaperWidths[cmbScalePapers.ItemIndex - 1];
    aPaperHeight := liPrintInfo.PaperHeights[cmbScalePapers.ItemIndex - 1];
  end;
end;

procedure TRMPrintForm.FillScalePapers;
var
	i: Integer;
  liPrintInfo: TRMPrinterInfo;
begin
	cmbScalePapers.Items.Clear;
  cmbScalePapers.Items.Add(RMLoadStr(rmRes + 1862));
  if cmbPrinters.ItemIndex >= 0 then
  begin
	  liPrintInfo := RMPrinters.PrinterInfo[cmbPrinters.ItemIndex];
    with liPrintInfo do
    begin
	  	for i := 0 to PaperSizesCount - 2 do
  	  begin
    		cmbScalePapers.Items.Add(PaperNames[i]);
	    end;
    end;
  end;
  cmbScalePapers.ItemIndex := 0;
end;

procedure TRMPrintForm.UpdateCollationSettings;
begin
  if (chkCollate.Checked) then
    imgCollate.Picture.Bitmap.Assign(Image2.Picture.Bitmap)
  else
    imgCollate.Picture.Bitmap.Assign(Image3.Picture.Bitmap)
end;

procedure TRMPrintForm.UpdatePrinterSettings;
var
  info: PPrinterInfo2;
  pcbNeeded, count: DWORD;
  str: string;
begin
  lblType.Caption := '';
  lblPosition.Caption := '';
  lblCommon.Caption := '';
  lblStatus.Caption := '';
  if cmbPrinters.ItemIndex >= 0 then
  begin
		WinSpool.GetPrinter(RMPrinter.PrinterHandle, 2, nil, 0, @count);
    GetMem(info, count);
    try
      if WinSpool.GetPrinter(RMPrinter.PrinterHandle, 2, info, count, @pcbNeeded) then
      begin
        lblType.Caption := info^.pDriverName;
        lblPosition.Caption := info^.pPortName;
        lblCommon.Caption := info^.pComment;
        if info^.cJobs > 0 then
        	str := '打印'
        else
	        str := '空闲';
        if info^.Status <> 0 then
        begin
          case info^.Status of
            PRINTER_STATUS_BUSY: str := RMLoadStr(rmRes + 1833);
            PRINTER_STATUS_DOOR_OPEN: str := RMLoadStr(rmRes + 1834);
            PRINTER_STATUS_ERROR: str := RMLoadStr(rmRes + 1835);
            PRINTER_STATUS_INITIALIZING: str := RMLoadStr(rmRes + 1836);
            PRINTER_STATUS_IO_ACTIVE: str := RMLoadStr(rmRes + 1837);
            PRINTER_STATUS_MANUAL_FEED: str := RMLoadStr(rmRes + 1838);
            PRINTER_STATUS_NO_TONER: str := RMLoadStr(rmRes + 1839);
            PRINTER_STATUS_NOT_AVAILABLE: str := RMLoadStr(rmRes + 1840);
            PRINTER_STATUS_OFFLINE: str := RMLoadStr(rmRes + 1841);
            PRINTER_STATUS_OUT_OF_MEMORY: str := RMLoadStr(rmRes + 1842);
            PRINTER_STATUS_OUTPUT_BIN_FULL: str := RMLoadStr(rmRes + 1843);
            PRINTER_STATUS_PAGE_PUNT: str := RMLoadStr(rmRes + 1844);
            PRINTER_STATUS_PAPER_JAM: str := RMLoadStr(rmRes + 18345);
            PRINTER_STATUS_PAPER_OUT: str := RMLoadStr(rmRes + 1846);
            PRINTER_STATUS_PAPER_PROBLEM: str := RMLoadStr(rmRes + 1847);
            PRINTER_STATUS_PAUSED: str := RMLoadStr(rmRes + 1848);
            PRINTER_STATUS_PENDING_DELETION: str := RMLoadStr(rmRes + 1849);
            PRINTER_STATUS_PRINTING: str := RMLoadStr(rmRes + 1850);
            PRINTER_STATUS_PROCESSING: str := RMLoadStr(rmRes + 1851);
            PRINTER_STATUS_TONER_LOW: str := RMLoadStr(rmRes + 1852);
            PRINTER_STATUS_USER_INTERVENTION: str := RMLoadStr(rmRes + 1853);
            PRINTER_STATUS_WAITING: str := RMLoadStr(rmRes + 1834);
            PRINTER_STATUS_WARMING_UP: str := RMLoadStr(rmRes + 1855);
          end;
        end;
        if info^.cJobs > 0 then
        begin
          if Length(str) > 0 then str := str + ':';
          str := str + Format(RMLoadStr(rmRes + 1856), [info^.cJobs]);
        end;
        lblStatus.Caption := str;
      end;
    finally
			ClosePrinter(Handle);
      FreeMem(info, count);
    end;
  end;
end;

procedure TRMPrintForm.FormCreate(Sender: TObject);
begin
	Localize;
  cmbPrinters.Items.Assign(RMPrinters.Printers);
  FOldIndex := RMPrinter.PrinterIndex;
  cmbPrinters.ItemIndex := FOldIndex;
  if cmbPrinters.ItemIndex < 0 then cmbPrinters.ItemIndex := 0;
  chkCollateClick(nil);

  cmbPrintAll.ItemIndex := 0;
  cmbPrintAll.Left := Label5.Left + Label5.Width + 11;

  cmbScalePapers.ItemIndex := -1;

  FScale := TRMUpDown.CreateForControl(edtScale);
  FScale.OnClick := OnScaleClickEvent;
end;

procedure TRMPrintForm.cmbPrintersDrawItem(Control: TWinControl; Index: Integer;
  ARect: TRect; State: TOwnerDrawState);
var
  r: TRect;
begin
  r := ARect;
  r.Right := r.Left + 18;
  r.Bottom := r.Top + 16;
  OffsetRect(r, 2, 0);
  with cmbPrinters.Canvas do
  begin
    FillRect(ARect);
    BrushCopy(r, Image1.Picture.Bitmap, Rect(0, 0, 18, 16), clOlive);
    TextOut(ARect.Left + 24, ARect.Top + 1, cmbPrinters.Items[Index]);
  end;
end;

procedure TRMPrintForm.btnPrinterPropClick(Sender: TObject);
begin
  RMPrinter.PropertiesDlg;
  UpdatePrinterSettings;
end;

procedure TRMPrintForm.E2Click(Sender: TObject);
begin
  rbdPrintPapges.Checked := True;
end;

procedure TRMPrintForm.rbdPrintPapgesClick(Sender: TObject);
begin
  edtPages.SetFocus;
end;

procedure TRMPrintForm.chkCollateClick(Sender: TObject);
begin
  UpdateCollationSettings;
end;

procedure TRMPrintForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if ModalResult <> mrOk then
    RMPrinter.PrinterIndex := FOldIndex;
end;

procedure TRMPrintForm.cmbPrintersChange(Sender: TObject);
begin
  RMPrinter.PrinterIndex := cmbPrinters.ItemIndex;
  UpdatePrinterSettings;
	FillScalePapers;
end;

procedure TRMPrintForm.FormShow(Sender: TObject);
begin
  cmbPrintersChange(nil);
end;

procedure TRMPrintForm.OnScaleClickEvent(Sender: TObject; Button: TUDBtnType);
begin
	try
	  if (Button = btPrev) and (StrToInt(edtScale.Text) > 1) then
	    edtScale.Text := IntToStr(StrToInt(edtScale.Text) - 1)
  	else
	    edtScale.Text := IntToStr(StrToInt(edtScale.Text) + 1);
  except
  	edtScale.Text := '100';
  end;
end;

function TRMPrintForm.GetScale: Integer;
begin
	try
  	Result := StrToInt(edtScale.Text);
    if Result < 1 then Result := 1;
  except
		Result := 100;
  end;
end;

end.