rm_pagesetup.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 647 行 · 第 1/2 页

unit RM_PageSetup;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, RM_Printer, RM_Ctrls, RM_Common;

type
  { TRMPageImage }
  TRMPageImage = class(TShape)
  private
    FColumns: Integer;
    FPageImage: TBitMap;
    procedure DrawPage;
  protected
    procedure Paint; override;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetLayout(aColumns: Integer; aRowSpacing: Single);
  end;

  { TRMPageSetupForm }
  TRMPageSetupForm = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    GroupBox2: TGroupBox;
    imgLandScape: TImage;
    imgPortrait: TImage;
    rdbPortrait: TRadioButton;
    rdbLandscape: TRadioButton;
    GroupBox1: TGroupBox;
    chkPrintToPrevPage: TCheckBox;
    TabSheet4: TTabSheet;
    chkUnlimitedHeight: TCheckBox;
    cmbPaperNames: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    lblPaperSize: TLabel;
    lstBinNames: TListBox;
    lblPaperTray: TLabel;
    grbPreview: TGroupBox;
    lblPrinterName: TLabel;
    cmbPrinterNames: TComboBox;
    chkDoublePass: TCheckBox;
    chkTaoda: TCheckBox;
    chkColorPrint: TCheckBox;
    Label9: TLabel;
    edtTitle: TEdit;
    chkNewPage: TCheckBox;
    GroupBox5: TGroupBox;
    Label7: TLabel;
    Label8: TLabel;
    GroupBox3: TGroupBox;
    Label4: TLabel;
    Label6: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    chkConvertNulls: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure cmbPrinterNamesChange(Sender: TObject);
    procedure cmbPaperNamesChange(Sender: TObject);
    procedure rdbPortraitClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure edtTitleExit(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure lstBinNamesClick(Sender: TObject);
  private
    { Private declarations }
    FPreviewPage: TRMPageImage;
    FPageSetting: TRMPageSetting;
    FUpdating: Boolean;
    FPrinterInfo: TRMPrinterInfo;

    FSpinPaperHeight: TRMSpinEdit;
    FSpinPaperWidth: TRMSpinEdit;
    FSpinMarginTop: TRMSpinEdit;
    FSpinMarginBottom: TRMSpinEdit;
    FSpinMarginLeft: TRMSpinEdit;
    FSpinMarginRight: TRMSpinEdit;
    FSpinColCount: TRMSpinEdit;
    FSpinColGap: TRMSpinEdit;

    procedure PaperChange;
    procedure PrinterChange;

    procedure Localize;
    procedure Init;
    procedure OnPagerWidthExitEvent(Sender: TObject);
    procedure OnMarginExitEvent(Sender: TObject);
  public
    { Public declarations }
    function PreviewPageSetup: Boolean;
    function Execute: Boolean;

    property PageSetting: TRMPageSetting read FPageSetting;
  end;

implementation

{$R *.DFM}

uses Math, RM_Utils, RM_Const, RM_Const1, RM_Class;

var
  FForm: TRMPageSetupForm;

  {------------------------------------------------------------------------------}
  {------------------------------------------------------------------------------}
  {TRMPageImage}

constructor TRMPageImage.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);

  FPageImage := TBitMap.Create;
  FColumns := 0;
  Color := clBtnFace;
end;

destructor TRMPageImage.Destroy;
begin
  FPageImage.Free;
  inherited Destroy;
end;

procedure TRMPageImage.SetLayout(aColumns: Integer; aRowSpacing: Single);
begin
  FColumns := aColumns;
  DrawPage;
end;

procedure TRMPageImage.DrawPage;
var
  ldRatio: Double;
  liHeight, liWidth: Integer;
  liLeft, liTop, liRight, liBottom: Integer;
  ldScaleWidth, ldScaleHeight: Double;
  liMarginTop: Integer;
  liMarginBottom: Integer;
  liMarginLeft: Integer;
  liMarginRight: Integer;
  lPaperWidth, lPaperHeight: Double;
begin
  lPaperWidth := FForm.PageSetting.PageWidth;
  lPaperHeight := FForm.PageSetting.PageHeight;
  if lPaperHeight = 0 then Exit;

  ldRatio := lPaperWidth / lPaperHeight;
  liHeight := Height;
  liWidth := Round(ldRatio * liHeight);
  while (liWidth >= Width) do
  begin
    liHeight := liHeight - 20;
    liWidth := Round(ldRatio * liHeight);
  end;

  ldScaleWidth := liWidth / lPaperWidth;
  ldScaleHeight := liHeight / lPaperHeight;

  liMarginTop := Trunc(FForm.FSpinMarginTop.Value * 100 * ldScaleHeight);
  liMarginBottom := Trunc(FForm.FSpinMarginBottom.Value * 100 * ldScaleHeight);
  liMarginLeft := Trunc(FForm.FSpinMarginLeft.Value * 100 * ldScaleWidth);
  liMarginRight := Trunc(FForm.FSpinMarginRight.Value * 100 * ldScaleWidth);

  FPageImage.Width := Width;
  FPageImage.Height := Height;

  FPageImage.Canvas.Pen.Style := psSolid;
  FPageImage.Canvas.Brush.Style := bsSolid;
  FPageImage.Canvas.Brush.Color := clBtnFace;
  FPageImage.Canvas.FillRect(Rect(0, 0, Width, Height));

  liLeft := (Width - liWidth) div 2;
  liTop := (Height - liHeight) div 2;
  liRight := liLeft + liWidth;
  liBottom := liTop + liHeight;

  FPageImage.Canvas.Brush.Color := clWindow;
  FPageImage.Canvas.Rectangle(liLeft, liTop, liRight - 5, liBottom - 5);

  FPageImage.Canvas.Brush.Color := clGray; //clBlack;
  FPageImage.Canvas.FillRect(Rect(liLeft + 6, liTop + liHeight - 5, liRight, liBottom));
  FPageImage.Canvas.FillRect(Rect(liRight - 5, liTop + 6, liRight, liBottom));

  liLeft := liLeft + 1 + liMarginLeft;
  liTop := liTop + 1 + liMarginTop;
  liRight := liRight - 6 - liMarginRight;
  liBottom := liBottom - 6 - liMarginBottom;

  FPageImage.Canvas.Pen.Style := psDot;
  FPageImage.Canvas.Brush.Color := clWindow;
  {$IFDEF D5}
  FPageImage.Canvas.Rectangle(Rect(liLeft, liTop, liRight, liBottom));
  {$ELSE}
  FPageImage.Canvas.Rectangle(liLeft, liTop, liRight, liBottom);
  {$ENDIF}
  Invalidate;
