vpdfdoc.pas

生成PDF文档的控件

    property DocScale: Extended read FDocScale write FDocScale;
    property Orientation: TVPDFPageOrientation read FOrientation write SetOrientation;
    property Resolution: Integer read FResolution write SetResolution;
    property Size: TVPDFPageSize read FSize write SetPageSize;
    property Width: Single read GetPageWidth write SetPageWidth;
    property Height: Single read GetPageHeight write SetPageHeight;
  end;

  TVPDFPara = class(TObject)
  private
    FParent: TVPDF;
    FJustification: TVPDFJustificationType;
    Indention: Single;
    LeftMargin: Single;
    RightMargin: Single;
    TopMargin: Single;
    BottomMargin: Single;
    procedure InternShowText(Text: AnsiString; var APrText: AnsiString; var APrVax: Single);
    procedure InternShowUnicodeText(Text: WideString; var APrText: WideString; var APrVax: Single);
    procedure SetJustification(const Value: TVPDFJustificationType);
    constructor Create(Parent: TVPDF);
    function GetCurrentLine: Single;
    procedure SetCurrentLine(const Value: Single);
  public
{$IFDEF BCB}
    procedure PrintText(Text: AnsiString);
{$ELSE}
    procedure ShowText(Text: AnsiString);
{$ENDIF}
    procedure ShowUnicodeText(Text: WideString);
    procedure NewLine;
    property Justification: TVPDFJustificationType read FJustification write SetJustification;
    property CurrentLine: Single read GetCurrentLine write SetCurrentLine;
  end;

  TVPDF = class(TComponent)
  private
  {private}
    FAutoAddPage: boolean;
    DocID: AnsiString;
    OwUsPass: AnsiString;
    UsPassStr: AnsiString;
    DocScale: Extended;
    ProtectFlags: Integer;
    FRevision: Integer;
    FCurrentKey: MD5Digest;
    FNewParaLine: boolean;
    FCurrentParagraph: TVPDFPara;
    FPrevParaOffset: Single;
    FCurrentParaLine: Single;
    FCurrentImageIndex: Integer;
    FCurrentFontIndex: Integer;
    FVPChanged: boolean;
    FIsLoaded: boolean;
    FPagesCount: Integer;
    FCurrentPageNum: Integer;
    FDocStarted: boolean;
    FProgress: boolean;
    FIsEncrypted: boolean;
    FEncryprtLink: TVPDFObjectNumber;
    FPageslink: TVPDFObjectNumber;
    FRootLink: TVPDFObjectNumber;
    FInfoLink: TVPDFObjectNumber;
    TrailerObj: TVPDFDictionaryObject;
    FastOpen: AnsiString;
    FastClose: AnsiString;
    FastWillSave: AnsiString;
    FastDidSave: AnsiString;
    FastWillPrint: AnsiString;
    FastDidPrint: AnsiString;
    FPagesIndex: Integer;
    FEncryprtIndex: Integer;
    FRootIndex: Integer;
    FInfoIndex: Integer;
    FInStream: TStream;
    FOutlineRoot: TVPDFDocOutlineObject;
    FXrefLen: Integer;
    FMaxObjNum: Integer;
    FResolution: Integer;
    PageArrPosition: Integer;
    FActivePara: Integer;
    FParas: array of TVPDFParagraph;
    FParaLen: Integer;
    FXref: array of XRefItem;
    PageArr: array of TVPDFDictArrItem;
    CSArray: array of TVPDFCopyStructItem;
    FParentMB: array[0..3] of Single;
    FIsParented: boolean;
    IndirectObjects: TList;
    FAutoLaunch: boolean;
    FShowInfo: boolean;
    FFontEmbedding: boolean;
    FStandardFontEmulation: boolean;
    FProtection: boolean;
    FCreationDate: TDateTime;
    FMemStream: boolean;
    FSubject: AnsiString;
    FTitle: AnsiString;
    FAuthor: AnsiString;
    FOwnerPassword: AnsiString;
    FKeywords: AnsiString;
    FUserPassword: AnsiString;
    FOutputStream: TStream;
    FontNames: array of AnsiString;
    FFileName: TFileName;
    FJpegQuality: TJPEGQualityRange;
    FVersion: TPDFVersType;
    FCurrentPage: TVPDFPage;
    FNEmbeddedFonts: TStringList;
    FCompressionMethod: TVPDFCompressionMethod;
    FCryptKeyType: TVPDFKeyType;
    FPageLayout: TVPDFPageLayout;
    FPageMode: TVPDFPageMode;
    FProtectOption: TVPDFProtectOptions;
    FViewerPreference: TVPDFViewerPreferences;
    XImages: array of TVPDFImageObject;
    FKeepImageAspectRatio: boolean;
    FImageCompressionType: TVPDFImageCompressionType;
    FSizes: array of TVPDF_SIZES;
    OutlineEnsemble: array of TVPDFDocOutlineObject;
    OutlineEnsLen: Integer;
    SamCorrel: boolean;
    procedure LoadUnFlateLZW(RegionStream, StrumStream: TStream; NameObj: AnsiString);
    procedure CreateKeys;
    procedure EnableEncrypt;
    procedure PadTrunc(S: Pointer; SL: Integer; D: Pointer);
    procedure DeleteObj(InObj: TVPDFObject; Recursive: boolean);
    function CrptStr(Data: AnsiString; Password: MD5Digest; PassLength: TVPDFKeyType; ObjID: Integer): AnsiString;
    procedure CrptStrm(Data: TMemoryStream; Password: MD5Digest; PassLength: TVPDFKeyType; ObjID: Integer);
    function CryptString(Data: AnsiString; ID: Integer): AnsiString;
    procedure CryptStream(Data: TMemoryStream; ID: Integer);
    function GetOutlineRoot: TVPDFDocOutlineObject;
    function AddImageFromTIFF(Image: TBitmap; Compression: TVPDFImageCompressionType): Integer;
    function GetCanvas: TCanvas;
    procedure SetOutputStream(const Value: TStream);
    procedure ListExtDictionary(PageObject: TVPDFDictionaryObject; PageLink: TVPDFObjectNumber);
    function CompareObjectID(IDL, IDR: TVPDFObjectNumber): Integer;
    procedure SetAutoLaunch(const Value: Boolean);
    procedure SetCompressionMethod(const Value: TVPDFCompressionMethod);
    procedure SetCryptKeyType(const Value: TVPDFKeyType);
    procedure SetNEmbeddedFont(const Value: TStringList);
    procedure SetPageLayout(const Value: TVPDFPageLayout);
    procedure SetStandardFontEmulation(const Value: boolean);
    function GetObjectByLink(LinkObj: TVPDFLink): TVPDFObject;
    procedure SetCurrentPageNum(const Value: Integer);
  protected
   {protected}
    LinksLen: Integer;
    LinkTable: array of TGenerationArray;
    IsLinearized: boolean;
    function CopyObject(SourceDoc: TVPDF; SourceObj: TVPDFObject): TVPDFObject;
    procedure SetDocImagearray(Width: Integer; Height: Integer);
    procedure SetViewerPreferences(const Value: TVPDFViewerPreferences);
    procedure StreamSaveString(DocStream: TStream; DocSting: AnsiString);
    procedure SetResolution(const Value: Integer);
    procedure CloseIndirectObjects;
    procedure LoadXrefArray;
    function LoadDocString: AnsiString;
    function LoadBackDocString: AnsiString;
    function LoadDocHeader: AnsiString;
    function FontIsEmbedded(FontNm: AnsiString): boolean;
    function CreateIndirectDictionary: TVPDFDictionaryObject;
    function SaveTypeObject(ValObject: TVPDFObject; ObjStream: TStream; IsArrayItem: boolean): Integer;
    function AddTypeObject(ObjType: TVPDFObjectType; IsIndirect: boolean): TVPDFObject;
    function LoadBooleanObject(ObjStream: TStream): TVPDFBooleanObject;
    function LoadNumericObject(ObjStream: TStream): TVPDFNumericObject;
    function LoadStringObject(ObjStream: TStream): TVPDFStringObject;
    function LoadNameObject(ObjStream: TStream): TVPDFNameObject;
    function LoadArrayObject(ObjStream: TStream): TVPDFArrayObject;
    function LoadStreamObject(ObjStream: TStream): TVPDFStreamObject;
    function LoadDictionaryObject(ObjStream: TStream): TVPDFDictionaryObject;
    function LoadLinkObject(ObjStream: TStream): TVPDFLink;
    function SaveObjectValue(ValObject: TVPDFObject; Value: AnsiString; ObjStream: TStream): Integer;
    function SaveNullObject(ValObject: TVPDFNullObject; ObjStream: TStream): Integer;
    function SaveBooleanObject(ValObject: TVPDFBooleanObject; ObjStream: TStream): Integer;
    function SaveNumericObject(ValObject: TVPDFNumericObject; ObjStream: TStream): Integer;
    function SaveStringObject(ValObject: TVPDFStringObject; ObjStream: TStream): Integer;
    function SaveNameObject(ValObject: TVPDFNameObject; ObjStream: TStream): Integer;
    function SaveArrayObject(ValObject: TVPDFArrayObject; ObjStream: TStream): Integer;
    function SaveStreamObject(ValObject: TVPDFStreamObject; ObjStream: TStream): Integer;
    function SaveDictionaryObject(ValObject: TVPDFDictionaryObject; ObjStream: TStream; IsArrayItem: boolean): Integer;
    function SaveLinkObject(ValObject: TVPDFLink; ObjStream: TStream): Integer;
    function MapImage(Image: TGraphic; Compression: TVPDFImageCompressionType;
      IsMask: boolean; MaskIndex: Integer): Integer;
    function LoadIsLinearized: Boolean;
    function GetIsHaveSimpleText: Boolean;
    function GetObjectNumber: TVPDFObjectNumber;
    function GetObjectType(ObjStream: TStream; UseIndirect: boolean): TVPDFObjectType;
    procedure SaveToFile(FileName: TFileName);
    procedure SaveToStream(DocStream: TStream);
  public
    FCHandle: HDC;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
{$IFDEF BCB}
    function AddImage(Image: TGraphic; Compression: TVPDFImageCompressionType;
      IsMask: boolean = False; MaskIndex: Integer = -1): Integer;
    function AddImageFromFile(FileName: TFileName; Compression:
      TVPDFImageCompressionType; IsMask: boolean = False; MaskIndex: Integer =
      -1): Integer;
{$ELSE}
    function AddImage(Image: TGraphic; Compression: TVPDFImageCompressionType;
      IsMask: boolean = False; MaskIndex: Integer = -1): Integer; overload;
    function AddImage(FileName: TFileName; Compression:
      TVPDFImageCompressionType; IsMask: boolean = False; MaskIndex: Integer =
      -1): Integer; overload;
{$ENDIF}
    function AddPage: Integer;
    procedure AddDocumentAttachment(FileName: TFileName; Description: AnsiString);
    procedure CopyPageFromDocument(SourceDoc: TVPDF; SourceIndex: Integer; DestIndex: Integer);
    procedure SetActionScript(ActionType: TVPDFActionScriptType; ActionText: AnsiString);
    procedure DeletePage(PageIndex: Integer);
    procedure SetCurrentPageNumber(const Value: Integer);
    function LoadFromFile(FileName: TFileName): Integer;
    function LoadFromStream(DocStream: TStream): Integer;
    function CreateParagraph(Indention: Single = 0; Justification: TVPDFJustificationType = jtLeft; LeftMargin: Single = 0; RightMargin: Single = 0; TopMargin: Single = 0; BottomMargin: Single = 0): Integer;
    procedure BeginDoc(Initial: boolean = false);
    procedure EndDoc;
    procedure BeginParagraph(Index: Integer);
    procedure EndParagraph;
    procedure AddTiffFromFile(FileName: TFileName; Compression: TVPDFImageCompressionType; PaintType: TTIFFPaintType);
    property IsHaveSimpleText: boolean read GetIsHaveSimpleText;
    property IsEncrypted: boolean read FIsEncrypted;
    property Canvas: TCanvas read GetCanvas; // Only for old version compatibility
    property CurrentParagraph: TVPDFPara read FCurrentParagraph;
    property CurrentPage: TVPDFPage read FCurrentPage;
    property OutputStream: TStream read FOutputStream write SetOutputStream;
    property CurrentPageNumber: Integer read FCurrentPageNum write SetCurrentPageNum;
    property OutlineRoot: TVPDFDocOutlineObject read GetOutlineRoot;
  published
    property AutoLaunch: Boolean read FAutoLaunch write SetAutoLaunch;
    property ShowInfo: boolean read FShowInfo write FShowInfo;
    property Author: AnsiString read FAuthor write FAuthor;
    property Keywords: AnsiString read FKeywords write FKeywords;
    property Subject: AnsiString read FSubject write FSubject;
    property Title: AnsiString read FTitle write FTitle;
    property FileName: TFileName read FFileName write FFileName;
    property Version: TPDFVersType read FVersion write FVersion;
    property UserPassword: AnsiString read FUserPassword write FUserPassword;
    property OwnerPassword: AnsiString read FOwnerPassword write FOwnerPassword;
    property ActivateProtection: boolean read FProtection write FProtection;
    property CryptKeyLength: TVPDFKeyType read FCryptKeyType write
      SetCryptKeyType;
    property ProtectOptions: TVPDFProtectOptions read FProtectOption write
      FProtectOption;
    property NotEmbeddedFonts: TStringList read FNEmbeddedFonts write
      SetNEmbeddedFont;
    property PageLayout: TVPDFPageLayout read FPageLayout write
      SetPageLayout;
    property PageMode: TVPDFPageMode read FPageMode write FPageMode;
    property PagesCount: Integer read FPagesCount;
    property StandardFontEmulation: boolean read FStandardFontEmulation write
      SetStandardFontEmulation;
    property FontEmbedding: boolean read FFontEmbedding write
      FFontEmbedding;
    property ViewerPreferences: TVPDFViewerPreferences read FViewerPreference
      write SetViewerPreferences;
    property JpegQuality: TJPEGQualityRange read FJpegQuality write
      FJpegQuality;
    property Compression: TVPDFCompressionMethod read FCompressionMethod
      write SetCompressionMethod;
    property KeepImageAspectRatio: boolean read FKeepImageAspectRatio
      write FKeepImageAspectRatio default true;
    property Resolution: Integer read FResolution write SetResolution;
    property ParaAutoAddPage: boolean read FAutoAddPage write FAutoAddPage;
    property ImageCompressionType: TVPDFImageCompressionType read FImageCompressionType
      write FImageCompressionType default icJpeg;
  end;

