vpdfdoc.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 VPDFDoc;

interface

{$I VisPDFLib.inc }

uses
  Windows, SysUtils, Classes, Graphics, Math, Jpeg, ShellApi, VPDFTypes,
  VPDFObjects, VPDFZLib, VPDFBarcode, VPDFFonts, VPDFCrypt;

type
  TVPDFJustificationType = (jtLeft, jtCenter, jtRight);

  TVPDFTSh = record
    AValText: AnsiString;
    AValX: Single;
  end;

  TVPDFCurrPoint = record
    X: Extended;
    Y: Extended;
  end;

  TVPDFRect = record
    Left, Top, Right, Bottom: Extended;
  end;

  TVPDFParagraph = record
    Justification: TVPDFJustificationType;
    Indention: Single;
    LeftMargin: Single;
    RightMargin: Single;
    TopMargin: Single;
    BottomMargin: Single;
  end;

  TGenByteArray = array[0..9] of byte;
  TGenerationArray = array[0..9] of Integer;

  TVPDFImageObject = record
    Index: Integer;
    Name: AnsiString;
    ImageObject: TVPDFObject;
    Width: Integer;
    Height: Integer;
  end;

  XRefItem = record
    Loaded: boolean;
    Offset: Integer;
    ObjNumber: TVPDFObjectNumber;
  end;

  TVPDFKeyType = (k40, k128, aes128);
  TPDFVersType = (pdf10, pdf11, pdf12, pdf13, pdf14, pdf15, pdf16, pdf17, pdf18, pdf19, pdf110);
  TVPDFActionScriptType = (astOpen, astClose, astWillSave, astDidSave, astWillPrint, astDidPrint);
  TVPDFCompressionMethod = (cmNone, cmFlateDecode);
{$IFDEF BCB}
  TVPDFPageOrientation = (vpoPortrait, vpoLandscape);
{$ELSE}
  TVPDFPageOrientation = (poPortrait, poLandscape);
{$ENDIF}
  TLineCapStyle = (lcButtEnd, lcRoundEnd, lcProjectSquareEnd);
  TLineJoinStyle = (ljMiterJoin, ljRoundJoin, ljBevelJoin);
  TPDFTextRenderingMode = (trFill, trStroke, trFillThenStroke, trInvisible,
    trFillClipping, trStrokeClipping, trFillStrokeClipping, trClipping);
  TVPDFImageCompressionType = (icFlate, icJpeg, icCCITT31, icCCITT32,
    icCCITT42);
  TVPDFPageLayout = (plSinglePage, plOneColumn, plTwoColumnLeft,
    plTwoColumnRight);
  TVPDFAnnotationSubType = (asTextNotes, asFreeText, asLine, asSquare, asCircle,
    asStamp, asFileAttachment, asSound, asMovie);
  TVPDFTextAnnotationType = (taComment, taKey, taNote, taHelp, taNewParagraph, taParagraph, taInsert);
  TVPDFFreeTextAnnotationJust = (ftLeftJust, ftCenter, ftRightJust);
  TVPDFCSAnnotationType = (csCircle, csSquare);
  TVPDFStampAnnotationType = (satApproved, satExperimental, satNotApproved, satAsIs, satExpired,
    satNotForPublicRelease, satConfidential, satFinal, satSold,
    satDepartmental, satForComment, satTopSecret, satDraft, satForPublicRelease);
  TVPDFPageSize = (psUserDefined, psLetter, psA4, psA3, psLegal, psB5, psC5,
    ps8x11, psB4, psA5, psFolio, psExecutive, psEnvB4, psEnvB5, psEnvC6,
    psEnvDL, psEnvMonarch, psEnv9, psEnv10, psEnv11);
  TVPDFBarcodeType =
    (bcCode_2_5_interleaved, bcCode_2_5_industrial, bcCode_2_5_matrix,
    bcCode39, bcCode39Extended, bcCode128A, bcCode128B, bcCode128C, bcCode93,
    bcCode93Extended, bcCodeMSI, bcCodePostNet, bcCodeCodabar, bcCodeEAN8, bcCodeEAN13,
    bcCodeUPC_A, bcCodeUPC_E0, bcCodeUPC_E1, bcCodeUPC_Supp2, bcCodeUPC_Supp5,
    bcCodeEAN128A, bcCodeEAN128B, bcCodeEAN128C);
  TVPDFPageMode = (pmUseNone, pmUseOutlines, pmUseThumbs, pmFullScreen, pmUseAttachments);
  TVPDFViewerPreference = (vpHideToolbar, vpHideMenubar, vpHideWindowUI,
    vpFitWindow, vpCenterWindow);
  TVPDFProtection = (prPrint, prModifyStructure, prInformationCopy,
    prEditAnnotations, prPrint12bit, prFillAnnotations, prExtractContent, prAssemble);
  TTIFFPaintType = (tptResizePage, tptResizeImage);
  TVPDFProtectOptions = set of TVPDFProtection;
  TVPDFViewerPreferences = set of TVPDFViewerPreference;

  TVPDFFontObj = class(TObject)
  private
    Name: AnsiString;
    Size: Single;
    ArrIndex: Integer;
    Saved: boolean;
    OldName: AnsiString;
    Ascent: Integer;
    FActive: boolean;
    IsUsed: boolean;
    UniLen: Integer;
    FontLen: Integer;
    IsUnicode: boolean;
    IsVertical: boolean;
    OrdinalName: AnsiString;
    IsStandard: boolean;
    FontStyle: TFontStyles;
    FontCharset: TFontCharset;
    IsMonospaced: boolean;
    OutTextM: OUTLINETEXTMETRIC;
    ABCArray: array[0..255] of ABC;
    Symbols: array of CDescript;
    UnicodeTable: array of IndexedChar;
    SymbolTable: array[32..255] of boolean;
    function GetCharWidth(AText: AnsiString; APos: integer): integer;
    procedure CopyFontFetures(InFnt: TVPDFFontObj);
    procedure GetFontFeatures;
    procedure ParseFontName;
    procedure ClearTables;
  end;

  TVPDF = class;
  TVPDFPage = class;

  TVPDFAnnotation = class(TObject)
  private
    FPage: TVPDFPage;
    FColor: array[0..3] of Byte;
    FType: TVPDFAnnotationSubType;
    FTypeState: AnsiString;
    FContents: AnsiString;
    FQuadding: Integer;
    FOpen: boolean;
    FLeftTop: TVPDFCurrPoint;
    FRightBottom: TVPDFCurrPoint;
    FName: AnsiString;
  protected
    procedure AddAnnotationObject;
  end;

  TVPDFDocOutlineObject = class(TObject)
  private
    FDoc: TVPDF;
    FParent: TVPDFDocOutlineObject;
    FNext: TVPDFDocOutlineObject;
    FPrev: TVPDFDocOutlineObject;
    FFirst: TVPDFDocOutlineObject;
    FLast: TVPDFDocOutlineObject;
    FTitle: AnsiString;
    FOpened: boolean;
  protected
    LinkedObj: TVPDFDictionaryObject;
    FCount: Integer;
    FTop: Integer;
    FLeft: Integer;
    procedure Init(AOwner: TVPDF);
  public
    function AddChild(Title: AnsiString; X: Single = 0; Y: Single = 0): TVPDFDocOutlineObject;
    property Parent: TVPDFDocOutlineObject read FParent;
    property Next: TVPDFDocOutlineObject read FNext;
    property Prev: TVPDFDocOutlineObject read FPrev;
    property First: TVPDFDocOutlineObject read FFirst;
    property Last: TVPDFDocOutlineObject read FLast;
    property Title: AnsiString read FTitle write FTitle;
    property Opened: boolean read FOpened write FOpened;
  end;

  TVPDFPage = class(TObject)
  private
    DPI: Single;
    FWordSpace: Single;
    FCharSpace: Single;
    FLeading: Single;
    FHorizontalScaling: Single;
    ISStated: Integer;
    STextBegin: boolean;
    FKBegin: boolean;
    SKBegin: boolean;
    FFillColor: TColor;
    FStrokeColor: TColor;
    FHyperColor: TColor;
    FMinXVal: Single;
    FMinYVal: Single;
    FMaxXVal: Single;
    FMaxYVal: Single;
    FDescStream: TStream;
    PageObjStream: TVPDFStreamObject;
    PageObj: TVPDFDictionaryObject;
    FResolution: Integer;
    FUpdateSize: boolean;
    mWidth: Single;
    mHeight: Single;
    FWidth: Single;
    FHeight: Single;
    FAnnotsObj: TVPDFArrayObject;
    FDocScale: Extended;
    FSize: TVPDFPageSize;
    XObjectObj: TVPDFObject;
    FontObjectObj: TVPDFObject;
    XObjectNames: array of AnsiString;
    FontArr: array of TVPDFFontObj;
    CurrentFontObj: TVPDFFontObj;
    FMediaBoxArray: TVPDFArrayObject;
    FOrientation: TVPDFPageOrientation;
    FTopTextPosition: boolean;
    PageContent: TStringList;
    PageMeta: TMetafile;
    FCanvas: TCanvas;
    procedure CloseCanvas;
    procedure ClosePage;
    procedure CalculateWidthFormat;
    procedure CalculateHeightFormat;
    procedure CalculateFormat;
    procedure ConvertPageObject;
    procedure SetResolution(const Value: Integer);
    function GetPageHeight: Single;
    function GetPageWidth: Single;
    procedure SetPageHeight(const Value: Single);
    procedure SetPageWidth(const Value: Single);
    procedure SetPageSize(const Value: TVPDFPageSize);
    procedure SetOrientation(const Value: TVPDFPageOrientation);
    procedure TurnPage;
    procedure StoreFont(FontObj: TVPDFFontObj);
    procedure SaveToPageStream(ValStr: AnsiString);
    function GetCanvas: TCanvas;
    function CompareCurrentFont: Integer;
    function XProjection(X: Single): Single;
    function YProjection(Y: Single): Single;
    function CompareResName(Index: Integer; Name: AnsiString): Integer;
    procedure CurveArc(CenterX, CenterY, RadiusX, RadiusY, StartAngle, SweepRange: Extended; UseMoveTo: Boolean);
    procedure ExecuteXObject(XOName: AnsiString);
    procedure DrawXObjectEx(X, Y, AWidth, AHeight: Single; ClipX, ClipY, ClipWidth, ClipHeight: Single; AXObjectName: AnsiString; angle: Extended; DocScale: Extended);
  protected
    function ProcChar(ComposChar: WORD): AnsiString;
    procedure RMoveTo(x, y: Single);
    procedure StoreCurrentFont;
    procedure InternUnicodeTextOut(X, Y: Single; Angle: Extended; Text: PWORD; TextLength: Integer);
    procedure FEllipse(X, Y, Width, Height: Single);
    procedure RotateCoordinate(X, Y, Angle: Extended; var XR, YR: Extended);
    procedure SetURIObject(UriLink: AnsiString; Left, Top, Right, Bottom: Extended);
  public
    FParent: TVPDF;
    constructor Create;
    destructor Destroy; override;
    procedure DrawPie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Extended);
    function DrawArc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single): TVPDFCurrPoint;
    procedure GStateSave;
    function GStateRestore: boolean;
    procedure Concat(A, B, C, D, E, F: Single);
    procedure SetFlat(Flatness: Byte);
    procedure SetLineCap(Linecap: TLineCapStyle);
    procedure SetDash(DashArray: array of Byte; Phase: Byte);
    procedure NoDash;
    procedure AddTextAnnotation(Contents: AnsiString; Rectangle: TRect; Open: boolean; Name: TVPDFTextAnnotationType; Color: TColor = clRed);
    procedure AddFreeTextAnnotation(Contents: AnsiString; Rectangle: TRect; Quadding: TVPDFFreeTextAnnotationJust; Color: TColor = clRed);
    procedure AddLineAnnotation(Contents: AnsiString; BeginPoint: TVPDFCurrPoint; EndPoint: TVPDFCurrPoint; Color: TColor = clRed);
    procedure AddCircleSquareAnnotation(Contents: AnsiString; Rectangle: TRect; CSType: TVPDFCSAnnotationType; Color: TColor = clRed);
    procedure AddStampAnnotation(Contents: AnsiString; Rectangle: TRect; StampType: TVPDFStampAnnotationType; Color: TColor = clRed);
    procedure AddFileAttachmentAnnotation(Contents: AnsiString; FileName: AnsiString; Rectangle: TRect; Color: TColor = clRed);
    procedure AddSoundAnnotation(Contents: AnsiString; FileName: AnsiString; Rectangle: TRect; Color: TColor = clRed);
    procedure AddMovieAnnotation(Contents: AnsiString; FileName: AnsiString; Rectangle: TRect; Color: TColor = clRed);
    procedure SetLineJoin(LineJoin: TLineJoinStyle);
    procedure SetLineWidth(Width: Single);
    procedure SetMiterLimit(MiterLimit: Byte);
    procedure CurveToC(X1, Y1, X2, Y2, X3, Y3: Single);
    procedure CurveToV(X2, Y2, X3, Y3: Single);
    procedure CurveToY(X1, Y1, X3, Y3: Single);
    procedure FMEllipse(X, Y, X1, Y1: Single);
    procedure MFRectangle(X, Y, X1, Y1: Single);
    procedure Rectangle(X, Y, Width, Height: Single);
    procedure RectangleRotate(X, Y, Width, Height: Single; Angle: Extended);
    procedure SetCharacterSpacing(Spacing: Single);
    procedure SetWordSpacing(Spacing: Single);
    procedure SetHorizontalScaling(Scaling: Single);
    procedure SetLeading(Leading: Single);
    procedure SetTextRenderingMode(Mode: TPDFTextRenderingMode);
    procedure SetTextRise(Rise: SmallInt);
    procedure MoveTextPoint(X, Y: Single);
    procedure SetTextMatrix(a, b, c, d, x, y: Single);
    procedure MoveToNextLine;
    procedure ShowText(Text: AnsiString; IsHexadecimal: boolean = false);
    procedure ShowUnicodeText(Text: WideString);
    procedure SetRGBHyperlinkColor(Value: TColor);
    procedure SetRGBColor(Value: TColor);
    procedure SetRGBFillColor(Value: TColor);
    procedure SetRGBStrokeColor(Value: TColor);
    procedure SetGrayColor(GrayColor: Extended);
    procedure SetGrayFillColor(GrayColor: Extended);
    procedure SetGrayStrokeColor(GrayColor: Extended);
    procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
    procedure Circle(X, Y, Radius: Single);
    procedure Ellipse(X, Y, Width, Height: Single);
    procedure DrawBarcode(BCType: TVPDFBarcodeType; X, Y, Height, MUnit:
      Integer; Angle: Single; Info: AnsiString; UseCheckSum: Boolean; BarColor,
      Color: TColor);
    procedure ProcessFont(Unicoded: boolean);
    procedure PrintHyperlink(X, Y: Single; Text, Link: AnsiString);
    procedure SetFont(FontName: AnsiString; FontStyle: TFontStyles; ASize: Single;
      FontCharset: TFontCharset = ANSI_CHARSET; IsVertical: boolean = false);
{$IFDEF BCB}
    procedure UnicodeTextOut(X, Y: Single; Angle: Extended; Text: PWORD; TextLength: Integer);
    procedure UnicodeTextOutStr(X, Y: Single; Angle: Extended; Text: WideString);
    procedure PrintText(X, Y: Single; Angle: Extended; Text: AnsiString);
    procedure OutText(X, Y: Single; Angle: Extended; Text: AnsiString);
{$ELSE}
    procedure UnicodeTextOut(X, Y: Single; Angle: Extended; Text: PWORD; TextLength: Integer); overload;
    procedure UnicodeTextOut(X, Y: Single; Angle: Extended; Text: WideString); overload;
    procedure TextOut(X, Y: Single; Angle: Extended; Text: AnsiString);
{$ENDIF}
    function TextWidth(Text: AnsiString): Single;
    function TextHeight(Text: AnsiString): Real;
    procedure SetFontAndSize(FontName: AnsiString; Size: Single);
{$IFDEF BCB}
    procedure ShowMetafileEx(MetaFile: TMetaFile);
    procedure ShowMetafile(MetaFile: TMetafile; X, Y, HorScale, VertScale:
      Extended);
{$ELSE}
    procedure ShowMetafile(MetaFile: TMetaFile); overload;
    procedure ShowMetafile(MetaFile: TMetafile; X, Y, HorScale, VertScale:
      Extended); overload;
{$ENDIF}
    procedure BeginText;
    procedure EndText;
    procedure ShowImage(ImageIndex: Integer; x, y, w, h, Angle: Extended);
    procedure MoveTo(X, Y: Single);
    procedure LineTo(X, Y: Single);
    procedure Stroke;
    procedure ClosePath;
    procedure NewPath;
    procedure ClosePathStroke;
    procedure Fill;
    procedure EoFill;
    procedure FillAndStroke;
    procedure ClosePathFillAndStroke;
    procedure EoFillAndStroke;
    procedure ClosePathEoFillAndStroke;
    procedure Clip;
    procedure EoClip;
    property Canvas: TCanvas read GetCanvas;
    property TopTextPosition: boolean read FTopTextPosition write FTopTextPosition;