end;

procedure TRMPageImage.Paint;
begin
  with Canvas do
    CopyRect(ClipRect, FPageImage.Canvas, ClipRect);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMPageSetupForm}

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

  RMSetStrProp(Self, 'Caption', rmRes + 390);
  RMSetStrProp(TabSheet1, 'Caption', rmRes + 391);
  RMSetStrProp(GroupBox2, 'Caption', rmRes + 392);
  RMSetStrProp(rdbPortrait, 'Caption', rmRes + 393);
  RMSetStrProp(rdbLandscape, 'Caption', rmRes + 394);
  RMSetStrProp(lblPaperSize, 'Caption', rmRes + 395);
  RMSetStrProp(Label1, 'Caption', rmRes + 396);
  RMSetStrProp(Label2, 'Caption', rmRes + 397);
  RMSetStrProp(TabSheet2, 'Caption', rmRes + 398);
  RMSetStrProp(Label3, 'Caption', rmRes + 400);
  RMSetStrProp(Label4, 'Caption', rmRes + 401);
  RMSetStrProp(Label5, 'Caption', rmRes + 402);
  RMSetStrProp(Label6, 'Caption', rmRes + 403);
  RMSetStrProp(chkColorPrint, 'Caption', rmRes + 369);
  RMSetStrProp(chkNewPage, 'Caption', rmRes + 368);
  RMSetStrProp(TabSheet3, 'Caption', rmRes + 405);
  RMSetStrProp(GroupBox1, 'Caption', rmRes + 406);
  RMSetStrProp(chkPrintToPrevPage, 'Caption', rmRes + 407);
  RMSetStrProp(chkUnlimitedHeight, 'Caption', rmRes + 413);
  RMSetStrProp(chkConvertNulls, 'Caption', rmRes + 415);

  RMSetStrProp(TabSheet4, 'Caption', rmRes + 411);
  RMSetStrProp(lblPaperTray, 'Caption', rmRes + 412);
  RMSetStrProp(Label9, 'Caption', rmRes + 372);
  RMSetStrProp(chkDoublePass, 'Caption', rmRes + 374);
  RMSetStrProp(lblPrinterName, 'Caption', rmRes + 371);
  RMSetStrProp(chkTaoda, 'Caption', rmRes + 375);
  RMSetStrProp(grbPreview, 'Caption', rmRes + 399);

  RMSetStrProp(GroupBox3, 'Caption', rmRes + 398);
  RMSetStrProp(GroupBox5, 'Caption', rmRes + 408);
  RMSetStrProp(Label7, 'Caption', rmRes + 409);
  RMSetStrProp(Label8, 'Caption', rmRes + 410);

  btnOk.Caption := RMLoadStr(SOk);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

function TRMPageSetupForm.Execute: Boolean;
begin
  Init;
  Result := (ShowModal = mrOK);
end;

function TRMPageSetupForm.PreviewPageSetup: Boolean;
begin
  //  cmbPrinterNames.Enabled := False;
  //  TabSheet3.TabVisible := False;
  //  Result := ShowModal = mrOK;
  FSpinColCount.Enabled := False;
  FSpinColGap.Enabled := False;
  chkUnlimitedHeight.Visible := False;

  Init;
  Result := ShowModal = mrOK;
end;

procedure TRMPageSetupForm.PrinterChange;
var
  lIndex, lPaperCount: Integer;
  SaveWidth, SaveHeight: Integer;
begin
  FPrinterInfo := RMPrinters.PrinterInfo[cmbPrinterNames.ItemIndex];
  with FPrinterInfo do
  begin
    cmbPaperNames.Items.Assign(PaperNames);
    lstBinNames.Items.Assign(BinNames);

    if FPageSetting.PageOr = rmpoPortrait then
    begin
      SaveWidth := FPageSetting.PageWidth;
      saveHeight := FPageSetting.PageHeight;
    end
    else
    begin
      SaveWidth := FPageSetting.PageHeight;
      saveHeight := FPageSetting.PageWidth;
    end;

    lIndex := 0;
    lPaperCount := PaperSizesCount;
    while lIndex < lPaperCount do
    begin
      if (abs(PaperWidths[lIndex] - SaveWidth) <= 1) and (abs(PaperHeights[lIndex] - SaveHeight) <= 1) then
        Break;

      Inc(lIndex);
    end;

    if lIndex < lPaperCount then
      FPageSetting.PageSize := PaperSizes[lIndex]
    else
      FPageSetting.PageSize := PaperSizes[lPaperCount - 1];
  end;

  PaperChange;
end;

procedure TRMPageSetupForm.PaperChange;