⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 pdftypes.pas

📁 给PDF文件加盖印章或背景
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{*
 * << P o w e r P d f >> -- PdfTypes.pas
 *
 * Copyright (c) 1999-2001 Takezou. <takeshi_kanno@est.hi-ho.ne.jp>
 *
 * 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.03.10 create.
 * 2001.06.30 added _FloatToStrR method.
 * 2001.07.07 added PdfBoolean object.
 * 2001.07.31 added PdfBinary object.
 * 2001.08.09 moved some constans to PdfDoc.pas.
 * 2001.08.09 changed base class to TObject.
 * 2001.08.19 small changes in TPdfDictiinary and TPdfArray.
 * 2001.09.01 changed some definations and methods to work with kylix.
 *}
unit PdfTypes;

interface

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

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

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 = 'GB';
//  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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -