📄 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;
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 + -