pdfdoc.pas

给PDF文件加盖印章或背景

    property Attribute: TPdfCanvasAttribute read FAttr;
    property Contents: TPdfStream read FContents;
    property Page: TPdfDictionary read GetPage;
    property Doc: TPdfDoc read GetDoc;
    property PageWidth: integer read GetPageWidth write SetPageWidth;
    property PageHeight: integer read GetPageHeight write SetPageHeight;
  end;

  TPdfDictionaryWrapper = class(TPersistent)
  private
    FData: TPdfDictionary;
    function GetHasData: boolean;
  protected
    procedure SetData(AData: TPdfDictionary); virtual;
  public
    property Data: TPdfDictionary read FData write SetData;
    property HasData: boolean read GetHasData;
  end;

  TPdfInfo = class(TPdfDictionaryWrapper)
  private
    function GetAuthor: string;
    procedure SetAuthor(Value: string);
    function GetCreationDate: TDateTime;
    procedure SetCreationDate(Value: TDateTime);
    function GetCreator: string;
    procedure SetCreator(Value: string);
    function GetKeywords: string;
    procedure SetKeywords(Value: string);
    function GetSubject: string;
    procedure SetSubject(Value: string);
    function GetTitle: string;
    procedure SetTitle(Value: string);
    function GetModDate: TDateTime;
    procedure SetModDate(Value: TDateTime);
  public
    property Author: string read GetAuthor write SetAuthor;
    property CreationDate: TDateTime read GetCreationDate write SetCreationDate;
    property Creator: string read GetCreator write SetCreator;
    property Keywords: string read GetKeywords write SetKeywords;
    property ModDate: TDateTime read GetModDate write SetModDate;
    property Subject: string read GetSubject write SetSubject;
    property Title: string read GetTitle write SetTitle;
  end;

  TPdfCatalog = class(TPdfDictionaryWrapper)
  private
    FOpenAction: TPdfDestination;
    procedure SetPageLayout(Value: TPdfPageLayout);
    procedure SetPageMode(Value: TPdfPageMode);
    procedure SetNonFullScreenPageMode(Value: TPdfPageMode);
    procedure SetViewerPreference(Value: TPdfViewerPreferences);
    procedure SetPages(APage: TPdfDictionary);
    function GetPageLayout: TPdfPageLayout;
    function GetPageMode: TPdfPageMode;
    function GetNonFullScreenPageMode: TPdfPageMode;
    function GetViewerPreference: TPdfViewerPreferences;
    function GetPages: TPdfDictionary;
  protected
    procedure SaveOpenAction;
  public
    property OpenAction: TPdfDestination read FOpenAction write FOpenAction;
    property PageLayout: TPdfPageLayout read GetPageLayout write SetPageLayout;
    property NonFullScreenPageMode: TPdfPageMode
                  read GetNonFullScreenPageMode write SetNonFullScreenPageMode;
    property PageMode: TPdfPageMode read GetPageMode write SetPageMode;
    property ViewerPreference: TPdfViewerPreferences
                         read GetViewerPreference write SetViewerPreference;
    property Pages: TPdfDictionary read GetPages write SetPages;
  end;

  TPdfFont = class(TPdfDictionaryWrapper)
  private
    FName: string;
  protected
    procedure AddStrElements(ADic: TPdfDictionary; ATable: array of TPDF_STR_TBL);
    procedure AddIntElements(ADic: TPdfDictionary; ATable: array of TPDF_INT_TBL);
  public
    constructor Create(AXref: TPdfXref; AName: string); virtual;
    function GetCharWidth(AText: string; APos: integer): integer; virtual;
    property Name: string read FName;
  end;

  TPdfDestination = class(TObject)
  private
    FDoc: TPdfDoc;
    FPage: TPdfDictionary;
    FType: TPdfDestinationType;
    FValues: array[0..3] of Integer;
    FZoom: Single;
    FReference: TObject;
    procedure SetElement(Index: integer; Value: Integer);
    procedure SetZoom(Value: Single);
    function GetElement(Index: integer): Integer;
    function GetPageWidth: Integer;
    function GetPageHeight: Integer;
  public
    constructor Create(APdfDoc: TPdfDoc);
    destructor Destroy; override;
    function GetValue: TPdfArray;
    property DestinationType: TPdfDestinationType read FType write FType;
    property Doc: TPdfDoc read FDoc;
    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 PageHeight: Integer read GetPageHeight;
    property PageWidth: Integer read GetPageWidth;
    property Zoom: Single read FZoom write SetZoom;
    property Reference: TObject read FReference write FReference;
  end;

  TPdfOutlineEntry = class(TPdfDictionaryWrapper)
  private
    FParent: TPdfOutlineEntry;
    FNext: TPdfOutlineEntry;
    FPrev: TPdfOutlineEntry;
    FFirst: TPdfOutlineEntry;
    FLast: TPdfOutlineEntry;
    FDest: TPdfDestination;
    FDoc: TPdfDoc;
    FTitle: string;
    FOpened: boolean;
    FCount: integer;
    FReference: TObject;
  protected
    constructor CreateEntry(AParent: TPdfOutlineEntry); virtual;
    procedure Save; virtual;
  public
    destructor Destroy; override;
    function AddChild: TPdfOutlineEntry;
    property Doc: TPdfDoc read FDoc;
    property Parent: TPdfOutlineEntry read FParent;
    property Next: TPdfOutlineEntry read FNext;
    property Prev: TPdfOutlineEntry read FPrev;
    property First: TPdfOutlineEntry read FFirst;
    property Last: TPdfOutlineEntry read FLast;
    property Dest: TPdfDestination read FDest write FDest;
    property Title: string read FTitle write FTitle;
    property Opened: boolean read FOpened write FOpened;
    property Reference: TObject read FReference write FReference;
  end;

  TPdfOutlineRoot = class(TPdfOutlineEntry)
  protected
    constructor CreateRoot(ADoc: TPdfDoc); virtual;
  public
    procedure Save; override;
  end;

