📄 exampleprintjob.pas
字号:
(* GREATIS PRINT SUITE *)
(* Copyright (C) 2001-2007 Greatis Software *)
(* web: http://www.greatis.com *)
(* support: http://greatis.com/bteam.html *)
unit ExamplePrintJob;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
PSJob;
type
TExamplePrintJob = class(TCustomPrintJob)
private
{ Private declarations }
// let's add new feature - font choosing
FFont: TFont;
procedure SetFont(const Value: TFont);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawArea(TheCanvas: TCanvas; PageIndex: Integer; Rect: TRect; Area: TDrawArea; Target: TDrawTarget); override;
published
{ Published declarations }
property Font: TFont read FFont write SetFont;
property PageCount;
end;
procedure Register;
implementation
procedure TExamplePrintJob.SetFont(const Value: TFont);
begin
// realization of the access method for Font property
FFont.Assign(Value);
// we must update print job after font changing
Update;
end;
constructor TExamplePrintJob.Create(AOwner: TComponent);
begin
// calling inherited constructor
inherited;
// initializing properties
with Margins do
begin
Left:=1;
Top:=1;
Right:=1;
Bottom:=1;
end;
MarginsUnits:=unInches;
Title:='Custom Print Job Demo';
Options:=[joMargins];
// creating internal font object
FFont:=TFont.Create;
with FFont do
begin
// setting default font properties
Name:='Arial';
Size:=200;
Style:=[fsBold];
end;
end;
destructor TExamplePrintJob.Destroy;
begin
// destroying font object
FFont.Free;
// calling inherited destructor
inherited;
end;
procedure TExamplePrintJob.DrawArea(TheCanvas: TCanvas; PageIndex: Integer; Rect: TRect; Area: TDrawArea; Target: TDrawTarget);
var
S: string;
begin
if Area=daPage then
with Rect,TheCanvas do
begin
// drawing page rectangle
Rectangle(Left,Top,Right,Bottom);
// assigning Self.Font properties to Canvas.Font
Font.Assign(FFont);
// drawing page centered text
S:=IntToStr(PageIndex);
TextOut(
(Left+Right-TextWidth(S)) div 2,
(Top+Bottom-TextHeight(S)) div 2,
S);
end;
end;
procedure Register;
begin
RegisterComponents('PS Examples', [TExamplePrintJob]);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -