pdfdoc.pas

给PDF文件加盖印章或背景

{*
 * << P o w e r P d f >> -- PdfDoc.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.
 *
 * 2000.09.10 create.
 * 2001.06.30 move FloatToStrR method to PdfTypes.pas.
 * 2001.07.01 implemented text annotation.
 * 2001.07.10 move TPDF_STR_TBL and TPDF_INT_TBL defination to top (for BCB).
 * 2001.07.21 changed TPdfDictionaryWrapper's properties(Data and HasData) to
 *            public.
 * 2001.07.28 fixed bug of TPdfCanvas.SetPage.
 * 2001.08.01 added TPdfCatalog.PageLayout
 * 2001.08.09 moved some constans from PdfTypes.pas.
 * 2001.08.12 changed the implementation of outlines.
 * 2001.08.12 changed the implementation of annotation.
 * 2001.08.18 added GetNextWord routine.
 * 2001.08.18 changed the parameter of MoveToTextPoint routine.
 * 2001.08.20 added Text utility routines.
 * 2001.08.20 added Leading property to TPdfCanvasAttribute.
 * 2001.08.22 change the method name MesureText to MeasureText(Spelling mistake :-)
 * 2001.08.26 changed some definations and methods to work with kylix.
 * 2001.09.01 changed the implementation of the image.
 * 2001.09.08 added OpenAction function.
 *            change AddAnnotation method to CreateAnnotation.
 * 2001.09.13 added ViewerPreference functions.
 *}
unit PdfDoc;

interface

// if use "FlateDecode" compression, comment out the next line.
// (this unit and PdfTypes.pas)
{$DEFINE NOZLIB}

uses
  SysUtils, Classes, PdfTypes
  {$IFDEF LINUX}
  , Types
  {$ELSE}
  , Windows
  {$ENDIF}
  ;

const
  POWER_PDF_VERSION_TEXT = 'PowerPdf version 0.9';

  {*
   * PreDefined page size
   *}
  PDF_PAGE_WIDTH_A4 = 596;
  PDF_PAGE_HEIGHT_A4 = 842;

  {*
   * Dafault page size.
   *}
  PDF_DEFAULT_PAGE_WIDTH = PDF_PAGE_WIDTH_A4;
  PDF_DEFAULT_PAGE_HEIGHT = PDF_PAGE_HEIGHT_A4;

  {*
   * collection of flags defining various characteristics of the font.
   *}
  PDF_FONT_FIXED_WIDTH = 1;
  PDF_FONT_SERIF       = 2;
  PDF_FONT_SYMBOLIC    = 4;
  PDF_FONT_SCRIPT      = 8;
  // Reserved          = 16
  PDF_FONT_STD_CHARSET = 32;
  PDF_FONT_ITALIC      = 64;
  // Reserved          = 128
  // Reserved          = 256
  // Reserved          = 512
  // Reserved          = 1024
  // Reserved          = 2048
  // Reserved          = 4096
  // Reserved          = 8192
  // Reserved          = 16384
  // Reserved          = 32768
  PDF_FONT_ALL_CAP     = 65536;
  PDF_FONT_SMALL_CAP   = 131072;
  PDF_FONT_FOURCE_BOLD = 262144;

  PDF_DEFAULT_FONT = 'Arial';
  PDF_DEFAULT_FONT_SIZE = 10;

  PDF_MIN_HORIZONTALSCALING = 10;
  PDF_MAX_HORIZONTALSCALING = 300;
  PDF_MAX_WORDSPACE = 300;
  PDF_MIN_CHARSPACE = -30;
  PDF_MAX_CHARSPACE = 300;
  PDF_MAX_FONTSIZE = 300;
  PDF_MAX_ZOOMSIZE = 10;
  PDF_MAX_LEADING = 300;

  PDF_PAGE_LAYOUT_NAMES: array[0..3] of string = ('SinglePage',
                                                  'OneColumn',
                                                  'TwoColumnLeft',
                                                  'TwoColumnRight');

  PDF_PAGE_MODE_NAMES: array[0..3] of string = ('UseNone',
                                                'UseOutlines',
                                                'UseThumbs',
                                                'FullScreen');

  PDF_ANNOTATION_TYPE_NAMES: array[0..12] of string = ('Text',
                                                      'Link',
                                                      'Sound',
                                                      'FreeText',
                                                      'Stamp',
                                                      'Square',
                                                      'Circle',
                                                      'StrikeOut',
                                                      'Highlight',
                                                      'Underline',
                                                      'Ink',
                                                      'FileAttachment',
                                                      'Popup');

  PDF_DESTINATION_TYPE_NAMES: array[0..7] of string = ('XYZ',
                                                       'Fit',
                                                       'FitH',
                                                       'FitV',
                                                       'FitR',
                                                       'FitB',
                                                       'FitBH',
                                                       'FitBV');

type
  {*
   * The pagemode determines how the document should appear when opened.
   *}
  TPdfPageMode = (pmUseNone,
                  pmUseOutlines,
                  pmUseThumbs,
                  pmFullScreen);

  {*
   * The line cap style specifies the shape to be used at the ends of open
   * subpaths when they are stroked.
   *}
  TLineCapStyle = (lcButt_End,
                   lcRound_End,
                   lcProjectingSquareEnd);

  {*
   * The line join style specifies the shape to be used at the corners of paths
   * that are stroked.
   *}
  TLineJoinStyle = (ljMiterJoin,
                    ljRoundJoin,
                    ljBevelJoin);

  {*
   * The text rendering mode determines whether text is stroked, filled, or used
   * as a clipping path.
   *}
  TTextRenderingMode = (trFill,
                        trStroke,
                        trFillThenStroke,
                        trInvisible,
                        trFillClipping,
                        trStrokeClipping,
                        trFillStrokeClipping,
                        trClipping);

  {*
   * The annotation types determines the valid annotation subtype of TPdfDoc.
   *}
  TPdfAnnotationSubType = (asTextNotes,
                           asLink);

  {*
   * The TPdfDestinationType determines default user space coordinate system of
   * Explicit destinations.
   *}
  TPdfDestinationType = (dtXYZ,
                        dtFit,
                        dtFitH,
                        dtFitV,
                        dtFitR,
                        dtFitB,
                        dtFitBH,
                        dtFitBV);

  {*
   * TPdfPageLayout specifying the page layout to be used when the document is
   * opened:
   *}
  TPdfPageLayout = (plSinglePage,
                    plOneColumn,
                    plTwoColumnLeft,
                    plTwoColumnRight);


  TPdfViewerPreference = (vpHideToolbar,
                          vpHideMenubar,
                          vpHideWindowUI,
                          vpFitWindow,
                          vpCenterWindow);
  TPdfViewerPreferences = set of TPdfViewerPreference;

  {$IFDEF NOZLIB}
  TPdfCompressionMethod = (cmNone);
  {$ELSE}
  TPdfCompressionMethod = (cmNone, cmFlateDecode);
  {$ENDIF}

  TPdfColor = -$7FFFFFFF-1..$7FFFFFFF;
  TXObjectID = integer;

  TPDF_STR_TBL = record
    KEY: string;
    VAL: string;
  end;
  TPDF_INT_TBL = record
    KEY: string;
    VAL: integer;
  end;

  TPdfHeader = class(TObject)
  protected
    procedure WriteToStream(const AStream: TStream);
  end;

  TPdfTrailer = class(TObject)
  private
    FAttributes: TPdfDictionary;
    FXrefAddress: integer;
  protected
    procedure WriteToStream(const AStream: TStream);
  public
    constructor Create(AObjectMgr: TPdfObjectMgr);
    destructor Destroy; override;
    property XrefAddress: integer read FXrefAddress write FXrefAddress;
    property Attributes: TPdfDictionary read FAttributes;
  end;

  TPdfXrefEntry = class(TObject)
  private
    FEntryType: string;
    FByteOffset: integer;
    FGenerationNumber: integer;
    FValue: TPdfObject;
    function GetAsString: string;
  public
    constructor Create(AValue: TPdfObject);
    destructor Destroy; override;
    property EntryType: string read FEntryType write FEntryType;
    property ByteOffset: integer read FByteOffSet write FByteOffset;
    property GenerationNumber: integer
                          read FGenerationNumber write FGenerationNumber;
    property AsString: string read GetAsString;
    property Value: TPdfObject read FValue;
  end;

  TPdfXref = class(TPdfObjectMgr)
  private
    FXrefEntries: TList;
    function GetItem(ObjectID: integer): TPdfXrefEntry;
    function GetItemCount: integer;
  protected
    procedure WriteToStream(const AStream: TStream);
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddObject(AObject: TPdfObject); override;
    function GetObject(ObjectID: integer): TPdfObject; override;
    property Items[ObjectID: integer]: TPdfXrefEntry read GetItem;
    property ItemCount: integer read GetItemCount;
  end;

  TPdfCanvas = class;
  TPdfInfo = class;
  TPdfCatalog = class;
  TPdfFont = class;
  TPdfDestination = class;
