preport.pas

给PDF文件加盖印章或背景

{*
 * << P o w e r P d f >> -- PReport.pas
 *
 * Copyright (c) 1999-2001 Takezou. <[e-mail]>
 *
 * This library is free software; you can redistribute it and/or modify it
 * under the terms of the GNU Library General Public License as published
 * by the Free Software Foundation; either version 2 of the License, or any
 * later version.
 *
 * This library is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 * FOR A PARTICULAR PURPOSE. See the GNU Library general Public License for more
 * details.
 *
 * You should have received a copy of the GNU Library General Public License
 * along with this library.
 *
 * 2001.01.28 create
 * 2001.06.24 added strech property to TPRImage.
 * 2001.06.30 added chinese font(Experimental).
 *            fixed TPRImage bug.
 *            move TPRText.GetInternalDoc method to TPRItem.
 * 2001.07.20 fixed font setting bugs.
 * 2001.07.25 changed TPRPage text width routines.
 * 2001.08.01 added TPReport.PageLayout.
 * 2001.08.08 changed the algorithm of the free XObject name.
 * 2001.08.10 changed the text width routine(bugs when large font size).
 * 2001.08.15 added TPROutline and TPRDestination.
 * 2001.09.01 changed the implementation of the image.
 * 2001.09.08 added OpenAction function.
 *            added AlignJustified property to TPRLabel.
 * 2001.09.13 added ViewerPreference functions.
 *            added check functions to TPReport.
 *
 *}
unit PReport;

interface

//{$DEFINE USE_JPFONTS}
{$DEFINE USE_GBFONTS}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, PdfDoc, PdfFonts, PdfTypes, PdfImages,PdfGBFonts;

const
  POWER_PDF_VERSION_STR = POWER_PDF_VERSION_TEXT;
  POWER_PDF_COPYRIGHT = 'copyright (c) 1999-2001 takeshi kanno';

type
  TPRFontName = (fnFixedWidth
               , fnArial
               , fnTimesRoman
               {$IFDEF USE_JPFONTS}
               , fnGothic
               , fnMincyo
               , fnPGothic
               , fnPMincyo
               {$ELSE}
               {$IFDEF USE_GBFONTS}
               , fnChinese
               {$ENDIF}
               {$ENDIF}
               );
  TPRPage = class;
  TPRCanvas = class;
  TPRPanel = class;
  TPRItem = class;
  TPROutlineEntry = class;
  TPRDestination = class;
  TPROutlineRoot = class;

  TPRPrintPageEvent = procedure(Sender: TObject;
                              ACanvas: TPRCanvas) of object;
  TPRPrintPanelEvent = procedure(Sender: TObject; ACanvas: TPRCanvas;
                              Rect: TRect) of object;
  TPRPrintItemEvent = TPRPrintPanelEvent;
  TPRPrintChildPanelEvent = procedure(Sender: TObject; ACanvas: TPRCanvas;
                              ACol, ARow: integer; Rect: TRect) of object;
  TPrintDirection = (pdHorz, pdVert);
  TPRDestinationType = TPdfDestinationType;
  TPRPageLayout = TPdfPageLayout;
  TPRPageMode = TPdfPageMode;
  TPRCompressionMethod = TPdfCompressionMethod;
  TPRViewerPreference = TPdfViewerPreference;
  TPRViewerPreferences = TPdfViewerPreferences;

  { TPReport }
  TPReport = class(TAbstractPReport)
  private
    FFileName: string;
    FPage: integer;
    FAuthor: string;
    FCreationDate: TDateTime;
    FCreator: string;
    FKeywords: string;
    FModDate: TDateTime;
    FSubject: string;
    FTitle: string;
    FCanvas: TPRCanvas;
    FDoc: TPdfDoc;
    FPageMode: TPRPageMode;
    FNonFullScreenPageMode: TPRPageMode;
    FPageLayout: TPRPageLayout;
    FCompressionMethod: TPRCompressionMethod;
    FUseOutlines: boolean;
    FOutlineRoot: TPROutlineRoot;
    FOpenAction: TPRDestination;
    FViewerPreference: TPRViewerPreferences;
    procedure SetOpenAction(ADest: TPRDestination);
    procedure SetAuthor(Value: string);
    procedure SetCreationDate(Value: TDateTime);
    procedure SetCreator(Value: string);
    procedure SetKeyWords(Value: string);
    procedure SetModDate(Value: TDateTime);
    procedure SetSubject(Value: string);
    procedure SetTitle(Value: string);
    procedure SetPageLayout(Value: TPRPageLayout);
    procedure SetPageMode(Value: TPRPageMode);
    procedure SetNonFullScreenPageMode(Value: TPRPageMode);
    procedure SetUseOutlines(Value: boolean);
    procedure SetViewerPreference(Value: TPRViewerPreferences);
    function GetOpenAction: TPRDestination;
    function GetOutlineRoot: TPROutlineRoot;
  protected
    { Protected }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BeginDoc;
    procedure Print(APage: TPRPage);
    procedure EndDoc;
    procedure Abort;
    function CreateDestination: TPRDestination;
    function GetPdfDoc: TPdfDoc;
    property PageNumber: integer read FPage;
    property OutlineRoot: TPROutlineRoot read GetOutlineRoot;
    property OpenAction: TPRDestination read GetOpenAction write SetOpenAction;
  published
    property FileName: string read FFileName write FFileName;
    property Author: string read FAuthor write SetAuthor;
    property CreationDate: TDateTime read FCreationDate write SetCreationDate;
    property Creator: string read FCreator write SetCreator;
    property Keywords: string read FKeyWords write SetKeyWords;
    property ModDate: TDateTime read FModDate write SetModDate;
    property Subject: string read FSubject write SetSubject;
    property Title: string read FTitle write SetTitle;
    property PageLayout: TPRPageLayout read FPageLayout
                           write SetPageLayout default plSinglePage;
    property PageMode: TPRPageMode read FPageMode
                           write SetPageMode default pmUseNone;
    property NonFullScreenPageMode: TPRPageMode read FNonFullScreenPageMode
                           write SetNonFullScreenPageMode default pmUseNone;
    property CompressionMethod: TPRCompressionMethod
       read FCompressionMethod write FCompressionMethod default cmNone;
    property UseOutlines: boolean read FUseOutlines write SetUseOutlines;
    property ViewerPreference: TPRViewerPreferences
                           read FViewerPreference write SetViewerPreference;
  end;

  { TPRCanvas }
  TPRCanvas = class(TPersistent)
  private
    FCanvas: TPdfCanvas;
    procedure SetPdfCanvas(ACanvas: TPdfCanvas);
    function GetPageHeight: integer;
    function GetPageWidth: integer;
  protected
  public
    constructor Create;
    function TextWidth(Text: string): Single;
    procedure SetCharSpace(charSpace: Single);
    procedure SetWordSpace(wordSpace: Single);
    procedure SetHorizontalScaling(hScaling: Word);
    procedure SetLeading(leading: Single);
    procedure SetFont(fontname: string; size: Single);
    procedure SetTextRenderingMode(mode: TTextRenderingMode);
    procedure SetTextRise(rise: Word);
    procedure TextOut(X, Y: Single; Text: string);
    procedure TextRect(ARect: TRect; Text: string;
                            Alignment: TAlignment; Clipping: boolean);
    property PdfCanvas: TPdfCanvas read FCanvas write SetPdfCanvas;
    property PageHeight: integer read GetPageHeight;
    property PageWidth: integer read GetPageWidth;
  end;

  { TPRPage }
  TPRPage = class(TCustompanel)
  private
    FDoc: TPdfDoc;
    FMarginTop: integer;
    FMarginLeft: integer;
    FMarginRight: integer;
    FMarginBottom: integer;
    FPrintPageEvent: TPRPrintPageEvent;
    procedure SetMarginTop(Value: integer);
    procedure SetMarginLeft(Value: integer);
    procedure SetMarginRight(Value: integer);
    procedure SetMarginBottom(Value: integer);
  protected
    procedure AlignControls(AControl: TControl; var ARect: TRect); override;
    procedure Paint; override;
    procedure Print(ACanvas: TPRCanvas);
    property InternalDoc: TPdfDoc read FDoc;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnPrintPage: TPRPrintPageEvent
                     read FPrintPageEvent write FPrintPageEvent;
    property MarginTop: integer read FMarginTop write SetMarginTop;
    property MarginLeft: integer read FMarginLeft write SetMarginLeft;
    property MarginRight: integer read FMarginRight write SetMarginRight;
    property MarginBottom: integer read FMarginBottom write SetMarginBottom;
    property Visible;
  end;

  { TPRPanel }
  TPRPanel = class(TCustomPanel)
  private
    function GetPage: TPRPage;
    function GetAbsoluteRect: TRect;
  protected
    procedure Paint; override;
    procedure Print(ACanvas: TPRCanvas; ARect: TRect); virtual;
  public
    property Page: TPRPage read GetPage;
    constructor Create(AOwner: TComponent); override;
  end;

  { TPRChildPanel }
  TPRChildPanel = class(TPRPanel)
  private
  protected
  end;

  { TPRLayoutPanel }
  TPRLayoutPanel = class(TPRPanel)
  private
    FAfterPrint: TPRPrintPanelEvent;
    FBeforePrint: TPRPrintPanelEvent;
  protected
    procedure SetParent(AParent: TWinControl); override;
    procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
  published
    property Align;
    property BeforePrint: TPRPrintPanelEvent
                                read FBeforePrint write FBeforePrint;
    property AfterPrint: TPRPrintPanelEvent
                                read FAfterPrint write FAfterPrint;
  end;

  { TRRGridPanel }
  TPRGridPanel = class(TPRPanel)
  private
    FAfterPrint: TPRPrintPanelEvent;
    FBeforePrint: TPRPrintPanelEvent;
    FBeforePrintChild: TPRPrintChildPanelEvent;
    FAfterPrintChild: TPRPrintChildPanelEvent;
    FColCount: integer;
    FRowCount: integer;
    FChildPanel: TPRChildPanel;
    FPrintDirection: TPrintDirection;
    procedure SetColCount(Value: integer);
    procedure SetRowCount(Value: integer);
  protected
    procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure AlignControls(AControl: TControl; var ARect: TRect); override;
    procedure Paint; override;
    procedure SetParent(AParent: TWinControl); override;
    function GetChildParent: TComponent; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ColCount: integer read FColCount write SetColCount;
    property RowCount: integer read FRowCount write SetRowCount;
    property Align;
    property PrintDirection: TPrintDirection
                        read FPrintDirection write FPrintDirection default pdHorz;
    property BeforePrint: TPRPrintPanelEvent
                        read FBeforePrint write FBeforePrint;
    property AfterPrint: TPRPrintPanelEvent
                        read FAfterPrint write FAfterPrint;
    property BeforePrintChild: TPRPrintChildPanelEvent
                        read FBeforePrintChild write FBeforePrintChild;
    property AfterPrintChild: TPRPrintChildPanelEvent
                        read FAfterPrintChild write FAfterPrintChild;
  end;

  { TPRItem }
  TPRItem = class(TGraphicControl)
  private
    FPrintable: boolean;
    function GetPage: TPRPage;
  protected
    procedure SetParent(AParent: TWinControl); override;
    procedure Print(ACanvas: TPRCanvas; ARect: TRect); virtual;
    function GetInternalDoc: TPdfDoc;
    property Page: TPRPage read GetPage;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Align;
    property Printable: boolean read FPrintable write FPrintable default true;
  end;

  { TPRCustomLabel }
  TPRCustomLabel = class(TPRItem)
  private
    FFontColor: TColor;
    FFontName: TPRFontName;
    FFontSize: Single;
    FFontBold: boolean;
    FFontItalic: boolean;
    FCharSpace: Single;
    FWordSpace: Single;
    procedure SetCharSpace(Value: Single);
    procedure SetWordSpace(Value: Single);
    procedure SetFontColor(Value: TColor);
    function GetFontClassName: string;
    procedure SetFontName(Value: TPRFontName);
    procedure SetFontItalic(Value: boolean);
    procedure SetFontBold(Value: boolean);
    procedure SetFontSize(Value: Single);
  protected
    function InternalTextout(APdfCanvas: TPdfCanvas;
                        S: string; X, Y: integer): Single;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property FontColor: TColor read FFontColor write SetFontColor default clBlack;
    property FontName: TPRFontName read FFontName write SetFontName;
    property FontSize: Single read FFontSize write SetFontSize;
    property FontBold: boolean read FFontBold write SetFontBold default false;
    property FontItalic: boolean read FFontItalic write SetFontItalic default false;
    property CharSpace: Single read FCharSpace write SetCharSpace;
    property WordSpace: Single read FWordSpace write SetWordSpace;
  end;

  { TPRLabel }
  TPRLabel = class(TPRCustomLabel)
  private
    FAlignment: TAlignment;
    FClipping: boolean;
    FAlignJustified: boolean;
    procedure SetAlignment(Value: TAlignment);
    procedure SetAlignJustified(Value: boolean);
    procedure SetCanvasProperties(ACanvas: TPdfCanvas);
  protected
    procedure Paint; override;
    procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
  published
    function GetTextWidth: Single;
    property Caption;
    property Clipping: boolean read FClipping write FClipping default false;
    property Alignment: TAlignment read FAlignment
                     write SetAlignment default taLeftJustify;
    property AlignJustified: boolean read FAlignJustified write SetAlignJustified default false;
  end;

  { TPRText }
  TPRText = class(TPRCustomLabel)
  private
    FWordwrap: boolean;
    FLeading: Single;
    FLines: TStrings;
    procedure SetLeading(Value: Single);
    procedure SetWordwrap(Value: boolean);
    procedure SetLines(Value: TStrings);
    procedure SetText(Value: string);
    function GetText: string;
    function GetLines: TStrings;
  protected
    procedure Paint; override;
    procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Text: string read GetText write SetText;
  published
    property Leading: Single read FLeading write SetLeading;
    property Lines: TStrings read GetLines write SetLines;
    property WordWrap: boolean read FWordWrap write SetWordwrap default false;
  end;

  { TPRShape }
  TPRShape = class(TPRItem)
  private
    FLineWidth: Single;
    FLineColor: TColor;
    FLineStyle: TPenStyle;
    FFillColor: TColor;
    procedure SetLineColor(Value: TColor);
    procedure SetFillColor(Value: TColor);
    procedure SetLineWidth(Value: Single);
    procedure SetLineStyle(Value: TPenStyle);
  protected
    procedure SetDash(ACanvas: TPdfCAnvas; APattern: TPenStyle);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property LineWidth: Single read FLineWidth write SetLineWidth;
    property LineColor: TColor read FLineColor write SetLineColor default clBlack;
    property LineStyle: TPenStyle read FLineStyle write SetLineStyle;
    property FillColor: TColor read FFillColor write SetFillColor default clNone;
  end;

  { TPRRect }
  TPRRect = class(TPRShape)
  protected
    procedure Paint; override;
    procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
  end;

  { TPREllipse }
  TPREllipse = class(TPRShape)
  protected
    procedure Paint; override;
    procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
  end;

  { TPRImage }
  TPRImage = class(TPRItem)
  private
    procedure SetStretch(Value: boolean);
  protected
    FPicture: TPicture;
    FSharedImage: boolean;
    FStretch: boolean;
    procedure SetPicture(Value: TPicture); virtual;
    procedure Paint; override;
    procedure Print(ACanvas: TPRCanvas; ARect: TRect); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Picture: TPicture read FPicture write SetPicture;
    property SharedImage: boolean read FSharedImage write FSharedImage;
    property Stretch: boolean read FStretch write SetStretch default true;
  end;

  { TPRDestination }
  TPRDestination = class(TObject)
  private
    FData: TPdfDestination;
    procedure SetType(Value: TPRDestinationType);
    function GetType: TPRDestinationType;
    procedure SetElement(Index: integer; Value: Integer);
    procedure SetZoom(Value: Single);
    function GetElement(Index: integer): Integer;
    function GetZoom: Single;
  protected
    constructor Create(AData: TPdfDestination);
  public
    property Data: TPdfDestination read FData;
    property DestinationType: TPRDestinationType read GetType write SetType;
    property Left: Integer index 0 read GetElement write SetElement;
    property Top: Integer index 1 read GetElement write SetElement;
    property Right: Integer index 2 read GetElement write SetElement;
    property Bottom: Integer index 3 read GetElement write SetElement;
    property Zoom: Single read GetZoom write SetZoom;
  end;

  { TPROutlineEntry }
  TPROutlineEntry = class(TObject)
  private
    FData: TPdfOutlineEntry;
    function GetParent: TPROutlineEntry;
    function GetNext: TPROutlineEntry;
    function GetPrev: TPROutlineEntry;
    function GetFirst: TPROutlineEntry;
    function GetLast: TPROutlineEntry;
    function GetDest: TPRDestination;
    function GetTitle: string;
    function GetOpened: boolean;
    procedure SetDest(Value: TPRDestination);
    procedure SetTitle(Value: string);
    procedure SetOpened(Value: boolean);
  public
    function AddChild: TPROutlineEntry;
    property Parent: TPROutlineEntry read GetParent;
    property Next: TPROutlineEntry read GetNext;