home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d3456 / POWERPDF.ZIP / PowerPdf / PdfDoc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-15  |  75.6 KB  |  2,791 lines
  1. {*
  2.  * << P o w e r P d f >> -- PdfDoc.pas
  3.  *
  4.  * Copyright (c) 1999-2001 Takezou. <takeshi_kanno@est.hi-ho.ne.jp>
  5.  *
  6.  * This library is free software; you can redistribute it and/or modify it
  7.  * under the terms of the GNU Library General Public License as published
  8.  * by the Free Software Foundation; either version 2 of the License, or any
  9.  * later version.
  10.  *
  11.  * This library is distributed in the hope that it will be useful, but WITHOUT
  12.  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  13.  * FOR A PARTICULAR PURPOSE. See the GNU Library general Public License for more
  14.  * details.
  15.  *
  16.  * You should have received a copy of the GNU Library General Public License
  17.  * along with this library.
  18.  *
  19.  * 2000.09.10 create.
  20.  * 2001.06.30 move FloatToStrR method to PdfTypes.pas.
  21.  * 2001.07.01 implemented text annotation.
  22.  * 2001.07.10 move TPDF_STR_TBL and TPDF_INT_TBL defination to top (for BCB).
  23.  * 2001.07.21 changed TPdfDictionaryWrapper's properties(Data and HasData) to
  24.  *            public.
  25.  * 2001.07.28 fixed bug of TPdfCanvas.SetPage.
  26.  * 2001.08.01 added TPdfCatalog.PageLayout
  27.  * 2001.08.09 moved some constans from PdfTypes.pas.
  28.  * 2001.08.12 changed the implementation of outlines.
  29.  * 2001.08.12 changed the implementation of annotation.
  30.  * 2001.08.18 added GetNextWord routine.
  31.  * 2001.08.18 changed the parameter of MoveToTextPoint routine.
  32.  * 2001.08.20 added Text utility routines.
  33.  * 2001.08.20 added Leading property to TPdfCanvasAttribute.
  34.  * 2001.08.22 change the method name MesureText to MeasureText(Spelling mistake :-)
  35.  * 2001.08.26 changed some definations and methods to work with kylix.
  36.  * 2001.09.01 changed the implementation of the image.
  37.  * 2001.09.08 added OpenAction function.
  38.  *            change AddAnnotation method to CreateAnnotation.
  39.  * 2001.09.13 added ViewerPreference functions.
  40.  *}
  41. unit PdfDoc;
  42.  
  43. interface
  44.  
  45. // if use "FlateDecode" compression, comment out the next line.
  46. // (this unit and PdfTypes.pas)
  47. {$DEFINE NOZLIB}
  48.  
  49. uses
  50.   SysUtils, Classes, PdfTypes
  51.   {$IFDEF LINUX}
  52.   , Types
  53.   {$ELSE}
  54.   , Windows
  55.   {$ENDIF}
  56.   ;
  57.  
  58. const
  59.   POWER_PDF_VERSION_TEXT = 'PowerPdf version 0.9';
  60.  
  61.   {*
  62.    * PreDefined page size
  63.    *}
  64.   PDF_PAGE_WIDTH_A4 = 596;
  65.   PDF_PAGE_HEIGHT_A4 = 842;
  66.  
  67.   {*
  68.    * Dafault page size.
  69.    *}
  70.   PDF_DEFAULT_PAGE_WIDTH = PDF_PAGE_WIDTH_A4;
  71.   PDF_DEFAULT_PAGE_HEIGHT = PDF_PAGE_HEIGHT_A4;
  72.  
  73.   {*
  74.    * collection of flags defining various characteristics of the font.
  75.    *}
  76.   PDF_FONT_FIXED_WIDTH = 1;
  77.   PDF_FONT_SERIF       = 2;
  78.   PDF_FONT_SYMBOLIC    = 4;
  79.   PDF_FONT_SCRIPT      = 8;
  80.   // Reserved          = 16
  81.   PDF_FONT_STD_CHARSET = 32;
  82.   PDF_FONT_ITALIC      = 64;
  83.   // Reserved          = 128
  84.   // Reserved          = 256
  85.   // Reserved          = 512
  86.   // Reserved          = 1024
  87.   // Reserved          = 2048
  88.   // Reserved          = 4096
  89.   // Reserved          = 8192
  90.   // Reserved          = 16384
  91.   // Reserved          = 32768
  92.   PDF_FONT_ALL_CAP     = 65536;
  93.   PDF_FONT_SMALL_CAP   = 131072;
  94.   PDF_FONT_FOURCE_BOLD = 262144;
  95.  
  96.   PDF_DEFAULT_FONT = 'Arial';
  97.   PDF_DEFAULT_FONT_SIZE = 10;
  98.  
  99.   PDF_MIN_HORIZONTALSCALING = 10;
  100.   PDF_MAX_HORIZONTALSCALING = 300;
  101.   PDF_MAX_WORDSPACE = 300;
  102.   PDF_MIN_CHARSPACE = -30;
  103.   PDF_MAX_CHARSPACE = 300;
  104.   PDF_MAX_FONTSIZE = 300;
  105.   PDF_MAX_ZOOMSIZE = 10;
  106.   PDF_MAX_LEADING = 300;
  107.  
  108.   PDF_PAGE_LAYOUT_NAMES: array[0..3] of string = ('SinglePage',
  109.                                                   'OneColumn',
  110.                                                   'TwoColumnLeft',
  111.                                                   'TwoColumnRight');
  112.  
  113.   PDF_PAGE_MODE_NAMES: array[0..3] of string = ('UseNone',
  114.                                                 'UseOutlines',
  115.                                                 'UseThumbs',
  116.                                                 'FullScreen');
  117.  
  118.   PDF_ANNOTATION_TYPE_NAMES: array[0..12] of string = ('Text',
  119.                                                       'Link',
  120.                                                       'Sound',
  121.                                                       'FreeText',
  122.                                                       'Stamp',
  123.                                                       'Square',
  124.                                                       'Circle',
  125.                                                       'StrikeOut',
  126.                                                       'Highlight',
  127.                                                       'Underline',
  128.                                                       'Ink',
  129.                                                       'FileAttachment',
  130.                                                       'Popup');
  131.  
  132.   PDF_DESTINATION_TYPE_NAMES: array[0..7] of string = ('XYZ',
  133.                                                        'Fit',
  134.                                                        'FitH',
  135.                                                        'FitV',
  136.                                                        'FitR',
  137.                                                        'FitB',
  138.                                                        'FitBH',
  139.                                                        'FitBV');
  140.  
  141. type
  142.   {*
  143.    * The pagemode determines how the document should appear when opened.
  144.    *}
  145.   TPdfPageMode = (pmUseNone,
  146.                   pmUseOutlines,
  147.                   pmUseThumbs,
  148.                   pmFullScreen);
  149.  
  150.   {*
  151.    * The line cap style specifies the shape to be used at the ends of open
  152.    * subpaths when they are stroked.
  153.    *}
  154.   TLineCapStyle = (lcButt_End,
  155.                    lcRound_End,
  156.                    lcProjectingSquareEnd);
  157.  
  158.   {*
  159.    * The line join style specifies the shape to be used at the corners of paths
  160.    * that are stroked.
  161.    *}
  162.   TLineJoinStyle = (ljMiterJoin,
  163.                     ljRoundJoin,
  164.                     ljBevelJoin);
  165.  
  166.   {*
  167.    * The text rendering mode determines whether text is stroked, filled, or used
  168.    * as a clipping path.
  169.    *}
  170.   TTextRenderingMode = (trFill,
  171.                         trStroke,
  172.                         trFillThenStroke,
  173.                         trInvisible,
  174.                         trFillClipping,
  175.                         trStrokeClipping,
  176.                         trFillStrokeClipping,
  177.                         trClipping);
  178.  
  179.   {*
  180.    * The annotation types determines the valid annotation subtype of TPdfDoc.
  181.    *}
  182.   TPdfAnnotationSubType = (asTextNotes,
  183.                            asLink);
  184.  
  185.   {*
  186.    * The TPdfDestinationType determines default user space coordinate system of
  187.    * Explicit destinations.
  188.    *}
  189.   TPdfDestinationType = (dtXYZ,
  190.                         dtFit,
  191.                         dtFitH,
  192.                         dtFitV,
  193.                         dtFitR,
  194.                         dtFitB,
  195.                         dtFitBH,
  196.                         dtFitBV);
  197.  
  198.   {*
  199.    * TPdfPageLayout specifying the page layout to be used when the document is
  200.    * opened:
  201.    *}
  202.   TPdfPageLayout = (plSinglePage,
  203.                     plOneColumn,
  204.                     plTwoColumnLeft,
  205.                     plTwoColumnRight);
  206.  
  207.  
  208.   TPdfViewerPreference = (vpHideToolbar,
  209.                           vpHideMenubar,
  210.                           vpHideWindowUI,
  211.                           vpFitWindow,
  212.                           vpCenterWindow);
  213.   TPdfViewerPreferences = set of TPdfViewerPreference;
  214.  
  215.   {$IFDEF NOZLIB}
  216.   TPdfCompressionMethod = (cmNone);
  217.   {$ELSE}
  218.   TPdfCompressionMethod = (cmNone, cmFlateDecode);
  219.   {$ENDIF}
  220.  
  221.   TPdfColor = -$7FFFFFFF-1..$7FFFFFFF;
  222.   TXObjectID = integer;
  223.  
  224.   TPDF_STR_TBL = record
  225.     KEY: string;
  226.     VAL: string;
  227.   end;
  228.   TPDF_INT_TBL = record
  229.     KEY: string;
  230.     VAL: integer;
  231.   end;
  232.  
  233.   TPdfHeader = class(TObject)
  234.   protected
  235.     procedure WriteToStream(const AStream: TStream);
  236.   end;
  237.  
  238.   TPdfTrailer = class(TObject)
  239.   private
  240.     FAttributes: TPdfDictionary;
  241.     FXrefAddress: integer;
  242.   protected
  243.     procedure WriteToStream(const AStream: TStream);
  244.   public
  245.     constructor Create(AObjectMgr: TPdfObjectMgr);
  246.     destructor Destroy; override;
  247.     property XrefAddress: integer read FXrefAddress write FXrefAddress;
  248.     property Attributes: TPdfDictionary read FAttributes;
  249.   end;
  250.  
  251.   TPdfXrefEntry = class(TObject)
  252.   private
  253.     FEntryType: string;
  254.     FByteOffset: integer;
  255.     FGenerationNumber: integer;
  256.     FValue: TPdfObject;
  257.     function GetAsString: string;
  258.   public
  259.     constructor Create(AValue: TPdfObject);
  260.     destructor Destroy; override;
  261.     property EntryType: string read FEntryType write FEntryType;
  262.     property ByteOffset: integer read FByteOffSet write FByteOffset;
  263.     property GenerationNumber: integer
  264.                           read FGenerationNumber write FGenerationNumber;
  265.     property AsString: string read GetAsString;
  266.     property Value: TPdfObject read FValue;
  267.   end;
  268.  
  269.   TPdfXref = class(TPdfObjectMgr)
  270.   private
  271.     FXrefEntries: TList;
  272.     function GetItem(ObjectID: integer): TPdfXrefEntry;
  273.     function GetItemCount: integer;
  274.   protected
  275.     procedure WriteToStream(const AStream: TStream);
  276.   public
  277.     constructor Create;
  278.     destructor Destroy; override;
  279.     procedure AddObject(AObject: TPdfObject); override;
  280.     function GetObject(ObjectID: integer): TPdfObject; override;
  281.     property Items[ObjectID: integer]: TPdfXrefEntry read GetItem;
  282.     property ItemCount: integer read GetItemCount;
  283.   end;
  284.  
  285.   TPdfCanvas = class;
  286.   TPdfInfo = class;
  287.   TPdfCatalog = class;
  288.   TPdfFont = class;
  289.   TPdfDestination = class;
  290. //  TPdfLink = class;
  291.   TPdfOutlineEntry = class;
  292.   TPdfOutlineRoot = class;
  293.   TAbstractPReport = class(TComponent);
  294.  
  295.   TPdfDoc = class(TObject)
  296.   private
  297.     FRoot: TPdfCatalog;
  298.     FCurrentPages: TPdfDictionary;
  299.     FCanvas: TPdfCanvas;
  300.     FHeader: TPdfHeader;
  301.     FTrailer: TPdfTrailer;
  302.     FXref: TPdfXref;
  303.     FInfo: TPdfInfo;
  304.     FHasDoc: boolean;
  305.     FFontList: TList;
  306.     FObjectList: TList;
  307.     FOutlineRoot: TPdfOutlineRoot;
  308.     FXObjectList: TPdfArray;
  309.     FDefaultPageWidth: Word;
  310.     FDefaultPageHeight: Word;
  311.     FCompressionMethod: TPdfCompressionMethod;
  312.     FUseOutlines: boolean;
  313.     function GetCanvas: TPdfCanvas;
  314.     function GetInfo: TPdfInfo;
  315.     function GetRoot: TPdfCatalog;
  316.     function GetOutlineRoot: TPdfOutlineRoot;
  317.   protected
  318.     procedure CreateInfo;
  319.     procedure CreateOutlines;
  320.     function CreateCatalog: TPdfDictionary;
  321.     function CreateFont(FontName: string): TPdfFont;
  322.     function CreatePages(Parent: TPdfDictionary): TPdfDictionary;
  323.   public
  324.     procedure RegisterXObject(AObject: TPdfXObject; AName: string);
  325.     constructor Create;
  326.     destructor Destroy; override;
  327.     procedure NewDoc;
  328.     procedure FreeDoc;
  329.     procedure AddPage;
  330.     procedure AddXObject(AName: string; AXObject: TPdfXObject);
  331.     procedure SaveToStream(AStream: TStream);
  332.     procedure SetVirtualMode;
  333.     function GetFont(FontName: string): TPdfFont;
  334.     function GetXObject(AName: string): TPdfXObject;
  335.     function CreateAnnotation(AType: TPdfAnnotationSubType; ARect: TPdfRect): TPdfDictionary;
  336.     function CreateDestination: TPdfDestination;
  337.     property HasDoc: boolean read FHasDoc;
  338.     property Canvas: TPdfCanvas read GetCanvas;
  339.     property Info: TPdfInfo read GetInfo;
  340.     property Root: TPdfCatalog read GetRoot;
  341.     property OutlineRoot: TPdfOutlineRoot read GetOutlineRoot;
  342.     property DefaultPageWidth: word read FDefaultPageWidth write FDefaultPageWidth;
  343.     property DefaultPageHeight: word read FDefaultPageHeight write FDefaultPageHeight;
  344.     property CompressionMethod: TPdfCompressionMethod
  345.        read FCompressionMethod write FCompressionMethod;
  346.     property UseOutlines: boolean read FUseoutlines write FUseoutlines;
  347.   end;
  348.  
  349.   TPdfCanvasAttribute = class(TObject)
  350.   private
  351.     FWordSpace: Single;
  352.     FCharSpace: Single;
  353.     FFontSize: Single;
  354.     FFont: TPdfFont;
  355.     FLeading: Single;
  356.     FHorizontalScaling: Word;
  357.     procedure SetWordSpace(Value: Single);
  358.     procedure SetCharSpace(Value: Single);
  359.     procedure SetFontSize(Value: Single);
  360.     procedure SetHorizontalScaling(Value: Word);
  361.     procedure SetLeading(Value: Single);
  362.   public
  363.     function TextWidth(Text: string): Single;
  364.     function MeasureText(Text: string; Width: Single): integer;
  365.     property WordSpace: Single read FWordSpace write SetWordSpace;
  366.     property CharSpace: Single read FCharSpace write SetCharSpace;
  367.     property HorizontalScaling: Word read FHorizontalScaling
  368.       write SetHorizontalScaling;
  369.     property Leading: Single read FLeading write SetLeading;
  370.     property FontSize: Single read FFontSize write SetFontSize;
  371.     property Font: TPdfFont read FFont write FFont;
  372.   end;
  373.  
  374.   TPdfCanvas = class(TObject)
  375.   private
  376.     FContents: TPdfStream;
  377.     FPage: TPdfDictionary;
  378.     FPdfDoc: TPdfDoc;
  379.     FAttr: TPdfCanvasAttribute;
  380.     FIsVirtual: boolean;
  381.     procedure SetPageWidth(AValue: integer);
  382.     procedure SetPageHeight(AValue: integer);
  383.     procedure WriteString(S: string);
  384.     function GetDoc: TPdfDoc;
  385.     function GetPage: TPdfDictionary;
  386.     function GetPageWidth: Integer;
  387.     function GetPageHeight: Integer;
  388.     function GetColorStr(Color: TPdfColor): string;
  389.   protected
  390.   public
  391.     constructor Create(APdfDoc: TPdfDoc);
  392.     destructor Destroy; override;
  393.  
  394.     {* Special Graphics State *}
  395.     procedure GSave;                                             {  q   }
  396.     procedure GRestore;                                          {  Q   }
  397.     procedure Concat(a, b, c, d, e, f: Single);                  {  cm  }
  398.  
  399.     {* General Graphics State *}
  400.     procedure SetFlat(flatness: Byte);                           {  i   }
  401.     procedure SetLineCap(linecap: TLineCapStyle);                {  J   }
  402.     procedure SetDash(aarray: array of Byte; phase: Byte);       {  d   }
  403.     procedure SetLineJoin(linejoin: TLineJoinStyle);             {  j   }
  404.     procedure SetLineWidth(linewidth: Single);                   {  w   }
  405.     procedure SetMiterLimit(miterlimit: Byte);                   {  M   }
  406.  
  407.     {* Paths *}
  408.     procedure MoveTo(x, y: Single);                              {  m   }
  409.     procedure LineTo(x, y: Single);                              {  l   }
  410.     procedure CurveToC(x1, y1, x2, y2, x3, y3: Single);          {  c   }
  411.     procedure CurveToV(x2, y2, x3, y3: Single);                  {  v   }
  412.     procedure CurveToY(x1, y1, x3, y3: Single);                  {  y   }
  413.     procedure Rectangle(x, y, width, height: Single);            {  re  }
  414.     procedure Closepath;                                         {  h   }
  415.     procedure NewPath;                                           {  n   }
  416.     procedure Stroke;                                            {  S   }
  417.     procedure ClosePathStroke;                                   {  s   }
  418.     procedure Fill;                                              {  f   }
  419.     procedure Eofill;                                            {  f*  }
  420.     procedure FillStroke;                                        {  B   }
  421.     procedure ClosepathFillStroke;                               {  b   }
  422.     procedure EofillStroke;                                      {  B*  }
  423.     procedure ClosepathEofillStroke;                             {  b*  }
  424.     procedure Clip;                                              {  W   }
  425.     procedure Eoclip;                                            {  W*  }
  426.  
  427.     {* Test state *}
  428.     procedure SetCharSpace(charSpace: Single);                   {  Tc  }
  429.     procedure SetWordSpace(wordSpace: Single);                   {  Tw  }
  430.     procedure SetHorizontalScaling(hScaling: Word);              {  Tz  }
  431.     procedure SetLeading(leading: Single);                       {  TL  }
  432.     procedure SetFontAndSize(fontname: string; size: Single);    {  Tf  }
  433.     procedure SetTextRenderingMode(mode: TTextRenderingMode);    {  Tr  }
  434.     procedure SetTextRise(rise: Word);                           {  Ts  }
  435.     procedure BeginText;                                         {  BT  }
  436.     procedure EndText;                                           {  ET  }
  437.     procedure MoveTextPoint(tx, ty: Single);                     {  Td  }
  438.     procedure SetTextMatrix(a, b, c, d, x, y: Word);             {  Tm  }
  439.     procedure MoveToNextLine;                                    {  T*  }
  440.     procedure ShowText(s: string);                               {  Tj  }
  441.     procedure ShowTextNextLine(s: string);                       {  '   }
  442.  
  443.     {* external objects *}
  444.     procedure ExecuteXObject(xObject: string);                   {  Do  }
  445.  
  446.     {* Device-dependent color space operators *}
  447.     procedure SetRGBFillColor(Value: TPdfColor);                 {  rg  }
  448.     procedure SetRGBStrokeColor(Value: TPdfColor);               {  RG  }
  449.  
  450.     {* utility routines *}
  451.     procedure SetPage(APage: TPdfDictionary);
  452.     procedure SetFont(AName: string; ASize: Single);
  453.     procedure TextOut(X, Y: Single; Text: string);
  454.     procedure TextRect(ARect: TPdfRect; Text: string;
  455.         Alignment: TPdfAlignment; Clipping: boolean);
  456.     procedure MultilineTextRect(ARect: TPdfRect;
  457.         Text: string; WordWrap: boolean);
  458.     procedure DrawXObject(X, Y, AWidth, AHeight: Single;
  459.         AXObjectName: string);
  460.     procedure DrawXObjectEx(X, Y, AWidth, AHeight: Single;
  461.         ClipX, ClipY, ClipWidth, ClipHeight: Single; AXObjectName: string);
  462.     procedure Ellipse(x, y, width, height: Single);
  463.     function TextWidth(Text: string): Single;
  464.     function MeasureText(Text: string; AWidth: Single): integer;
  465.     function GetNextWord(const S: string; var Index: integer): string;
  466.  
  467.     property Attribute: TPdfCanvasAttribute read FAttr;
  468.     property Contents: TPdfStream read FContents;
  469.     property Page: TPdfDictionary read GetPage;
  470.     property Doc: TPdfDoc read GetDoc;
  471.     property PageWidth: integer read GetPageWidth write SetPageWidth;
  472.     property PageHeight: integer read GetPageHeight write SetPageHeight;
  473.   end;
  474.  
  475.   TPdfDictionaryWrapper = class(TPersistent)
  476.   private
  477.     FData: TPdfDictionary;
  478.     function GetHasData: boolean;
  479.   protected
  480.     procedure SetData(AData: TPdfDictionary); virtual;
  481.   public
  482.     property Data: TPdfDictionary read FData write SetData;
  483.     property HasData: boolean read GetHasData;
  484.   end;
  485.  
  486.   TPdfInfo = class(TPdfDictionaryWrapper)
  487.   private
  488.     function GetAuthor: string;
  489.     procedure SetAuthor(Value: string);
  490.     function GetCreationDate: TDateTime;
  491.     procedure SetCreationDate(Value: TDateTime);
  492.     function GetCreator: string;
  493.     procedure SetCreator(Value: string);
  494.     function GetKeywords: string;
  495.     procedure SetKeywords(Value: string);
  496.     function GetSubject: string;
  497.     procedure SetSubject(Value: string);
  498.     function GetTitle: string;
  499.     procedure SetTitle(Value: string);
  500.     function GetModDate: TDateTime;
  501.     procedure SetModDate(Value: TDateTime);
  502.   public
  503.     property Author: string read GetAuthor write SetAuthor;
  504.     property CreationDate: TDateTime read GetCreationDate write SetCreationDate;
  505.     property Creator: string read GetCreator write SetCreator;
  506.     property Keywords: string read GetKeywords write SetKeywords;
  507.     property ModDate: TDateTime read GetModDate write SetModDate;
  508.     property Subject: string read GetSubject write SetSubject;
  509.     property Title: string read GetTitle write SetTitle;
  510.   end;
  511.  
  512.   TPdfCatalog = class(TPdfDictionaryWrapper)
  513.   private
  514.     FOpenAction: TPdfDestination;
  515.     procedure SetPageLayout(Value: TPdfPageLayout);
  516.     procedure SetPageMode(Value: TPdfPageMode);
  517.     procedure SetNonFullScreenPageMode(Value: TPdfPageMode);
  518.     procedure SetViewerPreference(Value: TPdfViewerPreferences);
  519.     procedure SetPages(APage: TPdfDictionary);
  520.     function GetPageLayout: TPdfPageLayout;
  521.     function GetPageMode: TPdfPageMode;
  522.     function GetNonFullScreenPageMode: TPdfPageMode;
  523.     function GetViewerPreference: TPdfViewerPreferences;
  524.     function GetPages: TPdfDictionary;
  525.   protected
  526.     procedure SaveOpenAction;
  527.   public
  528.     property OpenAction: TPdfDestination read FOpenAction write FOpenAction;
  529.     property PageLayout: TPdfPageLayout read GetPageLayout write SetPageLayout;
  530.     property NonFullScreenPageMode: TPdfPageMode
  531.                   read GetNonFullScreenPageMode write SetNonFullScreenPageMode;
  532.     property PageMode: TPdfPageMode read GetPageMode write SetPageMode;
  533.     property ViewerPreference: TPdfViewerPreferences
  534.                          read GetViewerPreference write SetViewerPreference;
  535.     property Pages: TPdfDictionary read GetPages write SetPages;
  536.   end;
  537.  
  538.   TPdfFont = class(TPdfDictionaryWrapper)
  539.   private
  540.     FName: string;
  541.   protected
  542.     procedure AddStrElements(ADic: TPdfDictionary; ATable: array of TPDF_STR_TBL);
  543.     procedure AddIntElements(ADic: TPdfDictionary; ATable: array of TPDF_INT_TBL);
  544.   public
  545.     constructor Create(AXref: TPdfXref; AName: string); virtual;
  546.     function GetCharWidth(AText: string; APos: integer): integer; virtual;
  547.     property Name: string read FName;
  548.   end;
  549.  
  550.   TPdfDestination = class(TObject)
  551.   private
  552.     FDoc: TPdfDoc;
  553.     FPage: TPdfDictionary;
  554.     FType: TPdfDestinationType;
  555.     FValues: array[0..3] of Integer;
  556.     FZoom: Single;
  557.     FReference: TObject;
  558.     procedure SetElement(Index: integer; Value: Integer);
  559.     procedure SetZoom(Value: Single);
  560.     function GetElement(Index: integer): Integer;
  561.     function GetPageWidth: Integer;
  562.     function GetPageHeight: Integer;
  563.   public
  564.     constructor Create(APdfDoc: TPdfDoc);
  565.     destructor Destroy; override;
  566.     function GetValue: TPdfArray;
  567.     property DestinationType: TPdfDestinationType read FType write FType;
  568.     property Doc: TPdfDoc read FDoc;
  569.     property Left: Integer index 0 read GetElement write SetElement;
  570.     property Top: Integer index 1 read GetElement write SetElement;
  571.     property Right: Integer index 2 read GetElement write SetElement;
  572.     property Bottom: Integer index 3 read GetElement write SetElement;
  573.     property PageHeight: Integer read GetPageHeight;
  574.     property PageWidth: Integer read GetPageWidth;
  575.     property Zoom: Single read FZoom write SetZoom;
  576.     property Reference: TObject read FReference write FReference;
  577.   end;
  578.  
  579.   TPdfOutlineEntry = class(TPdfDictionaryWrapper)
  580.   private
  581.     FParent: TPdfOutlineEntry;
  582.     FNext: TPdfOutlineEntry;
  583.     FPrev: TPdfOutlineEntry;
  584.     FFirst: TPdfOutlineEntry;
  585.     FLast: TPdfOutlineEntry;
  586.     FDest: TPdfDestination;
  587.     FDoc: TPdfDoc;
  588.     FTitle: string;
  589.     FOpened: boolean;
  590.     FCount: integer;
  591.     FReference: TObject;
  592.   protected
  593.     constructor CreateEntry(AParent: TPdfOutlineEntry); virtual;
  594.     procedure Save; virtual;
  595.   public
  596.     destructor Destroy; override;
  597.     function AddChild: TPdfOutlineEntry;
  598.     property Doc: TPdfDoc read FDoc;
  599.     property Parent: TPdfOutlineEntry read FParent;
  600.     property Next: TPdfOutlineEntry read FNext;
  601.     property Prev: TPdfOutlineEntry read FPrev;
  602.     property First: TPdfOutlineEntry read FFirst;
  603.     property Last: TPdfOutlineEntry read FLast;
  604.     property Dest: TPdfDestination read FDest write FDest;
  605.     property Title: string read FTitle write FTitle;
  606.     property Opened: boolean read FOpened write FOpened;
  607.     property Reference: TObject read FReference write FReference;
  608.   end;
  609.  
  610.   TPdfOutlineRoot = class(TPdfOutlineEntry)
  611.   protected
  612.     constructor CreateRoot(ADoc: TPdfDoc); virtual;
  613.   public
  614.     procedure Save; override;
  615.   end;
  616.  
  617. implementation
  618.  
  619. { Utility functions }
  620.  
  621. // _Pages_AddKids
  622. procedure _Pages_AddKids(AParent: TPdfDictionary; AKid: TPdfDictionary);
  623. var
  624.   FKids: TPdfArray;
  625. begin
  626.   // adding page object to the parent pages object.
  627.   FKids := AParent.PdfArrayByName('Kids');
  628.   FKids.AddItem(AKid);
  629.   AParent.PdfNumberByName('Count').Value := FKids.ItemCount;
  630. end;
  631.  
  632. // _Page_GetResources
  633. function _Page_GetResources(APage: TPdfDictionary; AName: string): TPdfDictionary;
  634. var
  635.   FResources: TPdfDictionary;
  636. begin
  637.   FResources := APage.PdfDictionaryByName('Resources');
  638.   Result := FResources.PdfDictionaryByName(AName);
  639. end;
  640.  
  641. { TPdfHeader }
  642.  
  643. // WriteToStream
  644. procedure TPdfHeader.WriteToStream(const AStream: TStream);
  645. begin
  646.   _WriteString('%PDF-1.2 '#13#10, AStream);
  647. end;
  648.  
  649. { TPdfTrailer }
  650.  
  651. // WriteToStream
  652. procedure TPdfTrailer.WriteToStream(const AStream: TStream);
  653. begin
  654.   _WriteString('trailer' + CRLF, AStream);
  655.   FAttributes.WriteToStream(AStream);
  656.   _WriteString(CRLF + 'startxref' + CRLF, AStream);
  657.   _WriteString(IntToStr(FXrefAddress) + CRLF, AStream);
  658.   _WriteString('%%EOF' + CRLF, AStream);
  659. end;
  660.  
  661. // Create
  662. constructor TPdfTrailer.Create(AObjectMgr: TPdfObjectMgr);
  663. begin
  664.   inherited Create;
  665.   FAttributes := TPdfDictionary.CreateDictionary(AObjectMgr);
  666.   FAttributes.AddItem('Size', TPdfNumber.CreateNumber(0));
  667. end;
  668.  
  669. // Destroy
  670. destructor TPdfTrailer.Destroy;
  671. begin
  672.   FAttributes.Free;
  673.   inherited;
  674. end;
  675.  
  676. { TPdfXrefEntry }
  677.  
  678. // Create
  679. constructor TPdfXrefEntry.Create(AValue: TPdfObject);
  680. begin
  681.   FByteOffset := -1;
  682.   if AValue <> nil then
  683.   begin
  684.     FEntryType := PDF_IN_USE_ENTRY;
  685.     FGenerationNumber := AValue.GenerationNumber;
  686.     FValue := AValue;
  687.   end
  688.   else
  689.   begin
  690.     FEntryType := PDF_FREE_ENTRY;
  691.     FGenerationNumber := 0;
  692.   end;
  693. end;
  694.  
  695. // Destroy
  696. destructor TPdfXrefEntry.Destroy;
  697. begin
  698.   if FEntryType = PDF_IN_USE_ENTRY then
  699.     FValue.Free;
  700.   inherited;
  701. end;
  702.  
  703. // GetAsString
  704. function TPdfXrefEntry.GetAsString: string;
  705.   function FormatIntToString(Value: integer; Len: integer): string;
  706.   var
  707.     S: string;
  708.     i, j: integer;
  709.   begin
  710.     Result := '';
  711.     if Value < 0 then
  712.       S := '0'
  713.     else
  714.       S := IntToStr(Value);
  715.     i := Len - Length(S);
  716.     for j := 0 to i - 1 do
  717.       Result := Result + '0';
  718.     Result := Result + S;
  719.   end;
  720. begin
  721.   Result := FormatIntToString(FByteOffset, 10) +
  722.             ' ' +
  723.             FormatIntToString(FGenerationNumber, 5) +
  724.             ' ' +
  725.             FEntryType;
  726. end;
  727.  
  728. { TPdfXref }
  729.  
  730. // Create
  731. constructor TPdfXref.Create;
  732. var
  733.   RootEntry: TPdfXrefEntry;
  734. begin
  735.   FXrefEntries := TList.Create;
  736.   RootEntry := TPdfXrefEntry.Create(nil);
  737.   RootEntry.GenerationNumber := PDF_MAX_GENERATION_NUM;
  738.   FXrefEntries.Add(RootEntry);
  739. end;
  740.  
  741. // Destroy
  742. destructor TPdfXref.Destroy;
  743. var
  744.   i: integer;
  745. begin
  746.   for i := 1 to FXrefEntries.Count - 1 do
  747.     GetItem(i).Free;
  748.   FXrefEntries.Free;
  749.   inherited;
  750. end;
  751.  
  752. // AddObject
  753. procedure TPdfXref.AddObject(AObject: TPdfObject);
  754. var
  755.   ObjectNumber: integer;
  756.   XrefEntry: TPdfXrefEntry;
  757. begin
  758.   // register object to xref table, and set objectnumber.
  759.   if AObject.ObjectType <> otDirectObject then
  760.     raise EPdfInvalidOperation.Create('AddObject --wrong object type.');
  761.   XrefEntry := TPdfXrefEntry.Create(AObject);
  762.   ObjectNumber := FXrefEntries.Add(XrefEntry);
  763.   AObject.SetObjectNumber(ObjectNumber);
  764. end;
  765.  
  766. // GetItem
  767. function TPdfXref.GetItem(ObjectID: integer): TPdfXrefEntry;
  768. begin
  769.   Result := TPdfXrefEntry(FXrefEntries.Items[ObjectID]);
  770. end;
  771.  
  772. // GetItemCount
  773. function TPdfXref.GetItemCount: integer;
  774. begin
  775.   Result := FXrefEntries.Count;
  776. end;
  777.  
  778. // GetObject
  779. function TPdfXref.GetObject(ObjectID: integer): TPdfObject;
  780. begin
  781.   Result := GetItem(ObjectID).Value;
  782. end;
  783.  
  784. // WriteToStream
  785. procedure TPdfXref.WriteToStream(const AStream: TStream);
  786. var
  787.   i: integer;
  788.   S: string;
  789.   Count: integer;
  790. begin
  791.   Count := FXrefEntries.Count;
  792.   S := 'xref' +
  793.        CRLF +
  794.        '0 ' +
  795.        IntToStr(Count) +
  796.        CRLF;
  797.   for i := 0 to Count - 1 do
  798.     S := S + Items[i].AsString + CRLF;
  799.   _WriteString(S, AStream);
  800. end;
  801.  
  802. { TPdfDoc }
  803.  
  804. // Create
  805. constructor TPdfDoc.Create;
  806. begin
  807.   inherited Create;
  808.   FHasDoc := false;
  809.   FCanvas := TPdfCanvas.Create(Self);
  810.   FDefaultPageWidth := PDF_DEFAULT_PAGE_WIDTH;
  811.   FDefaultPageHeight := PDF_DEFAULT_PAGE_HEIGHT;
  812.   FInfo := nil;
  813.   FRoot := nil;
  814. end;
  815.  
  816. // GetCanvas
  817. function TPdfDoc.GetCanvas: TPdfCanvas;
  818. begin
  819.   if not HasDoc then
  820.     raise EPdfInvalidOperation.Create('GetCanvas --Document is null');
  821.   Result := FCanvas;
  822. end;
  823.  
  824. // GetInfo
  825. function TPdfDoc.GetInfo: TPdfInfo;
  826. begin
  827.   if not HasDoc then
  828.     raise EPdfInvalidOperation.Create('GetInfo --this method can not use this state..');
  829.   if FInfo = nil then
  830.     CreateInfo;
  831.   Result := FInfo;
  832. end;
  833.  
  834. // GetRoot
  835. function TPdfDoc.GetRoot: TPdfCatalog;
  836. begin
  837.   if not HasDoc then
  838.     raise EPdfInvalidOperation.Create('GetRoot --this method can not use this state..');
  839.   Result := FRoot;
  840. end;
  841.  
  842. // GetOutlineRoot
  843. function TPdfDoc.GetOutlineRoot: TPdfOutlineRoot;
  844. begin
  845.   if not HasDoc then
  846.     raise EPdfInvalidOperation.Create('GetOutlineRoot --document is null..');
  847.   if not UseOutlines then
  848.     raise EPdfInvalidOperation.Create('GetOutlineRoot --not use outline mode..');
  849.   Result := FOutlineRoot;
  850. end;
  851.  
  852. // Destroy
  853. destructor TPdfDoc.Destroy;
  854. begin
  855.   FreeDoc;
  856.   FCanvas.Free;
  857.   inherited;
  858. end;
  859.  
  860. // CreateCatalog
  861. function TPdfDoc.CreateCatalog: TPdfDictionary;
  862. begin
  863.   // create catalog object and register to xref.
  864.   Result := TPdfDictionary.CreateDictionary(FXref);
  865.   FXref.AddObject(Result);
  866.   Result.AddItem('Type', TPdfName.CreateName('Catalog'));
  867.   FTrailer.Attributes.AddItem('Root', Result);
  868. end;
  869.  
  870. // CreateFont
  871. function TPdfDoc.CreateFont(FontName: string): TPdfFont;
  872. var
  873.   PdfFont: TPdfFont;
  874. begin
  875.   // create new font (not regist to xref -- because font object registed by
  876.   // TPdfFont).
  877.   PdfFont := TPdfFont(FindClass(FontName).Create);
  878.   if PdfFont = nil then
  879.     raise Exception.Create('CreateFont --InvalidFontName:' + FontName);
  880.   Result := PdfFont.Create(FXref, FontName);
  881.   Result.Data.AddItem('Name',
  882.     TPdfName.CreateName('F' + IntToStr(FFontList.Count)));
  883.   FFontList.Add(Result);
  884. end;
  885.  
  886. // RegisterXObject
  887. procedure TPdfDoc.RegisterXObject(AObject: TPdfXObject; AName: string);
  888. begin
  889.    // check object and register it.
  890.    if AObject = nil then
  891.      raise EPdfInvalidValue.Create('RegisterXObject --AObject is null');
  892.    if _GetTypeOf(AObject.Attributes) <> 'XObject' then
  893.      raise EPdfInvalidValue.Create('RegisterXObject --not XObject');
  894.    if AObject.ObjectType <> otIndirectObject then
  895.      FXref.AddObject(AObject);
  896.    if AObject.Attributes.ValueByName('Name') = nil then
  897.    begin
  898.      if GetXObject(AName) <> nil then
  899.        raise EPdfInvalidValue.Createfmt('RegisterXObject --dupulicate name: %s', [AName]);
  900.      FXObjectList.AddItem(AObject);
  901.      AObject.Attributes.AddItem('Name', TPdfName.CreateName(AName));
  902.    end;
  903. end;
  904.  
  905. // CreateInfo
  906. procedure TPdfDoc.CreateInfo;
  907. var
  908.   FInfoDictionary: TPdfDictionary;
  909. begin
  910.   FInfoDictionary := TPdfDictionary.CreateDictionary(FXref);
  911.   FXref.AddObject(FInfoDictionary);
  912.   FInfoDictionary.AddItem('Producer', TPdfText.CreateText(POWER_PDF_VERSION_TEXT));
  913.   FTrailer.Attributes.AddItem('Info', FInfoDictionary);
  914.   FInfo := TPdfInfo.Create;
  915.   FInfo.SetData(FInfoDictionary);
  916.   FObjectList.Add(FInfo);
  917. end;
  918.  
  919. // CreatePages
  920. function TPdfDoc.CreatePages(Parent: TPdfDictionary): TPdfDictionary;
  921. begin
  922.   // create pages object and register to xref.
  923.   result := TPdfDictionary.CreateDictionary(FXref);
  924.   FXref.AddObject(Result);
  925.   with Result do
  926.   begin
  927.     AddItem('Type', TPdfName.CreateName('Pages'));
  928.     AddItem('Kids', TPdfArray.CreateArray(FXref));
  929.     AddItem('Count', TPdfNumber.CreateNumber(0));
  930.   end;
  931.  
  932.   if (Parent <> nil) and (_GetTypeOf(Parent) = 'Pages') then
  933.     _Pages_AddKids(Parent, Result)
  934.   else
  935.     FRoot.Pages := Result;
  936. end;
  937.  
  938. // CreateOutlines
  939. procedure TPdfDoc.CreateOutlines;
  940. begin
  941.   FOutlineRoot := TPdfOutlineRoot.CreateRoot(Self);
  942.   FRoot.Data.AddItem('Outlines', FOutlineRoot.Data);
  943. end;
  944.  
  945. // GetFont
  946. function TPdfDoc.GetFont(FontName: string): TPdfFont;
  947. var
  948.   FFont: TPdfFont;
  949.   i :integer;
  950. begin
  951.   if not HasDoc then
  952.     raise EPdfInvalidOperation.Create('GetFont --document is null.');
  953.  
  954.   // if specified font exists in fontlist, return it. otherwise, create the font.
  955.   Result := nil;
  956.   for i := 0 to FFontList.Count - 1 do
  957.   begin
  958.     FFont := TPdfFont(FFontList.Items[i]);
  959.     if FFont.Name = FontName then
  960.     begin
  961.       Result := FFont;
  962.       Break;
  963.     end;
  964.   end;
  965.   if Result = nil then
  966.     Result := CreateFont(FontName);
  967. end;
  968.  
  969. // GetXObject
  970. function TPdfDoc.GetXObject(AName: string): TPdfXObject;
  971. var
  972.   FXObject: TPdfXObject;
  973.   i :integer;
  974. begin
  975.   // return the XObject which name is muched with specified name.
  976.   Result := nil;
  977.   for i := 0 to FXObjectList.ItemCount - 1 do
  978.   begin
  979.     FXObject := TPdfXObject(FXObjectList.Items[i]);
  980.     if TPdfName(FXObject.Attributes.ValueByName('Name')).Value = AName then
  981.     begin
  982.       Result := FXObject;
  983.       Break;
  984.     end;
  985.   end;
  986. end;
  987.  
  988. // CreateAnnotation
  989. function TPdfDoc.CreateAnnotation(AType: TPdfAnnotationSubType; ARect: TPdfRect): TPdfDictionary;
  990. var
  991.   FAnnotation: TPdfDictionary;
  992.   FArray: TPdfArray;
  993.   FPage: TPdfDictionary;
  994. begin
  995.   if not HasDoc then
  996.     raise EPdfInvalidOperation.Create('AddAnotation --document is null.');
  997.  
  998.   // create new annotation and set the properties.
  999.   FAnnotation := TPdfDictionary.CreateDictionary(FXref);
  1000.   FXref.AddObject(FAnnotation);
  1001.   with FAnnotation do
  1002.   begin
  1003.     AddItem('Type', TPdfName.CreateName('Annot'));
  1004.     AddItem('Subtype', TPdfName.CreateName(PDF_ANNOTATION_TYPE_NAMES[ord(AType)]));
  1005.     FArray := TPdfArray.CreateArray(nil);
  1006.     with FArray, ARect do
  1007.     begin
  1008.       AddItem(TPdfReal.CreateReal(Left));
  1009.       AddItem(TPdfReal.CreateReal(Top));
  1010.       AddItem(TPdfReal.CreateReal(Right));
  1011.       AddItem(TPdfReal.CreateReal(Bottom));
  1012.     end;
  1013.     AddItem('Rect', FArray);
  1014.   end;
  1015.  
  1016.   // adding annotation to the current page
  1017.   FPage := FCanvas.Page;
  1018.   FArray := FPage.PdfArrayByName('Annots');
  1019.   if FArray = nil then
  1020.   begin
  1021.     FArray := TPdfArray.CreateArray(nil);
  1022.     FPage.AddItem('Annots', FArray);
  1023.   end;
  1024.   FArray.AddItem(FAnnotation);
  1025.  
  1026.   Result := FAnnotation;
  1027. end;
  1028.  
  1029. // CreateDestination
  1030. function TPdfDoc.CreateDestination: TPdfDestination;
  1031. begin
  1032.   Result := TPdfDestination.Create(Self);
  1033.   FObjectList.Add(Result);
  1034. end;
  1035.  
  1036. // NewDoc
  1037. procedure TPdfDoc.NewDoc;
  1038. begin
  1039.   {*
  1040.    * create new document.
  1041.    *}
  1042.   FreeDoc;
  1043.   FXref := TPdfXref.Create;
  1044.   FHeader := TPdfHeader.Create;
  1045.   FTrailer := TPdfTrailer.Create(FXref);
  1046.   FFontList := TList.Create;
  1047.   FXObjectList := TPdfArray.CreateArray(FXref);
  1048.   FObjectList := TList.Create;
  1049.  
  1050.   FRoot := TPdfCatalog.Create;
  1051.   FRoot.SetData(CreateCatalog);
  1052.   FObjectList.Add(FRoot);
  1053.  
  1054.   if UseOutlines then
  1055.     CreateOutlines;
  1056.  
  1057.   CreateInfo;
  1058.   FInfo.CreationDate := now;
  1059.  
  1060.   FCurrentPages := CreatePages(nil);
  1061.   FRoot.SetPages(FCurrentPages);
  1062.  
  1063.   FHasDoc := true;
  1064. end;
  1065.  
  1066. // AddXObject
  1067. procedure TPdfDoc.AddXObject(AName: string; AXObject: TPdfXObject);
  1068. begin
  1069.   if GetXObject(AName) <> nil then
  1070.     raise Exception.CreateFmt('AddImage --the image named %s is already exists..', [AName]);
  1071.  
  1072.   // check whether AImage is valid PdfImage or not.
  1073.   if (AXObject = nil) or (AXObject.Attributes = nil) or
  1074.     (_GetTypeOf(AXObject.Attributes) <> 'XObject') or
  1075.     (AXObject.Attributes.PdfNameByName('Subtype').Value <> 'Image') then
  1076.     raise Exception.Create('AddImage --the image is not valid TPdfImage..');
  1077.  
  1078.   FXref.AddObject(AXObject);
  1079.   RegisterXObject(AXObject, AName);
  1080. end;
  1081.  
  1082. // AddPage
  1083. procedure TPdfDoc.AddPage;
  1084. var
  1085.   FPage: TPdfDictionary;
  1086.   FMediaBox: TPdfArray;
  1087.   FContents: TPdfStream;
  1088.   FResources: TPdfDictionary;
  1089.   FProcSet: TPdfArray;
  1090.   FFontArray: TPdfDictionary;
  1091.   FXObjectArray: TPdfDictionary;
  1092.   {$IFNDEF NOZLIB}
  1093.   FFilter: TPdfArray;
  1094.   {$ENDIF}
  1095. begin
  1096.   if FCurrentPages = nil then
  1097.     raise EPdfInvalidOperation.Create('AddPage --current pages null.');
  1098.  
  1099.   // create new page object and add it to the current pages object.
  1100.   FPage := TPdfDictionary.CreateDictionary(FXref);
  1101.   FXref.AddObject(FPage);
  1102.  
  1103.   _Pages_AddKids(FCurrentPages, FPage);
  1104.  
  1105.   FPage.AddItem('Type', TPdfName.CreateName('Page'));
  1106.   FPage.AddItem('Parent', FCurrentPages);
  1107.  
  1108.   FMediaBox := TPdfArray.CreateArray(FXref);
  1109.   with FMediabox do
  1110.   begin
  1111.     AddItem(TPdfNumber.CreateNumber(0));
  1112.     AddItem(TPdfNumber.CreateNumber(0));
  1113.     AddItem(TPdfNumber.CreateNumber(DefaultPageWidth));
  1114.     AddItem(TPdfNumber.CreateNumber(DefaultPageHeight));
  1115.   end;
  1116.   FPage.AddItem('MediaBox', FMediaBox);
  1117.  
  1118.   FResources := TPdfDictionary.CreateDictionary(FXref);
  1119.   FPage.AddItem('Resources', FResources);
  1120.  
  1121.   FFontArray := TPdfDictionary.CreateDictionary(FXref);
  1122.   FResources.AddItem('Font', FFontArray);
  1123.  
  1124.   FXObjectArray := TPdfDictionary.CreateDictionary(FXref);
  1125.   FResources.AddItem('XObject', FXObjectArray);
  1126.  
  1127.   FProcSet := TPdfArray.CreateArray(FXref);
  1128.   with FProcSet do
  1129.   begin
  1130.     AddItem(TPdfName.CreateName('PDF'));
  1131.     AddItem(TPdfName.CreateName('Text'));
  1132.     AddItem(TPdfName.CreateName('ImageC'));
  1133.   end;
  1134.   FResources.AddItem('ProcSet', FProcSet);
  1135.  
  1136.   FContents := TPdfStream.CreateStream(FXref);
  1137.   FXref.AddObject(FContents);
  1138.   {$IFNDEF NOZLIB}
  1139.   FFilter := FContents.Attributes.PdfArrayByName('Filter');
  1140.   if FCompressionMethod = cmFlateDecode then
  1141.     FFilter.AddItem(TPdfName.CreateName('FlateDecode'));
  1142.   {$ENDIF}
  1143.   FPage.AddItem('Contents', FContents);
  1144.  
  1145.   FCanvas.SetPage(FPage);
  1146. end;
  1147.  
  1148. // FreeDoc
  1149. procedure TPdfDoc.FreeDoc;
  1150. var
  1151.   i: integer;
  1152. begin
  1153.   if FHasDoc then
  1154.   begin
  1155.     FXObjectList.Free;
  1156.  
  1157.     for i := FFontList.Count - 1 downto 0 do
  1158.       TObject(FFontList.Items[i]).Free;
  1159.     FFontList.Free;
  1160.  
  1161.     for i := FObjectList.Count - 1 downto 0 do
  1162.       TObject(FObjectList.Items[i]).Free;
  1163.     FObjectList.Free;
  1164.  
  1165.     FXref.Free;
  1166.     FHeader.Free;
  1167.     FTrailer.Free;
  1168.  
  1169.     FInfo := nil;
  1170.     FRoot := nil;
  1171.     FOutlineRoot := nil;
  1172.  
  1173.     FHasDoc := false;
  1174.   end;
  1175. end;
  1176.  
  1177. // SaveToStream
  1178. procedure TPdfDoc.SaveToStream(AStream: TStream);
  1179. var
  1180.   i: integer;
  1181.   Pos: integer;
  1182.   PdfNumber: TPdfNumber;
  1183. begin
  1184.   if not HasDoc or (FCanvas.Page = nil) then
  1185.     raise EPdfInvalidOperation.Create('SaveToStream --there is no document to save.');
  1186.   // write all objects to specified stream.
  1187.  
  1188.   FInfo.ModDate := Now;
  1189.   FRoot.SaveOpenAction;
  1190.  
  1191.   // saving outline tree.
  1192.   if UseOutlines then
  1193.     FOutlineRoot.Save;
  1194.  
  1195.   AStream.Position := 0;
  1196.   FHeader.WriteToStream(AStream);
  1197.   for i := 1 to FXref.ItemCount - 1 do
  1198.   begin
  1199.     Pos := AStream.Position;
  1200.     FXref.Items[i].Value.WriteValueToStream(AStream);
  1201.     FXref.Items[i].ByteOffset := Pos;
  1202.   end;
  1203.   FTrailer.XrefAddress := AStream.Position;
  1204.   FXref.WriteToStream(AStream);
  1205.   PdfNumber := FTrailer.Attributes.PdfNumberByName('Size');
  1206.   PdfNumber.Value := FXref.ItemCount;
  1207.   FTrailer.WriteToStream(AStream);
  1208. end;
  1209.  
  1210. // SetVirtualMode
  1211. procedure TPdfDoc.SetVirtualMode;
  1212. begin
  1213.   NewDoc;
  1214.   AddPage;
  1215.   FCanvas.FIsVirtual := true;
  1216. end;
  1217.  
  1218.  
  1219. { TPdfCanvasAttribute }
  1220.  
  1221. // SetWordSpace
  1222. procedure TPdfCanvasAttribute.SetWordSpace(Value: Single);
  1223. begin
  1224.   if Value < 0 then
  1225.     raise EPdfInvalidValue.Create('SetWordSpace --invalid word space');
  1226.   if Value <> FWordSpace then
  1227.     FWordSpace := Value;
  1228. end;
  1229.  
  1230. // SetCharSpace
  1231. procedure TPdfCanvasAttribute.SetCharSpace(Value: Single);
  1232. begin
  1233.   if (Value < PDF_MIN_CHARSPACE) or (VALUE > PDF_MAX_CHARSPACE) then
  1234.     raise EPdfInvalidValue.Create('SetCharSpace --invalid char space');
  1235.   if Value <> FCharSpace then
  1236.     FCharSpace := Value;
  1237. end;
  1238.  
  1239. // SetFontSize
  1240. procedure TPdfCanvasAttribute.SetFontSize(Value: Single);
  1241. begin
  1242.   if (Value < 0) or (Value > PDF_MAX_FONTSIZE) then
  1243.     raise EPdfInvalidValue.Create('SetCharSpace --invalid font size');
  1244.   if Value <> FFontSize then
  1245.     FFontSize := Value;
  1246. end;
  1247.  
  1248. // SetHorizontalScaling
  1249. procedure TPdfCanvasAttribute.SetHorizontalScaling(Value: Word);
  1250. begin
  1251.   if (Value < PDF_MIN_HORIZONTALSCALING) or
  1252.     (Value > PDF_MAX_HORIZONTALSCALING) then
  1253.     raise EPdfInvalidValue.Create('SetHorizontalScaling --invalid font size');
  1254.   if Value <> FHorizontalScaling then
  1255.     FHorizontalScaling := Value;
  1256. end;
  1257.  
  1258. // SetLeading
  1259. procedure TPdfCanvasAttribute.SetLeading(Value: Single);
  1260. begin
  1261.   if (Value < 0) or (Value > PDF_MAX_LEADING) then
  1262.     raise EPdfInvalidValue.Create('SetLeading --invalid font size');
  1263.   if Value <> FLeading then
  1264.     FLeading := Value;
  1265. end;
  1266.  
  1267. // TextWidth
  1268. function TPdfCanvasAttribute.TextWidth(Text: string): Single;
  1269. var
  1270.   i: integer;
  1271.   ch: char;
  1272.   tmpWidth: Single;
  1273. begin
  1274.   Result := 0;
  1275.  
  1276.   // calculate width of specified text from current attributes
  1277.   for i := 1 to Length(Text) do
  1278.   begin
  1279.     ch := Text[i];
  1280.     tmpWidth := FFont.GetCharWidth(Text, i) * FFontSize / 1000;
  1281.     if FHorizontalScaling <> 100 then
  1282.       tmpWidth := tmpWidth * FHorizontalScaling / 100;
  1283.     if tmpWidth > 0 then
  1284.       tmpWidth := tmpWidth + FCharSpace
  1285.     else
  1286.       tmpWidth := 0;
  1287.     if (ch = ' ') and (FWordSpace > 0) and (i <> Length(Text)) then
  1288.       tmpWidth := tmpWidth + FWordSpace;
  1289.  
  1290.     Result := Result + tmpWidth;
  1291.   end;
  1292.   Result := Result - FCharSpace;
  1293. end;
  1294.  
  1295. // MeasureText
  1296. function TPdfCanvasAttribute.MeasureText(Text: string; Width: Single): integer;
  1297. var
  1298.   i: integer;
  1299.   ch: char;
  1300.   tmpWidth: Single;
  1301.   tmpTotalWidth: Single;
  1302. begin
  1303.   Result := 0;
  1304.   tmpTotalWidth := 0;
  1305.  
  1306.   // calculate number of charactor contain in the specified width.
  1307.   for i := 1 to Length(Text) do
  1308.   begin
  1309.     ch := Text[i];
  1310.     tmpWidth := FFont.GetCharWidth(Text, i) * FFontSize / 1000;
  1311.     if FHorizontalScaling <> 100 then
  1312.       tmpWidth := tmpWidth * FHorizontalScaling / 100;
  1313.     if tmpWidth > 0 then
  1314.       tmpWidth := tmpWidth + FCharSpace
  1315.     else
  1316.       tmpWidth := 0;
  1317.     if (ch = ' ') and (FWordSpace > 0) and (i <> Length(Text)) then
  1318.       tmpWidth := tmpWidth + FWordSpace;
  1319.  
  1320.     tmpTotalWidth := tmpTotalWidth + tmpWidth;
  1321.     if tmpTotalWidth > Width then
  1322.       Break;
  1323.     inc(Result);
  1324.   end;
  1325. end;
  1326.  
  1327. { TPdfCanvas }
  1328.  
  1329. // Create
  1330. constructor TPdfCanvas.Create(APdfDoc: TPdfDoc);
  1331. begin
  1332.   FPdfDoc := APdfDoc;
  1333.   FPage := nil;
  1334.   FContents := nil;
  1335.   FAttr := TPdfCanvasAttribute.Create;
  1336.   FIsVirtual := false;
  1337. end;
  1338.  
  1339. // Destroy
  1340. destructor TPdfCanvas.Destroy;
  1341. begin
  1342.   FAttr.Free;
  1343.   inherited;
  1344. end;
  1345.  
  1346. // SetPageWidth
  1347. procedure TPdfCanvas.SetPageWidth(AValue: integer);
  1348. var
  1349.   FMediaBox: TPdfArray;
  1350. begin
  1351.   FMediaBox := TPdfArray(Page.ValueByName('MediaBox'));
  1352.   if FMediaBox <> nil then
  1353.     TPdfNumber(FMediaBox.Items[2]).Value := AValue
  1354.   else
  1355.     EPdfInvalidOperation.Create('Can not chenge width of this page..');
  1356. end;
  1357.  
  1358. // SetPageHeight
  1359. procedure TPdfCanvas.SetPageHeight(AValue: integer);
  1360. var
  1361.   FMediaBox: TPdfArray;
  1362. begin
  1363.   FMediaBox := TPdfArray(Page.ValueByName('MediaBox'));
  1364.   if FMediaBox <> nil then
  1365.     TPdfNumber(FMediaBox.Items[3]).Value := AValue
  1366.   else
  1367.     EPdfInvalidOperation.Create('Can not chenge width of this page..');
  1368. end;
  1369.  
  1370. // WriteString
  1371. procedure TPdfCanvas.WriteString(S: string);
  1372. begin
  1373.   if (not FIsVirtual) and (FContents <> nil) then
  1374.     _WriteString(S, FContents.Stream);
  1375. end;
  1376.  
  1377. // GetPage
  1378. function TPdfCanvas.GetPage: TPdfDictionary;
  1379. begin
  1380.   if FPage <> nil then
  1381.     result := FPage
  1382.   else
  1383.     raise EPdfInvalidOperation.Create('GetPage --the Page is nil');
  1384. end;
  1385.  
  1386. // GetPageWidth
  1387. function TPdfCanvas.GetPageWidth: Integer;
  1388. var
  1389.   FMediaBox: TPdfArray;
  1390. begin
  1391.   FMediaBox := TPdfArray(Page.ValueByName('MediaBox'));
  1392.   if FMediaBox <> nil then
  1393.     result := TPdfNumber(FMediaBox.Items[2]).Value
  1394.   else
  1395.     result := FPdfDoc.DefaultPageWidth;
  1396. end;
  1397.  
  1398. // GetPageHeight
  1399. function TPdfCanvas.GetPageHeight: Integer;
  1400. var
  1401.   FMediaBox: TPdfArray;
  1402. begin
  1403.   FMediaBox := TPdfArray(Page.ValueByName('MediaBox'));
  1404.   if FMediaBox <> nil then
  1405.     result := TPdfNumber(FMediaBox.Items[3]).Value
  1406.   else
  1407.     result := FPdfDoc.DefaultPageHeight;
  1408. end;
  1409.  
  1410. // GetColorStr
  1411. function TPDFCanvas.GetColorStr(Color: TPdfColor): string;
  1412. var
  1413.   X: array[0..3] of Byte;
  1414.   rgb: integer;
  1415. begin
  1416.   if Color > 0 then
  1417.     rgb := integer(Color)
  1418.   else
  1419.     rgb := 0;
  1420.   Move(rgb, x[0], 4);
  1421.   result := _FloatToStrR(X[0] / 255) + ' ' +
  1422.             _FloatToStrR(X[1] / 255) + ' ' +
  1423.             _FloatToStrR(X[2] / 255);
  1424. end;
  1425.  
  1426. // SetPage
  1427. procedure TPdfCanvas.SetPage(APage: TPdfDictionary);
  1428.   procedure GetCurrentFont;
  1429.   var
  1430.     AFont: TPdfName;
  1431.   begin
  1432.     AFont := Page.PdfNameByName('_Font');
  1433.     with FAttr do
  1434.       if AFont <> nil then
  1435.       begin
  1436.         Font := FPdfDoc.GetFont(AFont.Value);
  1437.         FontSize := FPage.PdfNumberByName('_Font_Size').Value;
  1438.         WordSpace := FPage.PdfRealByName('_Word_Space').Value;
  1439.         CharSpace := FPage.PdfRealByName('_Char_Space').Value;
  1440.         HorizontalScaling := FPage.PdfNumberByName('_HScalling').Value;
  1441.         Leading := FPage.PdfNumberByName('_Leading').Value;
  1442.       end
  1443.       else
  1444.       begin
  1445.         Font := nil;
  1446.         SetFont(PDF_DEFAULT_FONT, PDF_DEFAULT_FONT_SIZE);
  1447.         CharSpace := 0;
  1448.         WordSpace := 0;
  1449.         HorizontalScaling := 100;
  1450.         Leading := 0;
  1451.       end;
  1452.   end;
  1453. begin
  1454.   // save current canvas attributes to internal objects.
  1455.   if FPage <> nil then
  1456.   with FPage do
  1457.     begin
  1458.       AddInternalItem('_Font', TPdfName.CreateName(FAttr.Font.Name));
  1459.       AddInternalItem('_Font_Size', TPdfReal.CreateReal(FAttr.FontSize));
  1460.       AddInternalItem('_Word_Space', TPdfReal.CreateReal(FAttr.WordSpace));
  1461.       AddInternalItem('_Char_Space', TPdfReal.CreateReal(FAttr.CharSpace));
  1462.       AddInternalItem('_HScalling', TPdfNumber.CreateNumber(FAttr.HorizontalScaling));
  1463.       AddInternalItem('_Leading', TPdfReal.CreateReal(FAttr.Leading));
  1464.     end;
  1465.   FPage := APage;
  1466.   FContents := TPdfStream(FPage.ValueByName('Contents'));
  1467.   GetCurrentFont;
  1468. end;
  1469.  
  1470. // SetFont
  1471. procedure TPdfCanvas.SetFont(AName: string; ASize: Single);
  1472. var
  1473.   FFont: TPdfFont;
  1474.   FFontList: TPdfDictionary;
  1475.   FFontName: string;
  1476. begin
  1477.   // get font object from pdfdoc object, then find fontlist from page object
  1478.   // by internal name. if font is not registered, register it to page object.
  1479.   FFont := FPdfDoc.GetFont(AName);
  1480.   if (FAttr.Font = FFont) and (FAttr.FontSize = ASize) then Exit;
  1481.   FFontList := _Page_GetResources(FPage, 'Font');
  1482.   FFontName := FFont.Data.PdfNameByName('Name').Value;
  1483.   if FFontList.ValueByName(FFontName) = nil then
  1484.     FFontList.AddItem(FFontName, FFont.Data);
  1485.   if FContents <> nil then
  1486.     SetFontAndSize('/' + FFontName, ASize);
  1487.   FAttr.Font := FFont;
  1488.   FAttr.FontSize := ASize;
  1489. end;
  1490.  
  1491. // TextOut
  1492. procedure TPdfCanvas.TextOut(X, Y: Single; Text: string);
  1493. begin
  1494.   BeginText;
  1495.   MoveTextPoint(X, Y);
  1496.   ShowText(Text);
  1497.   EndText;
  1498. end;
  1499.  
  1500. // TextRect
  1501. procedure TPdfCanvas.TextRect(ARect: TPdfRect; Text: string;
  1502.                             Alignment: TPdfAlignment; Clipping: boolean);
  1503. var
  1504.   tmpWidth: Single;
  1505.   XPos: Single;
  1506. begin
  1507.   // calculate text width.
  1508.   tmpWidth := TextWidth(Text);
  1509.  
  1510.   case Alignment of
  1511.     paCenter: XPos := Round((ARect.Right - ARect.Left - tmpWidth) / 2);
  1512.     paRightJustify: XPos := ARect.Right - ARect.Left - Round(tmpWidth);
  1513.   else
  1514.     XPos := 0;
  1515.   end;
  1516.  
  1517.   // clipping client rect if needed.
  1518.   if Clipping then
  1519.   begin
  1520.     GSave;
  1521.     with ARect do
  1522.       begin
  1523.         MoveTo(Left, Top);
  1524.         LineTo(Left, Bottom);
  1525.         LineTo(Right, Bottom);
  1526.         LineTo(Right, Top);
  1527.       end;
  1528.     ClosePath;
  1529.     Clip;
  1530.     NewPath;
  1531.   end;
  1532.  
  1533.   BeginText;
  1534.   MoveTextPoint(ARect.Left + XPos, ARect.Top - FAttr.FontSize * 0.85);
  1535.   ShowText(Text);
  1536.   EndText;
  1537.  
  1538.   if Clipping then
  1539.     GRestore;
  1540. end;
  1541.  
  1542. // MultilineTextRect
  1543. procedure TPdfCanvas.MultilineTextRect(ARect: TPdfRect;
  1544.             Text: string; WordWrap: boolean);
  1545. var
  1546.   i: integer;
  1547.   S1, S2: string;
  1548.   XPos, YPos: Single;
  1549.   tmpXPos: Single;
  1550.   tmpWidth: Single;
  1551.   ln: integer;
  1552.   FourceReturn: boolean;
  1553.   FText: string;
  1554.  
  1555.   procedure InternalShowText(S: string; AWidth: Single);
  1556.   var
  1557.     i: Integer;
  1558.   begin
  1559.     i := MeasureText(S, AWidth);
  1560.     S := Copy(S, 1, i);
  1561.     ShowText(S);
  1562.   end;
  1563.  
  1564. begin
  1565.   YPos := ARect.Top - FAttr.FontSize*0.85;
  1566.   XPos := ARect.Left;
  1567.   FText := Text;
  1568.  
  1569.   BeginText;
  1570.  
  1571.   MoveTextPoint(XPos, YPos);
  1572.   i := 1;
  1573.   S2 := GetNextWord(FText, i);
  1574.   XPos := XPos +  TextWidth(S2);
  1575.   if (Length(S2) > 0) and (S2[Length(S2)] = ' ') then
  1576.     XPos := XPos + FAttr.WordSpace;
  1577.  
  1578.   while i <= Length(FText) do
  1579.   begin
  1580.     ln := Length(S2);
  1581.     if (ln >= 2) and (S2[ln] = #10) and (S2[ln-1] = #13) then
  1582.     begin
  1583.       S2 := Copy(S2, 1, ln - 2);
  1584.       FourceReturn := true;
  1585.     end
  1586.     else
  1587.       FourceReturn := false;
  1588.  
  1589.     S1 := GetNextWord(FText, i);
  1590.     tmpWidth := TextWidth(S1);
  1591.     TmpXPos := XPos + tmpWidth;
  1592.  
  1593.     if (WordWrap and (TmpXPos > ARect.Right)) or
  1594.       FourceReturn then
  1595.     begin
  1596.       if S2 <> '' then
  1597.         InternalShowText(S2, ARect.Right - ARect.Left);
  1598.       S2 := '';
  1599.       MoveToNextLine;
  1600.       ARect.Top := ARect.Top - FAttr.Leading;
  1601.       if ARect.Top < ARect.Bottom + FAttr.FontSize then
  1602.         Break;
  1603.       XPos := ARect.Left;
  1604.     end;
  1605.     XPos := XPos + tmpWidth;
  1606.     if (Length(S1) > 0) and (S1[Length(S1)] = ' ') then
  1607.       XPos := XPos + FAttr.WordSpace;
  1608.     S2 := S2 + S1;
  1609.   end;
  1610.  
  1611.   if S2 <> '' then
  1612.     InternalShowText(S2, ARect.Right - ARect.Left);
  1613.   EndText;
  1614. end;
  1615.  
  1616. // DrawXObject
  1617. procedure TPdfCanvas.DrawXObject(X, Y, AWidth, AHeight: Single;
  1618.     AXObjectName: string);
  1619. var
  1620.   XObject: TPdfXObject;
  1621.   FXObjectList: TPdfDictionary;
  1622. begin
  1623.   // drawing object must be registered. check object name.
  1624.   XObject := FPdfDoc.GetXObject(AXObjectName);
  1625.   if XObject = nil then
  1626.     raise EPdfInvalidValue.CreateFmt('DrawXObject --XObject not found: %s', [AXObjectName]);
  1627.  
  1628.   FXObjectList := _Page_GetResources(FPage, 'XObject');
  1629.   if FXObjectList.ValueByName(AXObjectName) = nil then
  1630.     FXObjectList.AddItem(AXObjectName, XObject);
  1631.  
  1632.   GSave;
  1633.   Concat(AWidth, 0, 0, AHeight, X, Y);
  1634.   ExecuteXObject(XObject.Attributes.PdfNameByName('Name').Value);
  1635.   GRestore;
  1636. end;
  1637.  
  1638. // DrawXObjectEx
  1639. procedure TPdfCanvas.DrawXObjectEx(X, Y, AWidth, AHeight: Single;
  1640.       ClipX, ClipY, ClipWidth, ClipHeight: Single; AXObjectName: string);
  1641. var
  1642.   XObject: TPdfXObject;
  1643.   FXObjectList: TPdfDictionary;
  1644. begin
  1645.   // drawing object must be registered. check object name.
  1646.   XObject := FPdfDoc.GetXObject(AXObjectName);
  1647.   if XObject = nil then
  1648.     raise EPdfInvalidValue.CreateFmt('DrawXObjectEx --XObject not found: %s', [AXObjectName]);
  1649.  
  1650.   FXObjectList := _Page_GetResources(FPage, 'XObject');
  1651.   if FXObjectList.ValueByName(AXObjectName) = nil then
  1652.     FXObjectList.AddItem(AXObjectName, XObject);
  1653.  
  1654.   GSave;
  1655.   Rectangle(ClipX, ClipY, ClipWidth, ClipHeight);
  1656.   Clip;
  1657.   NewPath;
  1658.   Concat(AWidth, 0, 0, AHeight, X, Y);
  1659.   ExecuteXObject(XObject.Attributes.PdfNameByName('Name').Value);
  1660.   GRestore;
  1661. end;
  1662.  
  1663.   {* Special Graphics State *}
  1664.  
  1665. // GSave
  1666. procedure TPdfCanvas.GSave;
  1667. begin
  1668.   WriteString('q'#10);
  1669. end;
  1670.  
  1671. // GRestore
  1672. procedure TPdfCanvas.GRestore;
  1673. begin
  1674.   WriteString('Q'#10);
  1675. end;
  1676.  
  1677. // Concat
  1678. procedure TPdfCanvas.Concat(a, b, c, d, e, f: Single);
  1679. var
  1680.   S: string;
  1681. begin
  1682.   S := _FloatToStrR(a) + ' ' +
  1683.        _FloatToStrR(b) + ' ' +
  1684.        _FloatToStrR(c) + ' ' +
  1685.        _FloatToStrR(d) + ' ' +
  1686.        _FloatToStrR(e) + ' ' +
  1687.        _FloatToStrR(f) + ' cm'#10;
  1688.   WriteString(S);
  1689. end;
  1690.  
  1691.   {* General Graphics State *}
  1692.  
  1693. // SetFlat
  1694. procedure TPdfCanvas.SetFlat(flatness: Byte);
  1695. var
  1696.   S: string;
  1697. begin
  1698.   S := IntToStr(flatness) + ' i'#10;
  1699.   WriteString(S);
  1700. end;
  1701.  
  1702. // SetLineCap
  1703. procedure TPdfCanvas.SetLineCap(linecap: TLineCapStyle);
  1704. var
  1705.   S: string;
  1706. begin
  1707.   S := IntToStr(ord(linecap)) + ' J'#10;
  1708.   WriteString(S);
  1709. end;
  1710.  
  1711. // SetDash
  1712. procedure TPdfCanvas.SetDash(aarray: array of Byte; phase: Byte);
  1713. var
  1714.   S: string;
  1715.   i: integer;
  1716. begin
  1717.   S := '[';
  1718.   if (High(aarray) >= 0) and (aarray[0] <> 0) then
  1719.     for i := 0 to High(aarray) do
  1720.       S := S + IntToStr(aarray[i]) + ' ';
  1721.   S := S + '] ' + IntToStr(phase) + ' d'#10;
  1722.   WriteString(S);
  1723. end;
  1724.  
  1725. // SetLineJoin
  1726. procedure TPdfCanvas.SetLineJoin(linejoin: TLineJoinStyle);
  1727. var
  1728.   S: string;
  1729. begin
  1730.   S := IntToStr(ord(linejoin)) + ' j'#10;
  1731.   WriteString(S);
  1732. end;
  1733.  
  1734. // SetLineWidth
  1735. procedure TPdfCanvas.SetLineWidth(linewidth: Single);
  1736. var
  1737.   S: string;
  1738. begin
  1739.   S := _FloatToStrR(linewidth) + ' w'#10;
  1740.   WriteString(S);
  1741. end;
  1742.  
  1743. // SetMiterLimit
  1744. procedure TPdfCanvas.SetMiterLimit(miterlimit: Byte);
  1745. var
  1746.   S: string;
  1747. begin
  1748.   S := IntToStr(miterlimit) + ' M'#10;
  1749.   WriteString(S);
  1750. end;
  1751.  
  1752.   {* Paths *}
  1753.  
  1754. // MoveTo
  1755. procedure TPdfCanvas.MoveTo(x, y: Single);
  1756. var
  1757.   S: string;
  1758. begin
  1759.   S := _FloatToStrR(x) + ' ' + _FloatToStrR(y) + ' m'#10;
  1760.   WriteString(S);
  1761. end;
  1762.  
  1763. // LineTo
  1764. procedure TPdfCanvas.LineTo(x, y: Single);
  1765. var
  1766.   S: string;
  1767. begin
  1768.   S := _FloatToStrR(x) + ' ' + _FloatToStrR(y) + ' l'#10;
  1769.   WriteString(S);
  1770. end;
  1771.  
  1772. // CurveToC
  1773. procedure TPdfCanvas.CurveToC(x1, y1, x2, y2, x3, y3: Single);
  1774. var
  1775.   S: string;
  1776. begin
  1777.   S := _FloatToStrR(x1) + ' ' +
  1778.        _FloatToStrR(y1) + ' ' +
  1779.        _FloatToStrR(x2) + ' ' +
  1780.        _FloatToStrR(y2) + ' ' +
  1781.        _FloatToStrR(x3) + ' ' +
  1782.        _FloatToStrR(y3) + ' c'#10;
  1783.   WriteString(S);
  1784. end;
  1785.  
  1786. // CurveToV
  1787. procedure TPdfCanvas.CurveToV(x2, y2, x3, y3: Single);
  1788. var
  1789.   S: string;
  1790. begin
  1791.   S := _FloatToStrR(x2) + ' ' +
  1792.        _FloatToStrR(y2) + ' ' +
  1793.        _FloatToStrR(x3) + ' ' +
  1794.        _FloatToStrR(y3) + ' v'#10;
  1795.   WriteString(S);
  1796. end;
  1797.  
  1798. // CurveToY
  1799. procedure TPdfCanvas.CurveToY(x1, y1, x3, y3: Single);
  1800. var
  1801.   S: string;
  1802. begin
  1803.   S := _FloatToStrR(x1) + ' ' +
  1804.        _FloatToStrR(y1) + ' ' +
  1805.        _FloatToStrR(x3) + ' ' +
  1806.        _FloatToStrR(y3) + ' y'#10;
  1807.   WriteString(S);
  1808. end;
  1809.  
  1810. // Rectangle
  1811. procedure TPdfCanvas.Rectangle(x, y, width, height: Single);
  1812. var
  1813.   S: string;
  1814. begin
  1815.   S := _FloatToStrR(x) + ' ' +
  1816.        _FloatToStrR(y) + ' ' +
  1817.        _FloatToStrR(width) + ' ' +
  1818.        _FloatToStrR(height) + ' re'#10;
  1819.   WriteString(S);
  1820. end;
  1821.  
  1822. // Closepath
  1823. procedure TPdfCanvas.Closepath;
  1824. begin
  1825.   WriteString('h'#10);
  1826. end;
  1827.  
  1828. // NewPath
  1829. procedure TPdfCanvas.NewPath;
  1830. begin
  1831.   WriteString('n'#10);
  1832. end;
  1833.  
  1834. // Stroke
  1835. procedure TPdfCanvas.Stroke;
  1836. begin
  1837.   WriteString('S'#10);
  1838. end;
  1839.  
  1840. // ClosePathStroke
  1841. procedure TPdfCanvas.ClosePathStroke;
  1842. begin
  1843.   WriteString('s'#10);
  1844. end;
  1845.  
  1846. // Fill
  1847. procedure TPdfCanvas.Fill;
  1848. begin
  1849.   WriteString('f'#10);
  1850. end;
  1851.  
  1852. // Eofill
  1853. procedure TPdfCanvas.Eofill;
  1854. begin
  1855.   WriteString('f*'#10);
  1856. end;
  1857.  
  1858. // FillStroke
  1859. procedure TPdfCanvas.FillStroke;
  1860. begin
  1861.   WriteString('B'#10);
  1862. end;
  1863.  
  1864. // ClosepathFillStroke
  1865. procedure TPdfCanvas.ClosepathFillStroke;
  1866. begin
  1867.   WriteString('b'#10);
  1868. end;
  1869.  
  1870. // EofillStroke
  1871. procedure TPdfCanvas.EofillStroke;
  1872. begin
  1873.   WriteString('B*'#10);
  1874. end;
  1875.  
  1876. // ClosepathEofillStroke
  1877. procedure TPdfCanvas.ClosepathEofillStroke;
  1878. begin
  1879.   WriteString('b*'#10);
  1880. end;
  1881.  
  1882. // Clip
  1883. procedure TPdfCanvas.Clip;
  1884. begin
  1885.   WriteString('W'#10);
  1886. end;
  1887.  
  1888. // Eoclip
  1889. procedure TPdfCanvas.Eoclip;
  1890. begin
  1891.   WriteString('W*'#10);
  1892. end;
  1893.  
  1894. {* Test state *}
  1895.  
  1896. // SetCharSpace
  1897. procedure TPdfCanvas.SetCharSpace(charSpace: Single);
  1898. begin
  1899.   if FAttr.CharSpace = charSpace then Exit;
  1900.   FAttr.SetCharSpace(charSpace);
  1901.   if Contents <> nil then
  1902.     WriteString(_FloatToStrR(charSpace) + ' Tc'#10);
  1903. end;
  1904.  
  1905. // SetWordSpace
  1906. procedure TPdfCanvas.SetWordSpace(wordSpace: Single);
  1907. begin
  1908.   if FAttr.WordSpace = wordSpace then Exit;
  1909.   FAttr.SetWordSpace(wordSpace);
  1910.   if Contents <> nil then
  1911.     WriteString(_FloatToStrR(wordSpace) + ' Tw'#10);
  1912. end;
  1913.  
  1914. // SetHorizontalScaling
  1915. procedure TPdfCanvas.SetHorizontalScaling(hScaling: Word);
  1916. begin
  1917.   if FAttr.HorizontalScaling = hScaling then Exit;
  1918.   FAttr.SetHorizontalScaling(hScaling);
  1919.   WriteString(IntToStr(hScaling) + ' Tz'#10);
  1920. end;
  1921.  
  1922. // SetLeading
  1923. procedure TPdfCanvas.SetLeading(leading: Single);
  1924. begin
  1925.   if FAttr.Leading = leading then Exit;
  1926.   FAttr.SetLeading(leading);
  1927.   WriteString(_FloatToStrR(leading) + ' TL'#10);
  1928. end;
  1929.  
  1930. // SetFontAndSize
  1931. procedure TPdfCanvas.SetFontAndSize(fontname: string; size: Single);
  1932. var
  1933.   S: string;
  1934. begin
  1935.   S := fontname + ' ' +
  1936.        _FloatToStrR(size) + ' Tf'#10;
  1937.   WriteString(S);
  1938. end;
  1939.  
  1940. // SetTextRenderingMode
  1941. procedure TPdfCanvas.SetTextRenderingMode(mode: TTextRenderingMode);
  1942. begin
  1943.   WriteString(IntToStr(ord(mode)) + ' Tr'#10);
  1944. end;
  1945.  
  1946. // SetTextRise
  1947. procedure TPdfCanvas.SetTextRise(rise: Word);
  1948. begin
  1949.   WriteString(IntToStr(rise) + ' Ts'#10);
  1950. end;
  1951.  
  1952. // BeginText
  1953. procedure TPdfCanvas.BeginText;
  1954. begin
  1955.   WriteString('BT'#10);
  1956. end;
  1957.  
  1958. // EndText
  1959. procedure TPdfCanvas.EndText;
  1960. begin
  1961.   WriteString('ET'#10);
  1962. end;
  1963.  
  1964. // MoveTextPoint
  1965. procedure TPdfCanvas.MoveTextPoint(tx, ty: Single);
  1966. var
  1967.   S: string;
  1968. begin
  1969.   S := _FloatToStrR(tx) + ' ' +
  1970.        _FloatToStrR(ty) + ' Td'#10;
  1971.   WriteString(S);
  1972. end;
  1973.  
  1974. // SetTextMatrix
  1975. procedure TPdfCanvas.SetTextMatrix(a, b, c, d, x, y: Word);
  1976. var
  1977.   S: string;
  1978. begin
  1979.   S := IntToStr(a) + ' ' +
  1980.        IntToStr(b) + ' ' +
  1981.        IntToStr(c) + ' ' +
  1982.        IntToStr(d) + ' ' +
  1983.        IntToStr(x) + ' ' +
  1984.        IntToStr(y) + ' Tm'#10;
  1985.   WriteString(S);
  1986. end;
  1987.  
  1988. // MoveToNextLine
  1989. procedure TPdfCanvas.MoveToNextLine;
  1990. begin
  1991.   WriteString('T*'#10);
  1992. end;
  1993.  
  1994. // ShowText
  1995. procedure TPdfCanvas.ShowText(s: string);
  1996. var
  1997.   FString: string;
  1998. begin
  1999.   if _HasMultiByteString(s) then
  2000.     FString := '<' + _StrToHex(s) + '>'
  2001.   else
  2002.     FString := '(' + _EscapeText(s) + ')';
  2003.   WriteString(FString + ' Tj'#10);
  2004. end;
  2005.  
  2006. // ShowTextNextLine
  2007. procedure TPdfCanvas.ShowTextNextLine(s: string);
  2008. var
  2009.   FString: string;
  2010. begin
  2011.   if _HasMultiByteString(s) then
  2012.     FString := '<' + _StrToHex(s) + '>'
  2013.   else
  2014.     FString := '(' + _EscapeText(s) + ')';
  2015.   WriteString(FString + ' '''#10);
  2016. end;
  2017.  
  2018. {* external objects *}
  2019.  
  2020. // ExecuteXObject
  2021. procedure TPdfCanvas.ExecuteXObject(xObject: string);
  2022. var
  2023.   S: string;
  2024. begin
  2025.   S := '/' + xObject + ' Do'#10;
  2026.   WriteString(S);
  2027. end;
  2028.  
  2029. {* Device-dependent color space operators *}
  2030.  
  2031. // SetRGBFillColor
  2032. procedure TPdfCanvas.SetRGBFillColor(Value: TPdfColor);
  2033. var
  2034.   S: string;
  2035. begin
  2036.   S := GetColorStr(Value) + ' rg'#10;
  2037.   WriteString(S);
  2038. end;
  2039.  
  2040. // SetRGBStrokeColor
  2041. procedure TPdfCanvas.SetRGBStrokeColor(Value: TPdfColor);
  2042. var
  2043.   S: string;
  2044. begin
  2045.   S := GetColorStr(Value) + ' RG'#10;
  2046.   WriteString(S);
  2047. end;
  2048.  
  2049. { TPdfCanvas common routine }
  2050.  
  2051. // TextWidth
  2052. function TPdfCanvas.TextWidth(Text: string): Single;
  2053. begin
  2054.   result := FAttr.TextWidth(Text);
  2055. end;
  2056.  
  2057. // MeasureText
  2058. function TPdfCanvas.MeasureText(Text: string; AWidth: Single): integer;
  2059. begin
  2060.   result := FAttr.MeasureText(Text, AWidth);
  2061. end;
  2062.  
  2063. // Ellipse
  2064. procedure TPdfCanvas.Ellipse(x, y, width, height: Single);
  2065. begin
  2066.     MoveTo(x, y+height/2);
  2067.     CurveToC(x,
  2068.              y+height/2-height/2*11/20,
  2069.              x+width/2-width/2*11/20,
  2070.              y,
  2071.              x+width/2,
  2072.              y);
  2073.     CurveToC(x+width/2+width/2*11/20,
  2074.              y,
  2075.              x+width,
  2076.              y+height/2-height/2*11/20,
  2077.              x+width,
  2078.              y+height/2);
  2079.     CurveToC(x+width,
  2080.              y+height/2+height/2*11/20,
  2081.              x+width/2+width/2*11/20,
  2082.              y+height,
  2083.              x+width/2,
  2084.              y+height);
  2085.     CurveToC(x+width/2-width/2*11/20,
  2086.              y+height,
  2087.              x,
  2088.              y+height/2+height/2*11/20,
  2089.              x,
  2090.              y+height/2);
  2091. end;
  2092.  
  2093. // GetNextWord
  2094. function TPdfCanvas.GetNextWord(const S: string;
  2095.   var Index: integer): string;
  2096. var
  2097.   ln: integer;
  2098.   i: integer;
  2099. begin
  2100.   // getting a word from text.
  2101.   result := '';
  2102.   ln := Length(S);
  2103.   if Index > ln then
  2104.     Exit;
  2105.   i := Index;
  2106.   while true do
  2107.     if (S[i] = #10) and (S[i-1] = #13) or (S[i] = ' ') then
  2108.     begin
  2109.       result := Copy(S, Index, i - (Index -1));
  2110.       break;
  2111.     end
  2112.     else
  2113.     if i >= ln then
  2114.     begin
  2115.       result := Copy(S, Index, i - (Index - 1));
  2116.       break;
  2117.     end
  2118.     {$IFDEF USE_JPFONTS}
  2119.     else
  2120.     if ByteType(S, i) = mbTrailByte then
  2121.       if ((Copy(S, i+1, 2) <> #129#66) and
  2122.         (Copy(S, i+1, 2) <> #129#65)) then
  2123.       begin
  2124.         result := Copy(S, Index, i - (Index - 1));
  2125.         break;
  2126.       end
  2127.       else
  2128.         inc(i)
  2129.     else
  2130.     if ((i < ln) and (ByteType(S, i + 1) = mbLeadByte)) then
  2131.     begin
  2132.       result := Copy(S, Index, i - (Index - 1));
  2133.       break;
  2134.     end
  2135.     {$ENDIF}
  2136.     else
  2137.       inc(i);
  2138.  
  2139.    Index := i + 1;
  2140. end;
  2141.  
  2142. // GetDoc
  2143. function TPdfCanvas.GetDoc: TPdfDoc;
  2144. begin
  2145.   result := nil;
  2146.   if FPdfDoc <> nil then
  2147.     result := FPdfDoc
  2148.   else
  2149.     EPdfInvalidOperation.Create('ERROR: GetDoc documant is nil.');
  2150. end;
  2151.  
  2152. { TPdfDictionaryWrapper }
  2153.  
  2154. // SetData
  2155. procedure TPdfDictionaryWrapper.SetData(AData: TPdfDictionary);
  2156. begin
  2157.   FData := AData;
  2158. end;
  2159.  
  2160. // GetHasData
  2161. function TPdfDictionaryWrapper.GetHasData: boolean;
  2162. begin
  2163.   result := (FData = nil);
  2164. end;
  2165.  
  2166. { TPdfInfo }
  2167.  
  2168. // SetAuthor
  2169. procedure TPdfInfo.SetAuthor(Value: string);
  2170. begin
  2171.   FData.AddItem('Author', TPdfText.CreateText(Value));
  2172. end;
  2173.  
  2174. // SetCreationDate
  2175. procedure TPdfInfo.SetCreationDate(Value: TDateTime);
  2176. begin
  2177.   FData.AddItem('CreationDate', TPdfText.CreateText(_DateTimeToPdfDate(Value)));
  2178. end;
  2179.  
  2180. // SetModDate
  2181. procedure TPdfInfo.SetModDate(Value: TDateTime);
  2182. begin
  2183.   FData.AddItem('ModDate', TPdfText.CreateText(_DateTimeToPdfDate(Value)));
  2184. end;
  2185.  
  2186. // SetCreator
  2187. procedure TPdfInfo.SetCreator(Value: string);
  2188. begin
  2189.   FData.AddItem('Creator', TPdfText.CreateText(Value));
  2190. end;
  2191.  
  2192. // SetTitle
  2193. procedure TPdfInfo.SetTitle(Value: string);
  2194. begin
  2195.   FData.AddItem('Title', TPdfText.CreateText(Value));
  2196. end;
  2197.  
  2198. // SetSubject
  2199. procedure TPdfInfo.SetSubject(Value: string);
  2200. begin
  2201.   FData.AddItem('Subject', TPdfText.CreateText(Value));
  2202. end;
  2203.  
  2204. // SetKeywords
  2205. procedure TPdfInfo.SetKeywords(Value: string);
  2206. begin
  2207.   FData.AddItem('Keywords', TPdfText.CreateText(Value));
  2208. end;
  2209.  
  2210. // GetAuthor
  2211. function TPdfInfo.GetAuthor: string;
  2212. begin
  2213.   if FData.ValueByName('Author') <> nil then
  2214.     result := FData.PdfTextByName('Author').Value
  2215.   else
  2216.     result := '';
  2217. end;
  2218.  
  2219. // GetCreationDate
  2220. function TPdfInfo.GetCreationDate: TDateTime;
  2221. begin
  2222.   if FData.ValueByName('CreationDate') <> nil then
  2223.   try
  2224.     result := _PdfDateToDateTime(FData.PdfTextByName('CreationDate').Value);
  2225.   except
  2226.     result := 0;
  2227.   end
  2228.   else
  2229.     result := 0;
  2230. end;
  2231.  
  2232. // GetModDate
  2233. function TPdfInfo.GetModDate: TDateTime;
  2234. begin
  2235.   if FData.ValueByName('ModDate') <> nil then
  2236.   try
  2237.     result := _PdfDateToDateTime(FData.PdfTextByName('ModDate').Value);
  2238.   except
  2239.     result := 0;
  2240.   end
  2241.   else
  2242.     result := 0;
  2243. end;
  2244.  
  2245. // GetCreator
  2246. function TPdfInfo.GetCreator: string;
  2247. begin
  2248.   if FData.ValueByName('Creator') <> nil then
  2249.     result := FData.PdfTextByName('Creator').Value
  2250.   else
  2251.     result := '';
  2252. end;
  2253.  
  2254. // GetTitle
  2255. function TPdfInfo.GetTitle: string;
  2256. begin
  2257.   if FData.ValueByName('Title') <> nil then
  2258.     result := FData.PdfTextByName('Title').Value
  2259.   else
  2260.     result := '';
  2261. end;
  2262.  
  2263. // GetSubject
  2264. function TPdfInfo.GetSubject: string;
  2265. begin
  2266.   if FData.ValueByName('Subject') <> nil then
  2267.     result := FData.PdfTextByName('Subject').Value
  2268.   else
  2269.     result := '';
  2270. end;
  2271.  
  2272. // GetKeywords
  2273. function TPdfInfo.GetKeywords: string;
  2274. begin
  2275.   if FData.ValueByName('Keywords') <> nil then
  2276.     result := FData.PdfTextByName('Keywords').Value
  2277.   else
  2278.     result := '';
  2279. end;
  2280.  
  2281. { TPdfCatalog }
  2282.  
  2283. // SaveOpenAction
  2284. procedure TPdfCatalog.SaveOpenAction;
  2285. begin
  2286.   if (FOpenAction = nil) then
  2287.     FData.RemoveItem('OpenAction')
  2288.   else
  2289.     FData.AddItem('OpenAction', FOpenAction.GetValue);
  2290. end;
  2291.  
  2292. // SetPageLayout
  2293. procedure TPdfCatalog.SetPageLayout(Value: TPdfPageLayout);
  2294. var
  2295.   FPageLayout: TPdfName;
  2296. begin
  2297.   FPageLayout := TPdfName(FData.ValueByName('PageLayout'));
  2298.   if (FPageLayout = nil) or (not (FPageLayout is TPdfName)) then
  2299.     FData.AddItem('PageLayout', TPdfName.CreateName(PDF_PAGE_LAYOUT_NAMES[Ord(Value)]))
  2300.   else
  2301.     FPageLayout.Value := PDF_PAGE_LAYOUT_NAMES[Ord(Value)];
  2302. end;
  2303.  
  2304. // GetPageLayout
  2305. function TPdfCatalog.GetPageLayout: TPdfPageLayout;
  2306. var
  2307.   FPageLayout: TPdfName;
  2308.   S: string;
  2309.   i: integer;
  2310. begin
  2311.   result := plSinglePage;
  2312.   FPageLayout := TPdfName(FData.ValueByName('PageLayout'));
  2313.   if (FPageLayout = nil) or (not (FPageLayout is TPdfName)) then
  2314.     Exit
  2315.   else
  2316.   begin
  2317.     S := FPageLayout.Value;
  2318.     for i := 0 to High(PDF_PAGE_LAYOUT_NAMES) do
  2319.       if PDF_PAGE_LAYOUT_NAMES[i] = S then
  2320.       begin
  2321.         result := TPdfPageLayout(i);
  2322.         Break;
  2323.       end;
  2324.   end;
  2325. end;
  2326.  
  2327. function TPdfCatalog.GetNonFullScreenPageMode: TPdfPageMode;
  2328. var
  2329.   FDictionary: TPdfDictionary;
  2330.   FPageMode: TPdfName;
  2331.   S: string;
  2332.   i: integer;
  2333. begin
  2334.   result := pmUseNone;
  2335.   FDictionary := TPdfDictionary(FData.ValueByName('NonFullScreenPageMode'));
  2336.  
  2337.   if FDictionary = nil then
  2338.     Exit;
  2339.  
  2340.   FPageMode := TPdfName(FDictionary.ValueByName('NonFullScreenPageMode'));
  2341.   if (FPageMode = nil) or (not (FPageMode is TPdfName)) then
  2342.     Exit;
  2343.  
  2344.   S := FPageMode.Value;
  2345.   for i := 0 to High(PDF_PAGE_MODE_NAMES) do
  2346.     if PDF_PAGE_MODE_NAMES[i] = S then
  2347.     begin
  2348.       result := TPdfPageMode(i);
  2349.       Break;
  2350.     end;
  2351. end;
  2352.  
  2353. function TPdfCatalog.GetViewerPreference: TPdfViewerPreferences;
  2354. var
  2355.   FDictionary: TPdfDictionary;
  2356.   FValue: TPdfBoolean;
  2357. begin
  2358.   result := [];
  2359.   FDictionary := TPdfDictionary(FData.ValueByName('ViewerPreference'));
  2360.  
  2361.   if FDictionary = nil then
  2362.     Exit;
  2363.  
  2364.   FValue := FData.PdfBooleanByName('HideToolbar');
  2365.   if (FValue <> nil) or FValue.Value then
  2366.     result := result + [vpHideToolbar];
  2367.  
  2368.   FValue := FData.PdfBooleanByName('HideMenubar');
  2369.   if (FValue <> nil) or FValue.Value then
  2370.     result := result + [vpHideMenubar];
  2371.  
  2372.   FValue := FData.PdfBooleanByName('HideWindowUI');
  2373.   if (FValue <> nil) or FValue.Value then
  2374.     result := result + [vpHideWindowUI];
  2375.  
  2376.   FValue := FData.PdfBooleanByName('FitWindow');
  2377.   if (FValue <> nil) or FValue.Value then
  2378.     result := result + [vpFitWindow];
  2379.  
  2380.   FValue := FData.PdfBooleanByName('CenterWindow');
  2381.   if (FValue <> nil) or FValue.Value then
  2382.     result := result + [vpCenterWindow];
  2383. end;
  2384.  
  2385. // SetPageMode
  2386. procedure TPdfCatalog.SetPageMode(Value: TPdfPageMode);
  2387. var
  2388.   FPageMode: TPdfName;
  2389. begin
  2390.   FPageMode := TPdfName(FData.ValueByName('PageMode'));
  2391.   if (FPageMode = nil) or (not (FPageMode is TPdfName)) then
  2392.     FData.AddItem('PageMode', TPdfName.CreateName(PDF_PAGE_MODE_NAMES[Ord(Value)]))
  2393.   else
  2394.     FPageMode.Value := PDF_PAGE_MODE_NAMES[Ord(Value)];
  2395. end;
  2396.  
  2397. procedure TPdfCatalog.SetNonFullScreenPageMode(Value: TPdfPageMode);
  2398. var
  2399.   FDictionary: TPdfDictionary;
  2400.   FPageMode: TPdfName;
  2401. begin
  2402.   FDictionary := TPdfDictionary(FData.ValueByName('ViewerPreferences'));
  2403.  
  2404.   if FDictionary = nil then
  2405.   begin
  2406.     FDictionary := TPdfDictionary.CreateDictionary(Data.ObjectMgr);
  2407.     Data.AddItem('ViewerPreferences', FDictionary);
  2408.   end;
  2409.  
  2410.   // if Value is pmFullScreen, remove 'PageMode' element(use default value).
  2411.   if (Value = pmFullScreen) or (Value = pmUseNone) then
  2412.     FDictionary.RemoveItem('NonFullScreenPageMode')
  2413.   else
  2414.   begin
  2415.     FPageMode := TPdfName(FDictionary.ValueByName('NonFullScreenPageMode'));
  2416.     if (FPageMode = nil) or (not (FPageMode is TPdfName)) then
  2417.       FDictionary.AddItem('NonFullScreenPageMode',
  2418.                         TPdfName.CreateName(PDF_PAGE_MODE_NAMES[Ord(Value)]))
  2419.     else
  2420.       FPageMode.Value := PDF_PAGE_MODE_NAMES[Ord(Value)];
  2421.   end;
  2422. end;
  2423.  
  2424. procedure TPdfCatalog.SetViewerPreference(Value: TPdfViewerPreferences);
  2425. var
  2426.   FDictionary: TPdfDictionary;
  2427. begin
  2428.   FDictionary := TPdfDictionary(FData.ValueByName('ViewerPreferences'));
  2429.  
  2430.   if (FDictionary = nil) and (Value <> []) then
  2431.   begin
  2432.     FDictionary := TPdfDictionary.CreateDictionary(Data.ObjectMgr);
  2433.     FData.AddItem('ViewerPreferences', FDictionary);
  2434.   end;
  2435.  
  2436.   if (vpHideToolbar in Value) then
  2437.     FDictionary.AddItem('HideToolbar', TPdfBoolean.CreateBoolean(true))
  2438.   else
  2439.     FDictionary.RemoveItem('HideToolbar');
  2440.  
  2441.   if (vpHideMenubar in Value) then
  2442.     FDictionary.AddItem('HideMenubar', TPdfBoolean.CreateBoolean(true))
  2443.   else
  2444.     FDictionary.RemoveItem('HideMenubar');
  2445.  
  2446.   if (vpHideWindowUI in Value) then
  2447.     FDictionary.AddItem('HideWindowUI', TPdfBoolean.CreateBoolean(true))
  2448.   else
  2449.     FDictionary.RemoveItem('HideWindowUI');
  2450.  
  2451.   if (vpFitWindow in Value) then
  2452.     FDictionary.AddItem('FitWindow', TPdfBoolean.CreateBoolean(true))
  2453.   else
  2454.     FDictionary.RemoveItem('FitWindow');
  2455.  
  2456.   if (vpCenterWindow in Value) then
  2457.     FDictionary.AddItem('CenterWindow', TPdfBoolean.CreateBoolean(true))
  2458.   else
  2459.     FDictionary.RemoveItem('CenterWindow');
  2460. end;
  2461.  
  2462. // GetPageMode
  2463. function TPdfCatalog.GetPageMode: TPdfPageMode;
  2464. var
  2465.   FPageMode: TPdfName;
  2466.   S: string;
  2467.   i: integer;
  2468. begin
  2469.   result := pmUseNone;
  2470.   FPageMode := TPdfName(FData.ValueByName('PageMode'));
  2471.   if (FPageMode = nil) or (not (FPageMode is TPdfName)) then
  2472.     Exit
  2473.   else
  2474.   begin
  2475.     S := FPageMode.Value;
  2476.     for i := 0 to High(PDF_PAGE_MODE_NAMES) do
  2477.       if PDF_PAGE_MODE_NAMES[i] = S then
  2478.       begin
  2479.         result := TPdfPageMode(i);
  2480.         Break;
  2481.       end;
  2482.   end;
  2483. end;
  2484.  
  2485. // GetPages
  2486. function TPdfCatalog.GetPages: TPdfDictionary;
  2487. begin
  2488.   result := TPdfDictionary(FData.ValueByName('Pages'));
  2489.   if result = nil then
  2490.     raise EPdfInvalidOperation.Create('GetPages --page object is null..');
  2491. end;
  2492.  
  2493. // SetPages
  2494. procedure TPdfCatalog.SetPages(APage: TPdfDictionary);
  2495. begin
  2496.   if _GetTypeOf(APage) = 'Pages' then
  2497.     FData.AddItem('Pages', APage);
  2498. end;
  2499.  
  2500. { TPdfFont }
  2501.  
  2502. // AddStrElements
  2503. procedure TPdfFont.AddStrElements(ADic: TPdfDictionary;
  2504.   ATable: array of TPDF_STR_TBL);
  2505. var
  2506.   i: integer;
  2507. begin
  2508.   { utility routine for making font dictinary. }
  2509.   for i := 0 to High(ATable) do
  2510.     ADic.AddItem(ATable[i].KEY, TPdfName.CreateName(ATable[i].VAL));
  2511. end;
  2512.  
  2513. // AddIntElements
  2514. procedure TPdfFont.AddIntElements(ADic: TPdfDictionary;
  2515.   ATable: array of TPDF_INT_TBL);
  2516. var
  2517.   i: integer;
  2518. begin
  2519.   { utility routine for making font dictionary. }
  2520.   for i := 0 to High(ATable) do
  2521.     ADic.AddItem(ATable[i].KEY, TPdfNumber.CreateNumber(ATable[i].VAL));
  2522. end;
  2523.  
  2524. // GetCharWidth
  2525. function TPdfFont.GetCharWidth(AText: string; APos: integer): integer;
  2526. begin
  2527.   result := 0;
  2528. end;
  2529.  
  2530. // Create
  2531. constructor TPdfFont.Create(AXref: TPdfXref; AName: string);
  2532. begin
  2533.   inherited Create;
  2534.   FName := AName;
  2535. end;
  2536.  
  2537. { PdfDestination }
  2538.  
  2539. // Create
  2540. constructor TPdfDestination.Create(APdfDoc: TPdfDoc);
  2541. var
  2542.   i: integer;
  2543. begin
  2544.   inherited Create;
  2545.   FDoc := APdfDoc;
  2546.   if (FDoc = nil) or (not FDoc.HasDoc) then
  2547.     raise EPdfInvalidOperation.Create('TPdfDestination --cannot destination object.');
  2548.   FPage := FDoc.Canvas.Page;
  2549.   for i := 0 to 4 do
  2550.     FValues[i] := 0;
  2551.   FZoom := 1;
  2552. end;
  2553.  
  2554. // Destroy
  2555. destructor TPdfDestination.Destroy;
  2556. begin
  2557.   if FReference <> nil then
  2558.     FReference.Free;
  2559.   inherited;
  2560. end;
  2561.  
  2562. // GetElement
  2563. function TPdfDestination.GetElement(Index: integer): Integer;
  2564. begin
  2565.   result := FValues[Index];
  2566. end;
  2567.  
  2568. // SetElement
  2569. procedure TPdfDestination.SetElement(Index: integer; Value: Integer);
  2570. begin
  2571.   if FValues[Index] <> Value then
  2572.     if Value < 0 then
  2573.       FValues[Index] := -1
  2574.     else
  2575.       FValues[Index] := Value;
  2576. end;
  2577.  
  2578. // SetZoom
  2579. procedure TPdfDestination.SetZoom(Value: Single);
  2580. begin
  2581.   if Value <> FZoom then
  2582.     if Value < 0 then
  2583.       raise EPdfInvalidValue.Create('Zoom property cannot set to under 0.')
  2584.     else
  2585.     if Value > PDF_MAX_ZOOMSIZE then
  2586.       raise EPdfInvalidValue.CreateFmt('Zoom property cannot set to over %d.', [PDF_MAX_ZOOMSIZE])
  2587.     else
  2588.       FZoom := Value;
  2589. end;
  2590.  
  2591. // GetPageWidth
  2592. function TPdfDestination.GetPageWidth: Integer;
  2593. var
  2594.   FMediaBox: TPdfArray;
  2595. begin
  2596.   FMediaBox := FPage.PdfArrayByName('MediaBox');
  2597.   if FMediaBox <> nil then
  2598.     result := TPdfNumber(FMediaBox.Items[2]).Value
  2599.   else
  2600.     result := FDoc.DefaultPageWidth;
  2601. end;
  2602.  
  2603. // GetPageHeight
  2604. function TPdfDestination.GetPageHeight: Integer;
  2605. var
  2606.   FMediaBox: TPdfArray;
  2607. begin
  2608.   FMediaBox := FPage.PdfArrayByName('MediaBox');
  2609.   if FMediaBox <> nil then
  2610.     result := TPdfNumber(FMediaBox.Items[3]).Value
  2611.   else
  2612.     result := FDoc.DefaultPageHeight;
  2613. end;
  2614.  
  2615. // GetValue
  2616. function TPdfDestination.GetValue: TPdfArray;
  2617. const
  2618.   DEST_MAX_VALUE = 100;
  2619. begin
  2620.   // create TPdfArray object from the specified values.
  2621.   // the values which are not used are ignored.
  2622.   result := TPdfArray.CreateArray(FDoc.FXref);
  2623.   with result do
  2624.   begin
  2625.     AddItem(FPage);
  2626.     AddItem(TPdfName.CreateName(PDF_DESTINATION_TYPE_NAMES[ord(FType)]));
  2627.     case FType of
  2628.       // if the type is dtXYZ, only Left, Top and Zoom values are used,
  2629.       // other properties are ignored.
  2630.       dtXYZ:
  2631.         begin
  2632.           if FValues[0] >= -DEST_MAX_VALUE then
  2633.             AddItem(TPdfNumber.CreateNumber(Left))
  2634.           else
  2635.             AddItem(TPdfNull.Create);
  2636.           if FValues[1] >= -DEST_MAX_VALUE then
  2637.             AddItem(TPdfNumber.CreateNumber(Top))
  2638.           else
  2639.             AddItem(TPdfNull.Create);
  2640.           if FZoom < 0 then
  2641.             FZoom := 0;
  2642.           AddItem(TPdfReal.CreateReal(FZoom));
  2643.         end;
  2644.       // if the type is dtFitR, all values except Zoom are used.
  2645.       dtFitR:
  2646.         begin
  2647.           if FValues[0] >= -DEST_MAX_VALUE then
  2648.             AddItem(TPdfNumber.CreateNumber(Left))
  2649.           else
  2650.             AddItem(TPdfNull.Create);
  2651.           if FValues[1] >= -DEST_MAX_VALUE then
  2652.             AddItem(TPdfNumber.CreateNumber(Bottom))
  2653.           else
  2654.             AddItem(TPdfNull.Create);
  2655.           if FValues[2] >= 0 then
  2656.             AddItem(TPdfNumber.CreateNumber(Right))
  2657.           else
  2658.             AddItem(TPdfNull.Create);
  2659.           if FValues[3] >= 0 then
  2660.             AddItem(TPdfNumber.CreateNumber(Top))
  2661.           else
  2662.             AddItem(TPdfNull.Create);
  2663.         end;
  2664.       // if the type is dtFitH or dtFitBH, only Top property is used.
  2665.       dtFitH, dtFitBH:
  2666.           if FValues[1] >= -DEST_MAX_VALUE then
  2667.             AddItem(TPdfNumber.CreateNumber(Top))
  2668.           else
  2669.             AddItem(TPdfNull.Create);
  2670.       // if the type is dtFitV or dtFitBV, only Top property is used.
  2671.       dtFitV, dtFitBV:
  2672.           if FValues[0] >= -DEST_MAX_VALUE then
  2673.             AddItem(TPdfNumber.CreateNumber(Left))
  2674.           else
  2675.             AddItem(TPdfNull.Create);
  2676.     end;
  2677.   end;
  2678. end;
  2679.  
  2680. { TPdfOutlineEntry }
  2681.  
  2682. // CreateEntry
  2683. constructor TPdfOutlineEntry.CreateEntry(AParent: TPdfOutlineEntry);
  2684. begin
  2685.   inherited Create;
  2686.  
  2687.   if AParent = nil then
  2688.     Raise Exception.Create('CreateEntry --invalid parent.');
  2689.  
  2690.   FParent := AParent;
  2691.   FCount := 0;
  2692.   FDoc := AParent.Doc;
  2693.   Data := TPdfDictionary.CreateDictionary(FDoc.FXref);
  2694.   FDoc.FXref.AddObject(Data);
  2695.   FDoc.FObjectList.Add(Self);
  2696. end;
  2697.  
  2698. // Destroy
  2699. destructor TPdfOutlineEntry.Destroy;
  2700. begin
  2701.   if FReference <> nil then
  2702.     FReference.Free;
  2703.   inherited;
  2704. end;
  2705.  
  2706. // AddChild
  2707. function TPdfOutlineEntry.AddChild: TPdfOutlineEntry;
  2708. var
  2709.   TmpEntry: TPdfOutlineEntry;
  2710. begin
  2711.   // increment Count variable recursive.
  2712.   inc(FCount);
  2713.   TmpEntry := Parent;
  2714.   while TmpEntry <> nil do
  2715.   begin
  2716.     TmpEntry.FCount := TmpEntry.FCount + 1;
  2717.     TmpEntry := TmpEntry.Parent;
  2718.   end;
  2719.  
  2720.   result := TPdfOutlineEntry.CreateEntry(Self);
  2721.   if FFirst = nil then
  2722.     FFirst := Result;
  2723.   if FLast <> nil then
  2724.     FLast.FNext := Result;
  2725.   Result.FPrev := FLast;
  2726.   FLast := Result;
  2727. end;
  2728.  
  2729. // Save
  2730. procedure TPdfOutlineEntry.Save;
  2731. begin
  2732.   if Opened then
  2733.     Data.AddItem('Count', TPdfNumber.CreateNumber(FCount))
  2734.   else
  2735.     Data.AddItem('Count', TPdfNumber.CreateNumber(-FCount));
  2736.  
  2737.   Data.AddItem('Title', TPdfText.CreateText(FTitle));
  2738.  
  2739.   if FDest <> nil then
  2740.     Data.AddItem('Dest', FDest.GetValue);
  2741.  
  2742.   if FFirst <> nil then
  2743.   begin
  2744.     Data.AddItem('First', FFirst.Data);
  2745.     FFirst.Save;
  2746.   end;
  2747.   if FLast <> nil then
  2748.     Data.AddItem('Last', FLast.Data);
  2749.   if FPrev <> nil then
  2750.     Data.AddItem('Prev', FPrev.Data);
  2751.   if FNext <> nil then
  2752.   begin
  2753.     Data.AddItem('Next', FNext.Data);
  2754.     FNext.Save;
  2755.   end;
  2756. end;
  2757.  
  2758. { TPdfOutlineRoot }
  2759.  
  2760. // CreateRoot
  2761. constructor TPdfOutlineRoot.CreateRoot(ADoc: TPdfDoc);
  2762. begin
  2763.   inherited Create;
  2764.   FCount := 0;
  2765.   FDoc := ADoc;
  2766.   FOpened := true;
  2767.   Data := TPdfDictionary.CreateDictionary(ADoc.FXref);
  2768.   FDoc.FXref.AddObject(Data);
  2769.   with Data do
  2770.     AddItem('Type', TPdfName.CreateName('Outlines'));
  2771.   FDoc.FObjectList.Add(Self);
  2772. end;
  2773.  
  2774. // Save
  2775. procedure TPdfOutlineRoot.Save;
  2776. begin
  2777.   if Opened then
  2778.     Data.AddItem('Count', TPdfNumber.CreateNumber(FCount))
  2779.   else
  2780.     Data.AddItem('Count', TPdfNumber.CreateNumber(-FCount));
  2781.   if FFirst <> nil then
  2782.   begin
  2783.     Data.AddItem('First', FFirst.Data);
  2784.     FFirst.Save;
  2785.   end;
  2786.   if FLast <> nil then
  2787.     Data.AddItem('Last', FLast.Data);
  2788. end;
  2789.  
  2790. end.
  2791.