vpdfobjects.pas

生成PDF文档的控件

{*******************************************************}
{                                                       }
{       This unit is part of the VISPDF VCL library.    }
{       Written by R.Husske - ALL RIGHTS RESERVED.      }
{                                                       }
{       Copyright (C) 2000-2009, www.vispdf.com         }
{                                                       }
{       e-mail: [e-mail]                      }
{       http://www.vispdf.com                           }
{                                                       }
{*******************************************************}

unit VPDFObjects;

interface

{$I VisPDFLib.inc }

uses
  SysUtils, Classes, Graphics;

type
  TVPDFObjectType = (otBoolean, otNumeric, otString, otName, otArray, otDictionary, otStream, otNull, otLink);

  TVPDF_SIZES = record
    width: integer;
    heigh: integer;
  end;

  IndexedChar = record
    CharCode: boolean;
    Index: Integer;
  end;

  TVPDFObjectNumber = record
    ObjectNumber: Integer;
    GenerationNumber: Integer;
  end;

  TVPDFObject = class(TObject)
  public
    ID: TVPDFObjectNumber;
    FParent: TVPDFObject;
    IsIndirect: boolean;
    IsDeleted: boolean;
    ObjectType: TVPDFObjectType;
    destructor Destroy; override;
  end;

  PVPDFObject = ^TVPDFObject;

  TVPDFDictionaryItem = record
    Key: AnsiString;
    Value: TVPDFObject;
  end;

  TVPDFCopyStructItem = record
    ObjectNumber: TVPDFObjectNumber;
    ObjectBody: TVPDFObject;
  end;

  PVPDFDictionaryItem = ^TVPDFDictionaryItem;

  TVPDFNullObject = class(TVPDFObject)
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TVPDFBooleanObject = class(TVPDFObject)
  public
    Value: boolean;
    constructor Create(Parent: TVPDFObject);
    destructor Destroy; override;
  end;

  TVPDFNumericObject = class(TVPDFObject)
  public
    Value: Single;
    constructor Create(Parent: TVPDFObject);
    destructor Destroy; override;
  end;

  TVPDFStringObject = class(TVPDFObject)
  public
    Value: AnsiString;
    IsHexadecimal: boolean;
    constructor Create(Parent: TVPDFObject);
    destructor Destroy; override;
  end;

  TVPDFNameObject = class(TVPDFObject)
  public
    Value: AnsiString;
    constructor Create(Parent: TVPDFObject);
    destructor Destroy; override;
  end;

  TVPDFArrayObject = class(TVPDFObject)
  public
    Length: Integer;
    Items: TList;
    constructor Create(Parent: TVPDFObject);
    destructor Destroy; override;
    function GetIndexedItem(Index: Integer): TVPDFObject;
    procedure SetIndexedItem(Index: Integer; ValObject: TVPDFObject);
    procedure AddBooleanValue(Value: boolean);
    procedure AddObject(ValObject: TVPDFObject);
    procedure AddNameValue(Value: AnsiString);
    procedure AddStringValue(Value: AnsiString);
    procedure AddNumericValue(Value: Single);
  end;

  TVPDFDictionaryObject = class(TVPDFObject)
  private
  public
    Length: Integer;
    Items: TList;
    function GetIndexedKey(Index: Integer): AnsiString;
    function GetIndexedItem(Index: Integer): TVPDFObject;
    function FindValue(Key: AnsiString): Integer;
    procedure AddValue(Key: AnsiString; Value: TVPDFObject);
    procedure AddNameValue(Key: AnsiString; Value: AnsiString);
    procedure AddStringValue(Key: AnsiString; Value: AnsiString);
    procedure AddNumericValue(Key: AnsiString; Value: Single);
    procedure AddBooleanValue(Key: AnsiString; Value: boolean);
    procedure ReplaceValue(Key: AnsiString; Value: TVPDFObject);
    procedure DeleteValue(Key: AnsiString);
    constructor Create(Parent: TVPDFObject);
    destructor Destroy; override;
  end;

  TVPDFStreamObject = class(TVPDFObject)
  private
    function GetLength: Integer;
    procedure SetLength(const Value: Integer);
  public
    Dictionary: TVPDFDictionaryObject;
    Stream: TStream;
    constructor Create(Parent: TVPDFObject);
    destructor Destroy; override;
    property Length: Integer read GetLength write SetLength;
  end;

  TVPDFLink = class(TVPDFObject)
  public
    Value: TVPDFObjectNumber;
    constructor Create;
    destructor Destroy; override;
  end;

  TVPDFDictArrItem = record
    PageObj: TVPDFDictionaryObject;
    PageLink: TVPDFObjectNumber;
    ItemIndex: Integer;
    IsIndexed: boolean;
  end;

implementation

{ TVPDFDictionaryObject }

procedure TVPDFDictionaryObject.AddBooleanValue(Key: AnsiString;
  Value: boolean);
var
  NmTmp: TVPDFBooleanObject;
begin
  NmTmp := TVPDFBooleanObject.Create(Self);
  NmTmp.Value := Value;
  AddValue(key, NmTmp);
end;

procedure TVPDFDictionaryObject.AddNameValue(Key: AnsiString; Value: AnsiString);
var
  NmTmp: TVPDFNameObject;
begin
  NmTmp := TVPDFNameObject.Create(Self);
  NmTmp.Value := Value;
  AddValue(key, NmTmp);
end;

procedure TVPDFDictionaryObject.AddNumericValue(Key: AnsiString; Value: Single);
var
  NmTmp: TVPDFNumericObject;
begin
  NmTmp := TVPDFNumericObject.Create(Self);
  NmTmp.Value := Value;
  AddValue(key, NmTmp);
end;

procedure TVPDFDictionaryObject.AddStringValue(Key: AnsiString; Value: AnsiString);
var
  NmTmp: TVPDFStringObject;
begin
  NmTmp := TVPDFStringObject.Create(Self);
  NmTmp.Value := Value;
  AddValue(key, NmTmp);
end;

procedure TVPDFDictionaryObject.AddValue(Key: AnsiString; Value: TVPDFObject);
var
  ValInd: Integer;
  OBLink: TVPDFLink;
  OValue: TVPDFObject;
  PItem: PVPDFDictionaryItem;
begin
  if (Value = nil) then exit;
  ValInd := FindValue(Key);
  if (ValInd >= 0) then
  begin
    PItem := Items.Items[ValInd];
    OValue := PItem.Value;
    OValue.Free;
    if (Value.IsIndirect) then
    begin
      OBLink := TVPDFLink.Create;
      OBLink.Value.ObjectNumber := Value.ID.ObjectNumber;
      OBLink.Value.GenerationNumber := Value.ID.GenerationNumber;
      PItem.Value := OBLink;
    end
    else
      PItem.Value := Value;
  end
  else
  begin
    if (Value.IsIndirect) then
    begin
      OBLink := TVPDFLink.Create;
      OBLink.Value.ObjectNumber := Value.ID.ObjectNumber;
      OBLink.Value.GenerationNumber := Value.ID.GenerationNumber;
      OValue := OBLink;
    end
    else
      OValue := Value;
    New(PItem);
    PItem^.Key := Key;
    PItem^.Value := OValue;
    Items.Add(PItem);
  end;
end;

constructor TVPDFDictionaryObject.Create(Parent: TVPDFObject);
begin
  ObjectType := otDictionary;
  FParent := Parent;
  Items := TList.Create;
  IsDeleted := false;
end;

destructor TVPDFDictionaryObject.Destroy;
var
  I: Integer;
  PItem: PVPDFDictionaryItem;
begin
  for I := 0 to Items.Count - 1 do
  begin
    PItem := Items.Items[I];
    if TVPDFObject(PItem^.Value).ObjectType = otDictionary then
      TVPDFDictionaryObject(PItem^.Value).Free
    else
      if TVPDFObject(PItem^.Value).ObjectType = otArray
        then TVPDFArrayObject(PItem^.Value).Free
      else
        if TVPDFObject(PItem^.Value).ObjectType = otStream
          then TVPDFStreamObject(PItem^.Value).Free
        else
          TObject(PItem^.Value).Free;
    Dispose(PItem);
  end;
  Items.Free;
  inherited;
end;

function TVPDFDictionaryObject.FindValue(Key: AnsiString): Integer;
var
  I: Integer;
  LCKey: AnsiString;
  PItem: PVPDFDictionaryItem;
begin
  result := -1;
  for I := 0 to Items.Count - 1 do
  begin
    PItem := Items.Items[I];
    LCKey := PItem^.Key;
    if (LowerCase(String(LCKey)) = LowerCase(String(Key))) then
    begin
      Result := I;
      Exit;
    end;
  end;
end;

function TVPDFDictionaryObject.GetIndexedItem(Index: Integer): TVPDFObject;
var
  PItem: PVPDFDictionaryItem;
begin
  PItem := Items.Items[Index];
  result := PItem^.Value;
end;

function TVPDFDictionaryObject.GetIndexedKey(Index: Integer): AnsiString;
var
  PItem: PVPDFDictionaryItem;
begin
  PItem := Items.Items[Index];
  result := PItem^.Key;
end;

procedure TVPDFDictionaryObject.ReplaceValue(Key: AnsiString; Value: TVPDFObject);
var
  Index: Integer;
  PItem: PVPDFDictionaryItem;
begin
  Index := FindValue(Key);
  if (Index >= 0) then
  begin
    PItem := Items.Items[Index];
    if TVPDFObject(PItem^.Value).ObjectType = otDictionary then
      TVPDFDictionaryObject(PItem^.Value).Free
    else
      if TVPDFObject(PItem^.Value).ObjectType = otArray
        then TVPDFArrayObject(PItem^.Value).Free
      else
        if TVPDFObject(PItem^.Value).ObjectType = otStream
          then TVPDFStreamObject(PItem^.Value).Free
        else
          TObject(PItem^.Value).Free;
    Dispose(PItem);
    Items.Delete(Index);
  end;
  AddValue(Key, Value);
end;

procedure TVPDFDictionaryObject.DeleteValue(Key: AnsiString);
var
  Index: Integer;
  PItem: PVPDFDictionaryItem;
begin
  Index := FindValue(Key);
  if (Index >= 0) then
  begin
    PItem := Items.Items[Index];
    if TVPDFObject(PItem^.Value).ObjectType = otDictionary then
      TVPDFDictionaryObject(PItem^.Value).Free
    else
      if TVPDFObject(PItem^.Value).ObjectType = otArray
        then TVPDFArrayObject(PItem^.Value).Free
      else
        if TVPDFObject(PItem^.Value).ObjectType = otStream
          then TVPDFStreamObject(PItem^.Value).Free
        else
          TObject(PItem^.Value).Free;
    Dispose(PItem);          
    Items.Delete(Index);
  end;
end;

{ TVPDFStreamObject }

constructor TVPDFStreamObject.Create(Parent: TVPDFObject);
begin
  ObjectType := otStream;
  FParent := Parent;
  IsDeleted := false;
  Dictionary := TVPDFDictionaryObject.Create(Self);
  Stream := TMemoryStream.Create;
end;

destructor TVPDFStreamObject.Destroy;
begin
  Dictionary.Free;
  Stream.Free;
  inherited;
end;

function TVPDFStreamObject.GetLength: Integer;
var
  I: Integer;
  LenObj: TVPDFObject;
begin
  I := Dictionary.FindValue('Length');
  if I >= 0 then
  begin
    LenObj := Dictionary.GetIndexedItem(I);
    Result := Round(TVPDFNumericObject(LenObj).Value);
  end
  else
    raise Exception.Create('This stream without a length item');
end;

procedure TVPDFStreamObject.SetLength(const Value: Integer);
var
  I: Integer;
  LenObj: TVPDFObject;
begin
  I := Dictionary.FindValue('Length');
  if I >= 0 then
  begin
    LenObj := Dictionary.GetIndexedItem(I);
    TVPDFNumericObject(LenObj).Value := Value;
  end
  else
    raise Exception.Create('This stream without a length item');
end;

{ TVPDFNullObject }

constructor TVPDFNullObject.Create;
begin
  ObjectType := otNull;
  IsDeleted := false;
end;

destructor TVPDFNullObject.Destroy;
begin
  inherited;
end;

{ TVPDFBooleanObject }

constructor TVPDFBooleanObject.Create(Parent: TVPDFObject);
begin
  FParent := Parent;
  ObjectType := otBoolean;
  IsDeleted := false;
end;

destructor TVPDFBooleanObject.Destroy;
begin
  inherited;
end;


{ TVPDFNumericObject }

constructor TVPDFNumericObject.Create(Parent: TVPDFObject);
begin
  FParent := Parent;
  ObjectType := otNumeric;
  IsDeleted := false;
end;

destructor TVPDFNumericObject.Destroy;
begin
  inherited;
end;

{ TVPDFStringObject }

constructor TVPDFStringObject.Create(Parent: TVPDFObject);
begin
  FParent := Parent;
  ObjectType := otString;
  IsDeleted := false;
end;

destructor TVPDFStringObject.Destroy;
begin
  inherited;
end;

{ TVPDFNameObject }

constructor TVPDFNameObject.Create(Parent: TVPDFObject);
begin
  FParent := Parent;
  ObjectType := otName;
  IsDeleted := false;
end;

destructor TVPDFNameObject.Destroy;
begin
  inherited;
end;

{ TVPDFArrayObject }

procedure TVPDFArrayObject.AddNameValue(Value: AnsiString);
var
  NmTmp: TVPDFNameObject;
begin
  NmTmp := TVPDFNameObject.Create(Self);
  NmTmp.Value := Value;
  AddObject(NmTmp);
end;

procedure TVPDFArrayObject.AddNumericValue(Value: Single);
var
  NmTmp: TVPDFNumericObject;
begin
  NmTmp := TVPDFNumericObject.Create(Self);
  NmTmp.Value := Value;
  AddObject(NmTmp);
end;

procedure TVPDFArrayObject.AddBooleanValue(Value: boolean);
var
  NmTmp: TVPDFBooleanObject;
begin
  NmTmp := TVPDFBooleanObject.Create(Self);
  NmTmp.Value := Value;
  AddObject(NmTmp);
end;

procedure TVPDFArrayObject.AddObject(ValObject: TVPDFObject);
var
  OBLink: TVPDFLink;
  OValue: TVPDFObject;
begin
  if (ValObject = nil) then exit;
  if (ValObject.IsIndirect) then
  begin
    OBLink := TVPDFLink.Create;
    OBLink.Value.ObjectNumber := ValObject.ID.ObjectNumber;
    OBLink.Value.GenerationNumber := ValObject.ID.GenerationNumber;
    OValue := OBLink;
  end
  else
    OValue := ValObject;
  Items.Add(OValue);
end;

procedure TVPDFArrayObject.SetIndexedItem(Index: Integer;
  ValObject: TVPDFObject);
var
  OBLink: TVPDFLink;
  OValue: TVPDFObject;
begin
  if (ValObject.IsIndirect) then
  begin
    OBLink := TVPDFLink.Create;
    OBLink.Value.ObjectNumber := ValObject.ID.ObjectNumber;
    OBLink.Value.GenerationNumber := ValObject.ID.GenerationNumber;
    OValue := OBLink;
  end
  else
    OValue := ValObject;
  Items.Insert(Index, OValue);
end;

procedure TVPDFArrayObject.AddStringValue(Value: AnsiString);
var
  NmTmp: TVPDFStringObject;
begin
  NmTmp := TVPDFStringObject.Create(Self);
  NmTmp.Value := Value;
  AddObject(NmTmp);
end;

constructor TVPDFArrayObject.Create(Parent: TVPDFObject);
begin
  Length := 0;
  FParent := Parent;
  ObjectType := otArray;
  Items := TList.Create;
end;

destructor TVPDFArrayObject.Destroy;
var
  I: Integer;
begin
  for I := 0 to Items.Count - 1 do
  begin
    TVPDFObject(Items.Items[I]).Free;
  end;
  Items.Free;
  inherited;
end;

function TVPDFArrayObject.GetIndexedItem(Index: Integer): TVPDFObject;
begin
  result := TVPDFObject(Items.Items[Index]);
end;

{ TVPDFLink }

constructor TVPDFLink.Create;
begin
  ObjectType := otLink;
  IsDeleted := false;
end;

destructor TVPDFLink.Destroy;
begin
  inherited;
end;


{ TVPDFObject }

destructor TVPDFObject.Destroy;
begin
  inherited;
end;

end.