//  TPdfLink = class;
  TPdfOutlineEntry = class;
  TPdfOutlineRoot = class;
  TAbstractPReport = class(TComponent);

  TPdfDoc = class(TObject)
  private
    FRoot: TPdfCatalog;
    FCurrentPages: TPdfDictionary;
    FCanvas: TPdfCanvas;
    FHeader: TPdfHeader;
    FTrailer: TPdfTrailer;
    FXref: TPdfXref;
    FInfo: TPdfInfo;
    FHasDoc: boolean;
    FFontList: TList;
    FObjectList: TList;
    FOutlineRoot: TPdfOutlineRoot;
    FXObjectList: TPdfArray;
    FDefaultPageWidth: Word;
    FDefaultPageHeight: Word;
    FCompressionMethod: TPdfCompressionMethod;
    FUseOutlines: boolean;
    function GetCanvas: TPdfCanvas;
    function GetInfo: TPdfInfo;
    function GetRoot: TPdfCatalog;
    function GetOutlineRoot: TPdfOutlineRoot;
  protected
    procedure CreateInfo;
    procedure CreateOutlines;
    function CreateCatalog: TPdfDictionary;
    function CreateFont(FontName: string): TPdfFont;
    function CreatePages(Parent: TPdfDictionary): TPdfDictionary;
  public
    procedure RegisterXObject(AObject: TPdfXObject; AName: string);
    constructor Create;
    destructor Destroy; override;
    procedure NewDoc;
    procedure FreeDoc;
    procedure AddPage;
    procedure AddXObject(AName: string; AXObject: TPdfXObject);
    procedure SaveToStream(AStream: TStream);
    procedure SetVirtualMode;
    function GetFont(FontName: string): TPdfFont;
    function GetXObject(AName: string): TPdfXObject;
    function CreateAnnotation(AType: TPdfAnnotationSubType; ARect: TPdfRect): TPdfDictionary;
    function CreateDestination: TPdfDestination;
    property HasDoc: boolean read FHasDoc;
    property Canvas: TPdfCanvas read GetCanvas;
    property Info: TPdfInfo read GetInfo;
    property Root: TPdfCatalog read GetRoot;
    property OutlineRoot: TPdfOutlineRoot read GetOutlineRoot;
    property DefaultPageWidth: word read FDefaultPageWidth write FDefaultPageWidth;
    property DefaultPageHeight: word read FDefaultPageHeight write FDefaultPageHeight;
    property CompressionMethod: TPdfCompressionMethod
       read FCompressionMethod write FCompressionMethod;
    property UseOutlines: boolean read FUseoutlines write FUseoutlines;
  end;

  TPdfCanvasAttribute = class(TObject)
  private
    FWordSpace: Single;
    FCharSpace: Single;
    FFontSize: Single;
    FFont: TPdfFont;
    FLeading: Single;
    FHorizontalScaling: Word;
    procedure SetWordSpace(Value: Single);
    procedure SetCharSpace(Value: Single);
    procedure SetFontSize(Value: Single);
    procedure SetHorizontalScaling(Value: Word);
    procedure SetLeading(Value: Single);
  public
    function TextWidth(Text: string): Single;
    function MeasureText(Text: string; Width: Single): integer; overload;
    function MeasureText(Text: string; Width: Single;Var atWidth:Single ): integer; overload;

    property WordSpace: Single read FWordSpace write SetWordSpace;
    property CharSpace: Single read FCharSpace write SetCharSpace;
    property HorizontalScaling: Word read FHorizontalScaling
      write SetHorizontalScaling;
    property Leading: Single read FLeading write SetLeading;
    property FontSize: Single read FFontSize write SetFontSize;
    property Font: TPdfFont read FFont write FFont;
  end;

  TPdfCanvas = class(TObject)
  private
    FContents: TPdfStream;
    FPage: TPdfDictionary;
    FPdfDoc: TPdfDoc;
    FAttr: TPdfCanvasAttribute;
    FIsVirtual: boolean;
    procedure SetPageWidth(AValue: integer);
    procedure SetPageHeight(AValue: integer);
    procedure WriteString(S: string);
    function GetDoc: TPdfDoc;
    function GetPage: TPdfDictionary;
    function GetPageWidth: Integer;
    function GetPageHeight: Integer;
    function GetColorStr(Color: TPdfColor): string;
  protected
  public
    constructor Create(APdfDoc: TPdfDoc);
    destructor Destroy; override;

    {* Special Graphics State *}
    procedure GSave;                                             {  q   }
    procedure GRestore;                                          {  Q   }
    procedure Concat(a, b, c, d, e, f: Single);                  {  cm  }

    {* General Graphics State *}
    procedure SetFlat(flatness: Byte);                           {  i   }
    procedure SetLineCap(linecap: TLineCapStyle);                {  J   }
    procedure SetDash(aarray: array of Byte; phase: Byte);       {  d   }
    procedure SetLineJoin(linejoin: TLineJoinStyle);             {  j   }
    procedure SetLineWidth(linewidth: Single);                   {  w   }
    procedure SetMiterLimit(miterlimit: Byte);                   {  M   }

    {* Paths *}
    procedure MoveTo(x, y: Single);                              {  m   }
    procedure LineTo(x, y: Single);                              {  l   }
    procedure CurveToC(x1, y1, x2, y2, x3, y3: Single);          {  c   }
    procedure CurveToV(x2, y2, x3, y3: Single);                  {  v   }
    procedure CurveToY(x1, y1, x3, y3: Single);                  {  y   }
    procedure Rectangle(x, y, width, height: Single);            {  re  }
    procedure Closepath;                                         {  h   }
    procedure NewPath;                                           {  n   }
    procedure Stroke;                                            {  S   }
    procedure ClosePathStroke;                                   {  s   }
    procedure Fill;                                              {  f   }
    procedure Eofill;                                            {  f*  }
    procedure FillStroke;                                        {  B   }
    procedure ClosepathFillStroke;                               {  b   }
    procedure EofillStroke;                                      {  B*  }
    procedure ClosepathEofillStroke;                             {  b*  }
    procedure Clip;                                              {  W   }
    procedure Eoclip;                                            {  W*  }

    {* Test state *}
    procedure SetCharSpace(charSpace: Single);                   {  Tc  }
    procedure SetWordSpace(wordSpace: Single);                   {  Tw  }
    procedure SetHorizontalScaling(hScaling: Word);              {  Tz  }
    procedure SetLeading(leading: Single);                       {  TL  }
    procedure SetFontAndSize(fontname: string; size: Single);    {  Tf  }
    procedure SetTextRenderingMode(mode: TTextRenderingMode);    {  Tr  }
    procedure SetTextRise(rise: Word);                           {  Ts  }
    procedure BeginText;                                         {  BT  }
    procedure EndText;                                           {  ET  }
    procedure MoveTextPoint(tx, ty: Single);                     {  Td  }
    procedure SetTextMatrix(a, b, c, d, x, y: Word);             {  Tm  }
    procedure MoveToNextLine;                                    {  T*  }
    procedure ShowText(s: string);                               {  Tj  }
    procedure ShowTextNextLine(s: string);                       {  '   }

    {* external objects *}
    procedure ExecuteXObject(xObject: string);                   {  Do  }

    {* Device-dependent color space operators *}
    procedure SetRGBFillColor(Value: TPdfColor);                 {  rg  }
    procedure SetRGBStrokeColor(Value: TPdfColor);               {  RG  }

    {* utility routines *}
    procedure SetPage(APage: TPdfDictionary);
    procedure SetFont(AName: string; ASize: Single);
    procedure TextOut(X, Y: Single; Text: string);
    procedure TextRect(ARect: TPdfRect; Text: string;
        Alignment: TPdfAlignment; Clipping: boolean);
    procedure MultilineTextRect(ARect: TPdfRect;
        Text: string; WordWrap: boolean);
    procedure DrawXObject(X, Y, AWidth, AHeight: Single;
        AXObjectName: string);
    procedure DrawXObjectEx(X, Y, AWidth, AHeight: Single;
        ClipX, ClipY, ClipWidth, ClipHeight: Single; AXObjectName: string);
    procedure Ellipse(x, y, width, height: Single);
    function TextWidth(Text: string): Single;
    function MeasureText(Text: string; AWidth: Single): integer;overload;
    function MeasureText(Text: string; AWidth: Single;var atWidth:Single): integer;overload;
    function GetNextWord(const S: string; var Index: integer): string;