⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 rm_pgopt.pas

📁 report machine 2.3 功能强大
💻 PAS
📖 第 1 页 / 共 2 页
字号:

{******************************************}
{                                          }
{           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;
    edtColumnSpace: TEdit;
    Label8: TLabel;
    edtColumns: TEdit;
    TabSheet4: TTabSheet;
    chkUnlimitedHeight: TCheckBox;
    cmbPaperNames: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    edtPaperWidth: TEdit;
    edtPaperHeight: TEdit;
    lblPaperSize: TLabel;
    lstBinNames: TListBox;
    lblPaperTray: TLabel;
    edtMarginTop: TEdit;
    Label4: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    edtMarginRight: TEdit;
    edtMarginLeft: TEdit;
    Label6: TLabel;
    edtMarginBottom: TEdit;
    chkUseMargins: TCheckBox;
    grbPreview: TGroupBox;
    lblPrinterName: TLabel;
    cmbPrinterNames: TComboBox;
    chkPrintToDefault: TCheckBox;
    chkDoublePass: TCheckBox;
    chkTaoda: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure cmbPrinterNamesChange(Sender: TObject);
    procedure cmbPaperNamesChange(Sender: TObject);
    procedure rdbPortraitClick(Sender: TObject);
    procedure edtMarginTopKeyPress(Sender: TObject; var Key: Char);
    procedure edtMarginTopExit(Sender: TObject);
    procedure edtPaperWidthKeyPress(Sender: TObject; var Key: Char);
    procedure edtPaperWidthExit(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure edtPaperHeightExit(Sender: TObject);
    procedure chkPrintToPrevPageClick(Sender: TObject);
    procedure chkPrintToDefaultClick(Sender: TObject);
    procedure chkDoublePassClick(Sender: TObject);
    procedure chkUseMarginsClick(Sender: TObject);
    procedure chkUnlimitedHeightClick(Sender: TObject);
    procedure lstBinNamesClick(Sender: TObject);
    procedure chkTaodaClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    FPreviewPage: TRMPageImage;
    FPageSetting: TRMPageSetting;
    FUpdating: Boolean;
    FPrinterInfo: TRMPrinterInfo;

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

    procedure PaperChange;
    procedure PrinterChange;

    procedure SpinPaperHeightClick(Sender: TObject; Button: TUDBtnType);
    procedure SpinPaperWidthClick(Sender: TObject; Button: TUDBtnType);
    procedure SpinMarginTopClick(Sender: TObject; Button: TUDBtnType);
    procedure SpinMarginBottomClick(Sender: TObject; Button: TUDBtnType);
    procedure SpinMarginLeftClick(Sender: TObject; Button: TUDBtnType);
    procedure SpinMarginRightClick(Sender: TObject; Button: TUDBtnType);
    procedure SpinColCountClick(Sender: TObject; Button: TUDBtnType);
    procedure SpinColGapClick(Sender: TObject; Button: TUDBtnType);
    procedure Localize;
  public
    { Public declarations }
    function ShowPageSetup: Boolean;
    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(StrToFloat(FForm.edtMarginTop.Text) * 100 * ldScaleHeight);
  liMarginBottom := Trunc(StrToFloat(FForm.edtMarginBottom.Text) * 100 * ldScaleHeight);
  liMarginLeft := Trunc(StrToFloat(FForm.edtMarginLeft.Text) * 100 * ldScaleWidth);
  liMarginRight := Trunc(StrToFloat(FForm.edtMarginRight.Text) * 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));

  Caption := RMLoadStr(rmRes + 390);
  TabSheet1.Caption := RMLoadStr(rmRes + 391);
  GroupBox2.Caption := RMLoadStr(rmRes + 392);
  rdbPortrait.Caption := RMLoadStr(rmRes + 393);
  rdbLandscape.Caption := RMLoadStr(rmRes + 394);
  lblPaperSize.Caption := RMLoadStr(rmRes + 395);
  Label1.Caption := RMLoadStr(rmRes + 396);
  Label2.Caption := RMLoadStr(rmRes + 397);
  TabSheet2.Caption := RMLoadStr(rmRes + 398);
  Label3.Caption := RMLoadStr(rmRes + 400);
  Label4.Caption := RMLoadStr(rmRes + 401);
  Label5.Caption := RMLoadStr(rmRes + 402);
  Label6.Caption := RMLoadStr(rmRes + 403);
  chkUseMargins.Caption := RMLoadStr(rmRes + 404);
  TabSheet3.Caption := RMLoadStr(rmRes + 405);
  GroupBox1.Caption := RMLoadStr(rmRes + 406);
  chkPrintToPrevPage.Caption := RMLoadStr(rmRes + 407);
  chkUnlimitedHeight.Caption := RMLoadStr(rmRes + 413);
  GroupBox5.Caption := RMLoadStr(rmRes + 408);
  Label7.Caption := RMLoadStr(rmRes + 409);
  Label8.Caption := RMLoadStr(rmRes + 410);
  TabSheet4.Caption := RMLoadStr(rmRes + 411);
  lblPaperTray.Caption := RMLoadStr(rmRes + 412);
  btnOk.Caption := RMLoadStr(SOk);
  btnCancel.Caption := RMLoadStr(SCancel);
  chkPrintToDefault.Caption := RMLoadStr(rmRes + 372);
  chkDoublePass.Caption := RMLoadStr(rmRes + 374);
  lblPrinterName.Caption := RMLoadStr(rmRes + 371);
  chkTaoda.Caption := RMLoadStr(rmRes + 375);
  grbPreview.Caption := RMLoadStr(rmRes + 399);
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
    edtMarginTop.Text := FloatToStrF(FPageSetting.MarginTop / 10, ffGeneral, 3, 0);
    edtMarginBottom.Text := FloatToStrF(FPageSetting.MarginBottom / 10, ffGeneral, 3, 0);
    edtMarginLeft.Text := FloatToStrF(FPageSetting.MarginLeft / 10, ffGeneral, 3, 0);
    edtMarginRight.Text := FloatToStrF(FPageSetting.MarginRight / 10, ffGeneral, 3, 0);

    edtColumns.Text := IntToStr(FPageSetting.ColCount);
    edtColumnSpace.Text := FloatToStrF(FPageSetting.ColGap / 10, ffGeneral, 3, 0);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -