pdftypes.pas

作者:Takeshi Kanno. PowerPdf是一款制作PDF文档的VCL控件。使用上和QuickReport类似。

{*
 * << P o w e r P d f >> -- PdfTypes.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.
 *
 * Create 2001.03.10
 *
 *}
unit PdfTypes;

interface

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

uses
  SysUtils, Classes, Windows
{$IFNDEF NOZLIB}
  ,Zlib;
{$ELSE}
  ;
{$ENDIF}

const
{$IFNDEF NOZLIB}
  USE_ZLIB = true;
{$ELSE}
  USE_ZLIB = false;
{$ENDIF}

  POWER_PDF_VERSION_TEXT = 'PowerPdf version 0.8兝';

  {*
   * 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;

  {*
   * Const for xref entry.
   *}
  PDF_IN_USE_ENTRY = 'n';
  PDF_FREE_ENTRY = 'f';
  PDF_MAX_GENERATION_NUM = 65535;

  {*
   * 6A61 means ASCII code "ja".
   * UNICode string in Info object is consists of "FEFF" + "001B" +
   * <language identifiers> + "001B".
   *}
  PDF_LANG_STRING_JP = '6A61';
  PDF_UNICODE_HEADER = 'FEFF001B' + PDF_LANG_STRING_JP + '001B';

  {*
   * 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_MAX_HORIZONTALSCALING = 300;

  PDF_ENTRY_CLOSED = 0;
  PDF_ENTRY_OPENED = 1;

  CRLF = #13#10;
  LF = #10;

type
  TPdfObjectType = (otDirectObject,
                    otIndirectObject,
                    otVirtualObject);

  {*
   * object manager is virtual class to manage instance of indirectobject
   *}
  TPdfObject = class;
  TPdfObjectMgr = class(TPersistent)
  public
    procedure AddObject(AObject: TPdfObject); virtual; abstract;
    function GetObject(ObjectID: integer): TPdfObject; virtual; abstract;
  end;

  {*
   * objects declaration.
   *}
  TPdfObject = class(TPersistent)
  private
    FObjectType: TPdfObjectType;
    FObjectNumber: integer;
    FGenerationNumber: integer;
  protected
    procedure InternalWriteStream(const AStream: TStream); virtual;
  public
    procedure SetObjectNumber(Value: integer);
    constructor Create; virtual;
    procedure WriteToStream(const AStream: TStream);
    procedure WriteValueToStream(const AStream: TStream);
    property ObjectNumber: integer read FObjectNumber;
    property GenerationNumber: integer read FGenerationNumber;
    property ObjectType: TPdfObjectType read FObjectType;
  end;

  TPdfVirtualObject = class(TPdfObject)
  public
    constructor Create; override;
    constructor CreateVirtual(AObjectId: integer);
  end;

  TPdfNumber = class(TPdfObject)
  private
    FValue: integer;
  protected
    procedure InternalWriteStream(const AStream: TStream); override;
  public
    constructor CreateNumber(AValue: Integer);
    property Value: integer read FValue write FValue;
  end;

  TPdfReal = class(TPdfObject)
  private
    FValue: double;
  protected
    procedure InternalWriteStream(const AStream: TStream); override;
  public
    constructor CreateReal(AValue: double);
    property Value: double read FValue write FValue;
  end;

  TPdfString = class(TPdfObject)
  private
    FValue: string;
   protected
    procedure InternalWriteStream(const AStream: TStream); override;
  public
    constructor CreateString(AValue: string);
    property Value: string read FValue write FValue;
  end;

  TPdfText = class(TPdfObject)
  private
    FValue: string;
  protected
    procedure InternalWriteStream(const AStream: TStream); override;
  public
    constructor CreateText(AValue: string);
    property Value: String read FValue write FValue;
  end;

  TPdfName = class(TPdfObject)
  private
    FValue: string;
    function EscapeName(const Value: string): string;
  protected
    procedure InternalWriteStream(const AStream: TStream); override;
  public
    constructor CreateName(AValue: string);
    property Value: String read FValue write FValue;
  end;

  TPdfArray = class(TPdfObject)
  private
    FArray: TList;
    FObjectMgr: TPdfObjectMgr;
    function GetItems(Index: integer): TPdfObject;
    function GetItemCount: integer;
  protected
    procedure InternalWriteStream(const AStream: TStream); override;
  public
    constructor CreateArray(AObjectMgr: TPdfObjectMgr);
    constructor CreateNumArray(AObjectMgr: TPdfObjectMgr; AArray: array of Integer);
    destructor Destroy; override;
    procedure AddItem(AItem: TPdfObject);
    function FindName(AName: string): TPdfName;
    function RemoveName(AName: string): boolean;
    property Items[Index: integer]: TPdfObject read GetItems;
    property ItemCount: integer read GetItemCount;
    property ObjectMgr: TPdfObjectMgr read FObjectMgr;
  end;

  TPdfDictionaryElement = class(TObject)
  private
    FKey: TPdfName;
    FValue: TPdfObject;
    FIsInternal: boolean;
    function GetKey: string;
  public
    constructor Create(AKey: string; AValue: TPdfObject);
    constructor CreateAsInternal(AKey: string; AValue: TPdfObject; AVoid: Pointer);
    destructor Destroy; override;
    property Key: string read GetKey;
    property Value: TPdfObject read FValue;
    property IsInternal: boolean read FIsInternal;
  end;

  TPdfDictionary = class(TPdfObject)
  private
    FArray: TList;
    FObjectMgr: TPdfObjectMgr;
    function GetItems(Index: integer): TPdfDictionaryElement;
    function GetItemCount: integer;
  protected
    procedure InternalWriteStream(const AStream: TStream); override;
  public
    constructor CreateDictionary(AObjectMgr: TPdfObjectMgr);
    destructor Destroy; override;
    function ValueByName(AKey: string): TPdfObject;
    function PdfNumberByName(AKey: string): TPdfNumber;
    function PdfTextByName(AKey: string): TPdfText;
    function PdfRealByName(AKey: string): TPdfReal;
    function PdfStringByName(AKey: string): TPdfString;
    function PdfNameByName(AKey: string): TPdfName;
    function PdfDictionaryByName(AKey: string): TPdfDictionary;
    function PdfArrayByName(AKey: string): TPdfArray;
    procedure AddItem(AKey: string; AValue: TPdfObject);
    procedure AddNumberItem(AKey: string; AValue: Integer);
    procedure AddNameItem(AKey: string; AValue: string);
    procedure AddInternalItem(AKey: string; AValue: TPdfObject);
    procedure RemoveItem(AKey: string);
    property Items[Index: integer]: TPdfDictionaryElement read GetItems;
    property ItemCount: integer read GetItemCount;
    property ObjectMgr: TPdfObjectMgr read FObjectMgr;
  end;

  TPdfStream = class(TPdfObject)
  private
    FAttributes: TPdfDictionary;
    FStream: TStream;
  protected
    procedure InternalWriteStream(const AStream: TStream); override;
  public
    constructor CreateStream(AObjectMgr: TPdfObjectMgr);
    destructor Destroy; override;
    property Attributes: TPdfDictionary read FAttributes;
    property Stream: TStream read FStream;
  end;

  TPdfDate = string;

  TPdfXObject = class(TPdfStream);
  TPdfOutlines = class(TPdfDictionary);
  TPdfOutlineEntry = class(TPdfDictionary);

  EPdfInvalidValue = class(Exception);
  EPdfInvalidOperation = class(Exception);

  {*
   * utility functions.
   *}
  procedure _WriteString(const Value: string; AStream: TStream);
  function _StrToUnicodeHex(const Value: string): string;
  function _StrToHex(const Value: string): string;
  function _HasMultiByteString(const Value: string): boolean;
  function _DateTimeToPdfDate(ADate: TDateTime): TPdfDate;
  function _PdfDateToDateTime(AText: TPdfDate): TDateTime;
  function _EscapeText(const Value: string): string;
  function _GetTypeOf(ADictionary: TPdfDictionary): string;

implementation

{TPdfObject}

constructor TPdfObject.Create;
begin
  FObjectNumber := -1;
  FGenerationNumber := 0;
end;

procedure TPdfObject.SetObjectNumber(Value: integer);
begin
  // If object number is more then zero, the object is considered that indirect
  // object. otherwise, the object is considered that direct object.
  FObjectNumber := Value;
  if Value > 0 then
    FObjectType := otIndirectObject
  else
    FObjectType := otDirectObject;
end;

procedure TPdfObject.InternalWriteStream(const AStream: TStream);
begin
  // Abstruct method
end;

procedure TPdfObject.WriteToStream(const AStream: TStream);
var
  S: string;
begin
  // Write object to specified stream. If object is indirect object then write
  // references to stream.
  if FObjectType = otDirectObject then
    InternalWriteStream(AStream)
  else
  begin
    S := IntToStr(FObjectNumber) +
         ' ' +
         IntToStr(FGenerationNumber) +
         ' R';
    _WriteString(S, AStream);
  end;
end;

procedure TPdfObject.WriteValueToStream(const AStream: TStream);
var
  S: string;
begin
  // Write indirect object to specified stream. this method called by parent
  // object.
  if FObjectType <> otIndirectObject then
    raise EPdfInvalidOperation.Create('');
  S := IntToStr(FObjectNumber) +
       ' ' +
       IntToStr(FGenerationNumber) +
       ' obj' + 
       CRLF;
  _WriteString(S, AStream);
  InternalWriteStream(AStream);
  S := CRLF +
       'endobj' +
       #13#10;
  _WriteString(S, AStream);
end;

{ PdfVirtualObject }

constructor TPdfVirtualObject.Create;
begin
  raise Exception.Create('VirtualObject must be create by CreateVirtual method.');
end;

constructor TPdfVirtualObject.CreateVirtual(AObjectId: integer);
begin
  inherited Create;
  FObjectNumber := AObjectId;
  FObjectType := otVirtualObject;
end;

{ TPdfNumber }

procedure TPdfNumber.InternalWriteStream(const AStream: TStream);
begin
  _WriteString(IntToStr(FValue), AStream);
end;

constructor TPdfNumber.CreateNumber(AValue: integer);
begin
  Create;
  Value := AValue;
end;

{ TPdfReal }
procedure TPdfReal.InternalWriteStream(const AStream: TStream);
begin
  _WriteString(FloatToStr(FValue), AStream);
end;

constructor TPdfReal.CreateReal(AValue: double);
begin
  Create;
  Value := AValue;
end;

{ TPdfString }

procedure TPdfString.InternalWriteStream(const AStream: TStream);
var
  S: string;
begin
  // if the value has multibyte character, convert the value to hex code.
  // otherwise, escape characters.
  if _HasMultiByteString(FValue) then
    S := '<' + _StrToHex(FValue) + '>'
  else
    S := '(' + _EscapeText(FValue) + ')';
  _WriteString(S, AStream);
end;

constructor TPdfString.CreateString(AValue: string);
begin
  Create;
  Value := AValue;
end;

{ TPdfText }

procedure TPdfText.InternalWriteStream(const AStream: TStream);
var
  S: string;
begin
  // if the value has multibyte character, convert the value to hex unicode.
  // otherwise, escape characters.
  if _HasMultiByteString(FValue) then
    S := '<' + PDF_UNICODE_HEADER + _StrToUnicodeHex(FValue) + '>'
  else
    S := '(' + _EscapeText(FValue) + ')';
  _WriteString(S, AStream);
end;

constructor TPdfText.CreateText(AValue: string);
begin
  Create;
  Value := AValue;
end;

{ TPdfName }

function TPdfName.EscapeName(const Value: string): string;
const
  EscapeChars = ['%','(',')','<','>','[',']','{','}','/','#'];
var
  i: integer;
begin
  //  If text contains chars to need escape, replace text using <#> + hex value.
  result := '';
  for i := 1 to Length(Value) do
  begin
    if (Value[i] in EscapeChars) or
      (#33 > Value[i]) or
      (#126 < Value[i]) then
      result := result + '#'+ IntToHex(Ord(Value[i]), 02)
    else
      result := result + Value[i];
  end;
end;

procedure TPdfName.InternalWriteStream(const AStream: TStream);
var
  S: string;
begin
  // the name consists of </> + sequence of characters.
  S := '/' + EscapeName(FValue);
  _WriteString(S, AStream);
end;

constructor TPdfName.CreateName(AValue: string);
begin
  Create;
  Value := AValue;
end;

{ TPdfArray }