rm_pgopt.pas

进销存·完整的·有数据库的·非常完整·只得参考

{******************************************}
{                                          }
{           Report Machine v2.0            }
{              Page options                }
{                                          }
{******************************************}

unit RM_Pgopt;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, RM_prntr, 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;
    GroupBox5: TGroupBox;
    Label7: TLabel;
    Label8: TLabel;
    TabSheet4: TTabSheet;
    chkUnlimitedHeight: TCheckBox;
    cmbPaperNames: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    lblPaperSize: TLabel;
    lstBinNames: TListBox;
    lblPaperTray: TLabel;
    Label4: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    grbPreview: TGroupBox;
    lblPrinterName: TLabel;
    cmbPrinterNames: TComboBox;
    chkDoublePass: TCheckBox;
    chkTaoda: TCheckBox;
    chkPrintBackColor: TCheckBox;
    Label9: TLabel;
    edtTitle: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure cmbPrinterNamesChange(Sender: TObject);
    procedure cmbPaperNamesChange(Sender: TObject);
    procedure rdbPortraitClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure chkPrintToPrevPageClick(Sender: TObject);
    procedure chkDoublePassClick(Sender: TObject);
    procedure chkUnlimitedHeightClick(Sender: TObject);
    procedure lstBinNamesClick(Sender: TObject);
    procedure chkTaodaClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure chkPrintBackColorClick(Sender: TObject);
    procedure edtTitleExit(Sender: TObject);
    procedure FormDestroy(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 OnPagerWidthExitEvent(Sender: TObject);
    procedure OnMarginExitEvent(Sender: TObject);
  public
    { Public declarations }
    function ShowPageSetup: Boolean;
    procedure PreviewPageSetup;
    property PageSetting: TRMPageSetting read FPageSetting;
  end;

implementation

{$R *.DFM}

uses Math, Printers, 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(chkPrintBackColor, 'Caption', rmRes + 369);
  RMSetStrProp(TabSheet3, 'Caption', rmRes + 405);
  RMSetStrProp(GroupBox1, 'Caption', rmRes + 406);
  RMSetStrProp(chkPrintToPrevPage, 'Caption', rmRes + 407);
  RMSetStrProp(chkUnlimitedHeight, 'Caption', rmRes + 413);
  RMSetStrProp(GroupBox5, 'Caption', rmRes + 408);
  RMSetStrProp(Label7, 'Caption', rmRes + 409);
  RMSetStrProp(Label8, 'Caption', rmRes + 410);
  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);

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

function TRMPageSetupForm.ShowPageSetup: Boolean;
begin
  cmbPrinterNames.Enabled := FALSE;
  TabSheet3.TabVisible := FALSE;
  Result := ShowModal = mrOK;
end;

procedure TRMPageSetupForm.PrinterChange;
var
  liIndex, liPaperCount: 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 = poPortrait then
    begin
      SaveWidth := FPageSetting.PageWidth; saveHeight := FPageSetting.PageHeight;
    end
    else
    begin
      SaveWidth := FPageSetting.PageHeight; saveHeight := FPageSetting.PageWidth;
    end;
    liIndex := 0; liPaperCount := PaperSizesCount;
    while liIndex < liPaperCount do
    begin
      if (abs(PaperWidths[liIndex] - SaveWidth) <= 1) and (abs(PaperHeights[liIndex] - SaveHeight) <= 1) then
        Break;
      Inc(liIndex);
    end;
    if liIndex < liPaperCount then
      FPageSetting.PageSize := PaperSizes[liIndex]
    else
      FPageSetting.PageSize := PaperSizes[liPaperCount - 1];
  end;
  PaperChange;
end;

procedure TRMPageSetupForm.PaperChange;
begin
  if FUpdating then
    Exit;
  FUpdating := True;
  try
    FSpinMarginTop.Value := FPageSetting.MarginTop / 10;
    FSpinMarginBottom.Value := FPageSetting.MarginBottom / 10;
    FSpinMarginLeft.Value := FPageSetting.MarginLeft / 10;
    FSpinMarginRight.Value := FPageSetting.MarginRight / 10;

    FSpinColCount.Value := FPageSetting.ColCount;
    FSpinColGap.Value := FPageSetting.ColGap / 10;

    chkPrintToPrevPage.Checked := FPageSetting.PrintToPrevPage;
    chkDoublePass.Checked := FPageSetting.DoublePass;