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

📄 exampleprintjob.pas

📁 GREATIS Print Suite Pro for Delphi (3-7,2005,2006,2007) and C++ Builder (3-6) Set of components for
💻 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 + -