implementation

uses PdfGBFonts;

{ Utility functions }

// _Pages_AddKids
procedure _Pages_AddKids(AParent: TPdfDictionary; AKid: TPdfDictionary);
var
  FKids: TPdfArray;
begin
  // adding page object to the parent pages object.
  FKids := AParent.PdfArrayByName('Kids');
  FKids.AddItem(AKid);
  AParent.PdfNumberByName('Count').Value := FKids.ItemCount;
end;

// _Page_GetResources
function _Page_GetResources(APage: TPdfDictionary; AName: string): TPdfDictionary;
var
  FResources: TPdfDictionary;
begin
  FResources := APage.PdfDictionaryByName('Resources');
  Result := FResources.PdfDictionaryByName(AName);
end;

{ TPdfHeader }

// WriteToStream
procedure TPdfHeader.WriteToStream(const AStream: TStream);
begin
  _WriteString('%PDF-1.2 '#13#10, AStream);
end;

{ TPdfTrailer }

// WriteToStream
procedure TPdfTrailer.WriteToStream(const AStream: TStream);
begin
  _WriteString('trailer' + CRLF, AStream);
  FAttributes.WriteToStream(AStream);
  _WriteString(CRLF + 'startxref' + CRLF, AStream);
  _WriteString(IntToStr(FXrefAddress) + CRLF, AStream);
  _WriteString('%%EOF' + CRLF, AStream);
end;

// Create
constructor TPdfTrailer.Create(AObjectMgr: TPdfObjectMgr);
begin
  inherited Create;
  FAttributes := TPdfDictionary.CreateDictionary(AObjectMgr);
  FAttributes.AddItem('Size', TPdfNumber.CreateNumber(0));
end;

// Destroy
destructor TPdfTrailer.Destroy;
begin
  FAttributes.Free;
  inherited;
end;

{ TPdfXrefEntry }

// Create
constructor TPdfXrefEntry.Create(AValue: TPdfObject);
begin
  FByteOffset := -1;
  if AValue <> nil then
  begin
    FEntryType := PDF_IN_USE_ENTRY;
    FGenerationNumber := AValue.GenerationNumber;
    FValue := AValue;
  end
  else
  begin
    FEntryType := PDF_FREE_ENTRY;
    FGenerationNumber := 0;
  end;
end;

// Destroy
destructor TPdfXrefEntry.Destroy;
begin
  if FEntryType = PDF_IN_USE_ENTRY then
    FValue.Free;
  inherited;
end;

// GetAsString
function TPdfXrefEntry.GetAsString: string;
  function FormatIntToString(Value: integer; Len: integer): string;
  var
    S: string;
    i, j: integer;
  begin
    Result := '';
    if Value < 0 then
      S := '0'
    else
      S := IntToStr(Value);
    i := Len - Length(S);
    for j := 0 to i - 1 do
      Result := Result + '0';
    Result := Result + S;
  end;
begin
  Result := FormatIntToString(FByteOffset, 10) +
            ' ' +
            FormatIntToString(FGenerationNumber, 5) +
            ' ' +
            FEntryType;
end;

{ TPdfXref }

// Create
constructor TPdfXref.Create;
var
  RootEntry: TPdfXrefEntry;
begin
  FXrefEntries := TList.Create;
  RootEntry := TPdfXrefEntry.Create(nil);
  RootEntry.GenerationNumber := PDF_MAX_GENERATION_NUM;
  FXrefEntries.Add(RootEntry);
end;

// Destroy
destructor TPdfXref.Destroy;
var
  i: integer;
begin
  for i := 1 to FXrefEntries.Count - 1 do
    GetItem(i).Free;
  FXrefEntries.Free;
  inherited;
end;

// AddObject
procedure TPdfXref.AddObject(AObject: TPdfObject);
var
  ObjectNumber: integer;
  XrefEntry: TPdfXrefEntry;
begin
  // register object to xref table, and set objectnumber.
  if AObject.ObjectType <> otDirectObject then
    raise EPdfInvalidOperation.Create('AddObject --wrong object type.');
  XrefEntry := TPdfXrefEntry.Create(AObject);
  ObjectNumber := FXrefEntries.Add(XrefEntry);
  AObject.SetObjectNumber(ObjectNumber);
end;

// GetItem
function TPdfXref.GetItem(ObjectID: integer): TPdfXrefEntry;
begin
  Result := TPdfXrefEntry(FXrefEntries.Items[ObjectID]);
end;

// GetItemCount
function TPdfXref.GetItemCount: integer;
begin
  Result := FXrefEntries.Count;
end;

// GetObject
function TPdfXref.GetObject(ObjectID: integer): TPdfObject;
begin
  Result := GetItem(ObjectID).Value;
end;

// WriteToStream
procedure TPdfXref.WriteToStream(const AStream: TStream);
var
  i: integer;
  S: string;
  Count: integer;
begin
  Count := FXrefEntries.Count;
  S := 'xref' +
       CRLF +
       '0 ' +
       IntToStr(Count) +
       CRLF;
  for i := 0 to Count - 1 do
    S := S + Items[i].AsString + CRLF;
  _WriteString(S, AStream);
end;

{ TPdfDoc }

// Create
constructor TPdfDoc.Create;
begin
  inherited Create;
  FHasDoc := false;
  FCanvas := TPdfCanvas.Create(Self);
  FDefaultPageWidth := PDF_DEFAULT_PAGE_WIDTH;
  FDefaultPageHeight := PDF_DEFAULT_PAGE_HEIGHT;
  FInfo := nil;
  FRoot := nil;
end;

// GetCanvas
function TPdfDoc.GetCanvas: TPdfCanvas;
begin
  if not HasDoc then
    raise EPdfInvalidOperation.Create('GetCanvas --Document is null');
  Result := FCanvas;
end;

// GetInfo
function TPdfDoc.GetInfo: TPdfInfo;
begin
  if not HasDoc then
    raise EPdfInvalidOperation.Create('GetInfo --this method can not use this state..');
  if FInfo = nil then
    CreateInfo;
  Result := FInfo;
end;

// GetRoot
function TPdfDoc.GetRoot: TPdfCatalog;
begin
  if not HasDoc then
    raise EPdfInvalidOperation.Create('GetRoot --this method can not use this state..');
  Result := FRoot;
end;

// GetOutlineRoot
function TPdfDoc.GetOutlineRoot: TPdfOutlineRoot;
begin
  if not HasDoc then
    raise EPdfInvalidOperation.Create('GetOutlineRoot --document is null..');
  if not UseOutlines then
    raise EPdfInvalidOperation.Create('GetOutlineRoot --not use outline mode..');
  Result := FOutlineRoot;
end;

// Destroy
destructor TPdfDoc.Destroy;
begin
  FreeDoc;
  FCanvas.Free;
  inherited;
end;

// CreateCatalog
function TPdfDoc.CreateCatalog: TPdfDictionary;
begin
  // create catalog object and register to xref.
  Result := TPdfDictionary.CreateDictionary(FXref);
  FXref.AddObject(Result);
  Result.AddItem('Type', TPdfName.CreateName('Catalog'));
  FTrailer.Attributes.AddItem('Root', Result);
end;

// CreateFont
function TPdfDoc.CreateFont(FontName: string): TPdfFont;
var
  PdfFont: TPdfFont;
begin
  // create new font (not regist to xref -- because font object registed by
  // TPdfFont).
  PdfFont := TPdfFont(FindClass(FontName).Create);
  if PdfFont = nil then
    raise Exception.Create('CreateFont --InvalidFontName:' + FontName);
  Result := PdfFont.Create(FXref, FontName);
  Result.Data.AddItem('Name',
    TPdfName.CreateName('F' + IntToStr(FFontList.Count)));
  FFontList.Add(Result);
end;

// RegisterXObject
procedure TPdfDoc.RegisterXObject(AObject: TPdfXObject; AName: string);
begin
   // check object and register it.
   if AObject = nil then
     raise EPdfInvalidValue.Create('RegisterXObject --AObject is null');
   if _GetTypeOf(AObject.Attributes) <> 'XObject' then
     raise EPdfInvalidValue.Create('RegisterXObject --not XObject');
   if AObject.ObjectType <> otIndirectObject then
     FXref.AddObject(AObject);
   if AObject.Attributes.ValueByName('Name') = nil then
   begin
     if GetXObject(AName) <> nil then
       raise EPdfInvalidValue.Createfmt('RegisterXObject --dupulicate name: %s', [AName]);
     FXObjectList.AddItem(AObject);
     AObject.Attributes.AddItem('Name', TPdfName.CreateName(AName));
   end;
end;

// CreateInfo
procedure TPdfDoc.CreateInfo;
var
  FInfoDictionary: TPdfDictionary;
begin
  FInfoDictionary := TPdfDictionary.CreateDictionary(FXref);
  FXref.AddObject(FInfoDictionary);
  FInfoDictionary.AddItem('Producer', TPdfText.CreateText(POWER_PDF_VERSION_TEXT));
  FTrailer.Attributes.AddItem('Info', FInfoDictionary);
  FInfo := TPdfInfo.Create;
  FInfo.SetData(FInfoDictionary);
  FObjectList.Add(FInfo);
end;

// CreatePages
function TPdfDoc.CreatePages(Parent: TPdfDictionary): TPdfDictionary;
begin
  // create pages object and register to xref.
  result := TPdfDictionary.CreateDictionary(FXref);
  FXref.AddObject(Result);
  with Result do
  begin
    AddItem('Type', TPdfName.CreateName('Pages'));
    AddItem('Kids', TPdfArray.CreateArray(FXref));
    AddItem('Count', TPdfNumber.CreateNumber(0));
  end;