embeddedpdftypes.pas

DBDesigner 4 is a database design system that integrates database design, modelling, creation and ma

unit EmbeddedPdfTypes;

//----------------------------------------------------------------------------------------------------------------------
//
// This file is part of fabFORCE EmbeddedPDF.
// Copyright (c) 1999-2001 Takezou. <[e-mail]>
// Copyright (C) 2003 Michael G. Zinner, www.fabFORCE.net
//
// EmbeddedPDF 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
// (at your option) any later version.
//
// EmbeddedPDF 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 EmbeddedPDF; if not, write to the Free Software
// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
//
//----------------------------------------------------------------------------------------------------------------------
//
// Unit PdfTypes.pas
// -----------------
// Version 1.0, 12.09.2003, Mike
// Description
//   Type and Class definitions
//
// Changes:
//   Version 1.0, 12.09.2003, Mike
//     adapted version from Takezou's PowerPDF, Version 0.9 (beta), 2001.09.01
//
//----------------------------------------------------------------------------------------------------------------------

{$I EmbeddedPdfConf.inc}

interface

uses
{$IFNDEF LINUX}Windows, {$ENDIF}
{$IFNDEF NOZLIB}ZLib, {$ENDIF}
  SysUtils, Classes;

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

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

  PDF_ENTRY_CLOSED = 0;
  PDF_ENTRY_OPENED = 1;

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

  PDF_UNICODE_HEADER = 'FEFF001B%s001B';

  PDF_LANG_STRING = 'en';
//  PDF_LANG_STRING = 'jp';

type
  TPdfRect = record
    Left, Top, Right, Bottom: Single;
  end;

  TPdfObjectType = (otDirectObject, otIndirectObject, otVirtualObject);
  TPdfAlignment = (paLeftJustify, paRightJustify, paCenter);

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

  {*
   * objects declaration.
   *}
  TPdfObject = class(TObject)
  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;

  TPdfBoolean = class(TPdfObject)
  private
    FValue: boolean;
  protected
    procedure InternalWriteStream(const AStream: TStream); override;
  public
    constructor CreateBoolean(AValue: Boolean);
    property Value: boolean read FValue write FValue;
  end;

  TPdfNull = class(TPdfObject)
  protected
    procedure InternalWriteStream(const AStream: TStream); override;
  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 PdfBooleanByName(AKey: string): TPdfBoolean;
    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;

  // TPdfBinary is useed to make object which is not defined in PowerPdf.
  TPdfBinary = class(TPdfObject)
  private
    FStream: TStream;
  protected
    procedure InternalWriteStream(const AStream: TStream); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    property Stream: TStream read FStream;
  end;

  TPdfDate = string;

  TPdfXObject = class(TPdfStream);
  TPdfImage = class(TPdfXObject);
  TPdfOutlines = 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;
  function _FloatToStrR(Value: Extended): string;
  function _GetUnicodeHeader: string;
  function _PdfRect(Left, Top, Right, Bottom: Single): TPdfRect;
  function _GetCharCount(Text: string): integer;

implementation

{TPdfObject}

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

// SetObjectNumber
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;

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

// WriteToStream
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;

// WriteValueToStream
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('internal error wrong object type');
  S := IntToStr(FObjectNumber) +
       ' ' +
       IntToStr(FGenerationNumber) +
       ' obj' + 
       CRLF;
  _WriteString(S, AStream);
  InternalWriteStream(AStream);
  S := CRLF +
       'endobj' +
       #13#10;
  _WriteString(S, AStream);
end;

{ PdfVirtualObject }

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

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

{ TPdfNull }

// InternalWriteStream
procedure TPdfNull.InternalWriteStream(const AStream: TStream);
begin
  _WriteString('null', AStream)
end;

{ TPdfBoolean }

// InternalWriteStream
procedure TPdfBoolean.InternalWriteStream(const AStream: TStream);
begin
  if Value then
    _WriteString('true', AStream)
  else
    _WriteString('false', AStream)
end;

// CreateBoolean
constructor TPdfBoolean.CreateBoolean(AValue: Boolean);
begin
  Create;
  Value := AValue;
end;

{ TPdfNumber }

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

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

{ TPdfReal }

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

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

{ TPdfString }

// InternalWriteStream
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;

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

{ TPdfText }

// InternalWriteStream
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 := '<' + _GetUnicodeHeader + _StrToUnicodeHex(FValue) + '>'
  else
    S := '(' + _EscapeText(FValue) + ')';
  _WriteString(S, AStream);
end;

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

{ TPdfName }

// EscapeName
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;

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

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

{ TPdfArray }

// GetItems
function TPdfArray.GetItems(Index: integer): TPdfObject;
begin
  result := TPdfObject(FArray[Index]);
  if result.ObjectType = otVirtualObject then
    if FObjectMgr <> nil then
      result := FObjectMgr.GetObject(result.ObjectNumber)
    else
      result := nil;
end;

// GetItemCount
function TPdfArray.GetItemCount: integer;
begin
  Result := FArray.Count;
end;

// InternalWriteStream
procedure TPdfArray.InternalWriteStream(const AStream: TStream);
var
  i: integer;
begin
  _WriteString('[', AStream);
  for i := 0 to FArray.Count - 1 do
  begin
    TPdfObject(FArray[i]).WriteToStream(AStream);
    _WriteString(' ', AStream);
  end;
  _WriteString(']', AStream);
end;

// CreateArray
constructor TPdfArray.CreateArray(AObjectMgr: TPdfObjectMgr);
begin
  inherited Create;
  FArray := TList.Create;
  FObjectMgr := AObjectMgr;
end;

// CreateNumArray