implementation

uses VPDFWmf, VPDFImage, VPDFTiff;

const
  EscapeChars = [' ', '/', '(', '<', '[', '>', ']', #10, #13];

{ TVPDFAnnotation }

procedure TVPDFAnnotation.AddAnnotationObject;
var
  MFS: TFileStream;
  AttS: TVPDFStreamObject;
  AspectArray: TVPDFArrayObject;
  ColorArray: TVPDFArrayObject;
  RectArray: TVPDFArrayObject;
  LineArray: TVPDFArrayObject;
  MediaF: TVPDFDictionaryObject;
  FilSpec: TVPDFDictionaryObject;
  AnotDict: TVPDFDictionaryObject;

  function ConvertFileName(FileName: TFileName): TFileName;
  var
    I: Integer;
    FNL: Integer;
  begin
    FNL := Length(FileName);
    for I := 1 to FNL do
    begin
      if (FileName[I] = '\') then FileName[I] := '/';
    end;
    result := FileName;
  end;

begin
  AnotDict := FPage.FParent.CreateIndirectDictionary;
  AnotDict.AddNameValue('Type', 'Annot');
  ColorArray := TVPDFArrayObject.Create(nil);
  ColorArray.AddNumericValue(FColor[0] / 255);
  ColorArray.AddNumericValue(FColor[1] / 255);
  ColorArray.AddNumericValue(FColor[2] / 255);
  if (FPage.FAnnotsObj = nil) then
  begin
    FPage.FAnnotsObj := TVPDFArrayObject.Create(nil);
    FPage.PageObj.AddValue('Annots', FPage.FAnnotsObj);
  end;
  case FType of
    asTextNotes:
      begin
        AnotDict.AddNameValue('Subtype', 'Text');
        AnotDict.AddNameValue('Name', FName);
        RectArray := TVPDFArrayObject.Create(nil);
        RectArray.AddNumericValue(Fpage.XProjection(FLeftTop.X));
        RectArray.AddNumericValue(Fpage.YProjection(FRightBottom.Y));
        RectArray.AddNumericValue(Fpage.XProjection(FRightBottom.X));
        RectArray.AddNumericValue(Fpage.YProjection(FLeftTop.Y));
        AnotDict.AddValue('Rect', RectArray);
        AnotDict.AddStringValue('Contents', FContents);
        AnotDict.AddBooleanValue('Open', FOpen);
        AnotDict.AddValue('P', Fpage.PageObj);
      end;
    asFreeText:
      begin
        AnotDict.AddNameValue('Subtype', 'FreeText');
        RectArray := TVPDFArrayObject.Create(nil);
        RectArray.AddNumericValue(Fpage.XProjection(FLeftTop.X));
        RectArray.AddNumericValue(Fpage.YProjection(FRightBottom.Y));
        RectArray.AddNumericValue(Fpage.XProjection(FRightBottom.X));
        RectArray.AddNumericValue(Fpage.YProjection(FLeftTop.Y));
        AnotDict.AddValue('Rect', RectArray);
        AnotDict.AddStringValue('Contents', FContents);
        AnotDict.AddNumericValue('Q', FQuadding);
        AnotDict.AddValue('P', Fpage.PageObj);
      end;
    asLine:
      begin
        AnotDict.AddNameValue('Subtype', 'Line');
        AnotDict.AddStringValue('Contents', FContents);
        LineArray := TVPDFArrayObject.Create(nil);
        LineArray.AddNumericValue(Fpage.XProjection(FLeftTop.X));
        LineArray.AddNumericValue(Fpage.YProjection(FLeftTop.Y));
        LineArray.AddNumericValue(Fpage.XProjection(FRightBottom.X));
        LineArray.AddNumericValue(Fpage.YProjection(FRightBottom.Y));
        AnotDict.AddValue('L', LineArray);
        RectArray := TVPDFArrayObject.Create(nil);
        RectArray.AddNumericValue(Fpage.XProjection(FLeftTop.X));
        RectArray.AddNumericValue(Fpage.YProjection(FLeftTop.Y));
        RectArray.AddNumericValue(Fpage.XProjection(FRightBottom.X));
        RectArray.AddNumericValue(Fpage.YProjection(FRightBottom.Y));