SynPdf.pas

/// PDF file generation
// - this unit is a part of the freeware Synopse framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynPdf;

{
    This file is part of Synopse framework.

    Synopse framework. Copyright (C) 2023 Arnaud Bouchez
      Synopse Informatique - https://synopse.info

  *** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the License.

  The Original Code is Synopse framework.

  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2023
  the Initial Developer. All Rights Reserved.

  Contributor(s):
   Achim Kalwa
   Alexander (chaa)
   aweste
   CoMPi
   Damien (ddemars)
   David Mead (MDW)
   David Heffernan
   FalconB
   Florian Grummel
   Harald Simon
   Josh Kelley (joshkel)
   Karel (vandrovnik)
   Kukhtin Igor
   LoukaO
   Marsh
   MChaos
   Mehrdad Momeni (nosa)
   mogulza
   Nzsolt
   Ondrej (reddwarf)
   Pierre le Riche
   Sinisa (sinisav)
   Sundazer

  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****

  Sponsors: https://synopse.info/fossil/wiki?name=HelpDonate
  Ongoing development and maintenance of the SynPDF library was sponsored
  in part by:
   https://www.helpndoc.com
    Easy to use yet powerful help authoring environment which can generate
    various documentation formats from a single source.
  Thanks for your contribution!

}


{$I Synopse.inc} // define HASINLINE CPU32 CPU64

{$ifndef MSWINDOWS}
  { disable features requiring OS specific APIs
    - until they are implemented }
  {$define NO_USE_SYNGDIPLUS}
  {$define NO_USE_UNISCRIBE}
  {$define NO_USE_METAFILE}
  {$define NO_USE_BITMAP}
{$endif}

{.$define USE_PDFALEVEL}
{ - if defined, the TPdfDocument*.Create() constructor will have an PDF/A level 
  value instead of the boolean value PDFA1}
{$ifdef NO_USE_PDFALEVEL}
  { this special conditional can be set globaly for an application which doesn't
    need the PDF/A level features }
  {$undef USE_PDFALEVEL}
{$endif}

{$define USE_PDFSECURITY}
{ - if defined, the TPdfDocument*.Create() constructor will have an additional
  AEncryption: TPdfEncryption parameter able to create secured PDF files
  - this feature will link the SynCrypto unit for MD5 and RC4 algorithms }
{$ifdef NO_USE_PDFSECURITY}
  { this special conditional can be set globaly for an application which doesn't
    need the security features, therefore dependency to SynCrypto unit }
  {$undef USE_PDFSECURITY}
{$endif}

{$define USE_UNISCRIBE}
{ - if defined, the PDF engine will use the Windows Uniscribe API to
  render Ordering and Shaping of the text (useful for Hebrew, Arabic and
  some Asiatic languages)
  - this feature need the TPdfDocument.UseUniscribe property to be forced to
  true according to the language of the text you want to render
  - can be undefined to safe some KB if you're sure you won't need it }
{$ifdef NO_USE_UNISCRIBE}
  { this special conditional can be set globaly for an application which doesn't
    need the UniScribe features }
  {$undef USE_UNISCRIBE}
{$endif}

{$define USE_SYNGDIPLUS}
{ - if defined, the PDF engine will use SynGdiPlus to handle all
    JPG, TIF, PNG and GIF image types (prefered way, but need XP or later OS)
  - if you'd rather use the default jpeg unit (and add some more code to your
    executable), undefine this conditional }
{$ifdef NO_USE_SYNGDIPLUS}
  { this special conditional can be set globaly for an application which doesn't
    need the SynGdiPlus features (like TMetaFile drawing), and would rather
    use the default jpeg unit }
  {$undef USE_SYNGDIPLUS}
{$endif}

{$define USE_SYNZIP}
{ - if defined, the PDF engine will use SynZip to handle the ZIP/deflate
    compression schema (this unit is faster than the default ZLib unit,
    and used by other units of the framework)
  - if you'd rather use the default ZLib unit (and add some more code to your
    executable), undefine this conditional }
{$ifdef NO_USE_SYNZIP}
  { this special conditional can be set globaly for an application for which
    standard ZLib unit is enough (not to be used with a mORMot application) }
  {$undef USE_SYNZIP}
{$endif}

{$define USE_BITMAP}
{ - if defined, the PDF engine will support TBitmap
  - it would induce a dependency to the VCL.Graphics unit }
{$ifdef NO_USE_BITMAP}
  { this special conditional can be set globaly for an application which doesn't
    need the TBitmap features }
  {$undef USE_BITMAP}
{$endif}

{$define USE_METAFILE}
{ - if defined, the PDF engine will support TMetaFile/TMetaFileCanvas
  - it would induce a dependency to the VCL.Graphics unit }
{$ifdef NO_USE_METAFILE}
  { this special conditional can be set globaly for an application which doesn't
    need the TMetaFile features }
  {$undef USE_METAFILE}
{$endif}

{$define USE_ARC}
{ - if defined, the PDF engine will support ARC, inducing a dependency to Math.pas }
{$ifdef NO_USE_ARC}
  {$undef USE_ARC}
{$endif}

{$ifdef USE_BITMAP}
  {$define USE_GRAPHICS_UNIT}
{$endif}
{$ifdef USE_METAFILE}
  {$define USE_GRAPHICS_UNIT}
{$endif}

interface

uses
  {$ifdef MSWINDOWS}
  Windows,
  WinSpool,
  {$ifdef USE_GRAPHICS_UNIT}
  {$ifdef ISDELPHIXE2}
  VCL.Graphics,
  {$else}
  Graphics,
  {$endif}
  {$endif}
  {$endif MSWINDOWS}
  {$ifdef USE_SYNGDIPLUS}
  SynGdiPlus, // use our GDI+ library for handling TJpegImage and such
  {$else}
  jpeg,
  {$endif}
  SysConst,
  SysUtils,
  Classes,
  {$ifdef USE_ARC}
  Math,
  {$endif}
  {$ifdef ISDELPHIXE3}
  System.Types,
  System.AnsiStrings,
  {$else}
  {$ifdef HASINLINE}
  Types,
  {$endif}
  {$endif}
  {$ifdef USE_SYNZIP}
  SynZip,
  {$else}
  ZLib,
  {$endif}
  {$ifdef USE_PDFSECURITY}
  SynCrypto,
  {$endif}
  SynCommons,
  SynLZ;

const
  MWT_IDENTITY = 1;
  MWT_LEFTMULTIPLY = 2;
  MWT_RIGHTMULTIPLY = 3;
  MWT_SET = 4;
  {$NODEFINE MWT_IDENTITY}
  {$NODEFINE MWT_LEFTMULTIPLY}
  {$NODEFINE MWT_RIGHTMULTIPLY}

{  some low-level record definition for True Type format table reading }

type
  PSmallIntArray = ^TSmallIntArray;
  TSmallIntArray = array[byte] of SmallInt;

  PPointArray = ^TPointArray;
  TPointArray = array[word] of TPoint;
  PSmallPointArray = ^TSmallPointArray;
  TSmallPointArray = array[word] of TSmallPoint;

  /// The 'cmap' table begins with an index containing the table version number
  // followed by the number of encoding tables. The encoding subtables follow.
  TCmapHeader = packed record
    /// Version number (Set to zero)
    version: word;
    /// Number of encoding subtables
    numberSubtables: word;
  end;
  /// points to every 'cmap' encoding subtables
  TCmapSubTableArray = packed array[byte] of packed record
    /// Platform identifier
    platformID: word;
    /// Platform-specific encoding identifier
    platformSpecificID: word;
    /// Offset of the mapping table
    offset: Cardinal;
  end;
  /// 'hhea' table contains information needed to layout fonts whose
  // characters are written horizontally, that is, either left to right or
  // right to left
  TCmapHHEA = packed record
    version: longint;
    ascent: word;
    descent: word;
    lineGap: word;
    advanceWidthMax: word;
    minLeftSideBearing: word;
    minRightSideBearing: word;
    xMaxExtent: word;
    caretSlopeRise: SmallInt;
    caretSlopeRun: SmallInt;
    caretOffset: SmallInt;
    reserved: Int64;
    metricDataFormat: SmallInt;
    numOfLongHorMetrics: word;
  end;
  /// 'head' table contains global information about the font
  TCmapHEAD = packed record
    version: longint;
    fontRevision: longint;
    checkSumAdjustment: cardinal;
    magicNumber: cardinal;
    flags: word;
    unitsPerEm: word;
    createdDate: Int64;
    modifiedDate: Int64;
    xMin: SmallInt;
    yMin: SmallInt;
    xMax: SmallInt;
    yMax: SmallInt;
    macStyle: word;
    lowestRec: word;
    fontDirection: SmallInt;
    indexToLocFormat: SmallInt;
    glyphDataFormat: SmallInt
  end;
  /// header for the 'cmap' Format 4 table
  // - this is a two-byte encoding format
  TCmapFmt4 = packed record
    format: word;
    length: word;
    language: word;
    segCountX2: word;
    searchRange: word;
    entrySelector: word;
    rangeShift: word;
  end;

type
  /// the PDF library use internaly AnsiString text encoding
  // - the corresponding charset is the current system charset, or the one
  // supplied as a parameter to TPdfDocument.Create
  PDFString = AnsiString;

  /// a PDF date, encoded as 'D:20100414113241'
  TPdfDate = PDFString;

  /// the internal pdf file format
  TPdfFileFormat = (pdf13, pdf14, pdf15, pdf16);

  /// the PDF/A level
  TPdfALevel = (pdfaNone, pdfa1A, pdfa1B, pdfa2A, pdfa2B, pdfa3A, pdfa3B);

  /// PDF exception, raised when an invalid value is given to a constructor
  EPdfInvalidValue = class(Exception);

  /// PDF exception, raised when an invalid operation is triggered
  EPdfInvalidOperation = class(Exception);

  /// Page mode determines how the document should appear when opened
  TPdfPageMode = (
    pmUseNone, pmUseOutlines, pmUseThumbs, pmFullScreen);

  /// Line cap style specifies the shape to be used at the ends of open
  // subpaths when they are stroked
  TLineCapStyle = (
    lcButt_End, lcRound_End, lcProjectingSquareEnd);

  /// The line join style specifies the shape to be used at the corners of paths
  // that are stroked
  TLineJoinStyle = (
    ljMiterJoin, ljRoundJoin, ljBevelJoin);

  /// The text rendering mode determines whether text is stroked, filled, or used
  // as a clipping path
  TTextRenderingMode = (
    trFill, trStroke, trFillThenStroke, trInvisible,
    trFillClipping, trStrokeClipping, trFillStrokeClipping, trClipping);

  /// The annotation types determines the valid annotation subtype of TPdfDoc
  TPdfAnnotationSubType = (
    asTextNotes, asLink);

  /// The border style of an annotation
  TPdfAnnotationBorder = (
    abSolid, abDashed, abBeveled, abInset, abUnderline);

  /// Destination Type determines default user space coordinate system of
  // Explicit destinations
  TPdfDestinationType = (
    dtXYZ, dtFit, dtFitH, dtFitV, dtFitR, dtFitB, dtFitBH, dtFitBV);

  /// The page layout to be used when the document is opened
  TPdfPageLayout = (
    plSinglePage, plOneColumn, plTwoColumnLeft, plTwoColumnRight);

  /// Viewer preferences specifying how the reader User Interface must start
  // - vpEnforcePrintScaling will set the file version to be PDF 1.6
  TPdfViewerPreference = (
    vpHideToolbar, vpHideMenubar, vpHideWindowUI, vpFitWindow, vpCenterWindow,
    vpEnforcePrintScaling);

  /// set of Viewer preferences
  TPdfViewerPreferences = set of TPdfViewerPreference;

  /// available known paper size (psA4 is the default on TPdfDocument creation)
  TPDFPaperSize = (
    psA4, psA5, psA3, psA2, psA1, psA0, psLetter, psLegal, psUserDefined);

  /// define if streams must be compressed
  TPdfCompressionMethod = (
    cmNone, cmFlateDecode);

  /// the available PDF color range
  TPdfColor = -$7FFFFFFF-1..$7FFFFFFF;

  /// the PDF color, as expressed in RGB terms
  // - maps COLORREF / TColorRef as used e.g. under windows
  TPdfColorRGB = cardinal;

  /// the recognized families of the Standard 14 Fonts
  TPdfFontStandard = (pfsTimes, pfsHelvetica, pfsCourier);

  /// numerical ID for every XObject
  TXObjectID = integer;


const
  /// used for an used xref entry
  PDF_IN_USE_ENTRY = 'n';
  /// used for an unused (free) xref entry, e.g. the root entry
  PDF_FREE_ENTRY = 'f';
  /// used e.g. for the root xref entry
  PDF_MAX_GENERATION_NUM = 65535;

  PDF_ENTRY_CLOSED = 0;
  PDF_ENTRY_OPENED = 1;

  /// the Carriage Return and Line Feed values used in the PDF file generation
  // - expect #13 and #10 under Windows, but #10 (e.g. only Line Feed) is enough
  // for the PDF standard, and will create somewhat smaller PDF files
  CRLF = #10;
  /// the Line Feed value
  LF = #10;

  PDF_MIN_HORIZONTALSCALING = 10;
  PDF_MAX_HORIZONTALSCALING = 300;
  PDF_MAX_WORDSPACE = 300;
  PDF_MIN_CHARSPACE = -30;
  PDF_MAX_CHARSPACE = 300;
  PDF_MAX_FONTSIZE = 2000;
  PDF_MAX_ZOOMSIZE = 10;
  PDF_MAX_LEADING = 300;

  /// list of common fonts available by default since Windows 2000
  // - to not embedd these fonts in the PDF document, and save some KB,
  // just use the EmbeddedTTFIgnore property of TPdfDocument/TPdfDocumentGDI:
  // !   PdfDocument.EmbeddedTTFIgnore.Text := MSWINDOWS_DEFAULT_FONTS;
  // - note that this is useful only if the EmbeddedTTF property was set to TRUE
  MSWINDOWS_DEFAULT_FONTS: RawUTF8 =
    'Arial'#13#10'Courier New'#13#10'Georgia'#13#10+
    'Impact'#13#10'Lucida Console'#13#10'Roman'#13#10'Symbol'#13#10+
    'Tahoma'#13#10'Times New Roman'#13#10'Trebuchet'#13#10+
    'Verdana'#13#10'WingDings';

type
  /// PDF text paragraph alignment
  TPdfAlignment = (paLeftJustify, paRightJustify, paCenter);

  /// PDF gradient direction
  TGradientDirection = (gdHorizontal, gdVertical);

    /// a PDF coordinates rectangle
  TPdfRect = record
    Left, Top, Right, Bottom: Single;
  end;
  PPdfRect = ^TPdfRect;

  /// a PDF coordinates box
  TPdfBox = record
    Left, Top, Width, Height: Single;
  end;
  PPdfBox = ^TPdfBox;

  /// allowed types for PDF objects (i.e. TPdfObject)
  TPdfObjectType = (otDirectObject, otIndirectObject, otVirtualObject);

  TPdfObject = class;
  TPdfCanvas = class;
  TPdfFont = class;
  TPdfFontTrueType = class;
  TPdfDocument = class;

{$ifdef USE_PDFSECURITY}
  /// the available encryption levels
  // - in current version only RC4 40-bit and RC4 128-bit are available, which
  // correspond respectively to PDF 1.3 and PDF 1.4 formats
  // - for RC4 40-bit and RC4 128-bit, associated password are restricted to a
  // maximum length of 32 characters and could contain only characters from the
  // Latin-1 encoding (i.e. no accent)
  TPdfEncryptionLevel = (elNone, elRC4_40, elRC4_128);

  /// PDF can encode various restrictions on document operations which can be
  // granted or denied individually (some settings depend on others, though):
  // - Printing: If printing is not allowed, the print button in Acrobat will be
  // disabled. Acrobat supports a distinction between high-resolution and
  // low-resolution printing. Low-resolution printing generates a bitmapped
  // image of the page which is suitable only for personal use, but prevents
  // high-quality reproduction and re-distilling. Note that bitmap printing
  // not only results in low output quality, but will also considerably slow
  // down the printing process.
  // - General Editing: If this is disabled, any document modification is
  // prohibited. Content extraction and printing are allowed.
  // - Content Copying and Extraction: If this is disabled, selecting document
  // contents and copying it to the clipboard for repurposing the contents is
  // prohibited. The accessibility interface also is disabled. If you need to
  // search such documents with Acrobat you must select the Certified Plugins
  // Only preference in Acrobat.
  // - Authoring Comments and Form Fields: If this is disabled, adding,
  // modifying, or deleting comments and form fields is prohibited. Form field
  // filling is allowed.
  // - Form Field Fill-in or Signing: If this is enabled, users can sign and
  // fill in forms, but not create form fields.
  // - Document Assembly: If this is disabled, inserting, deleting or rotating
  // pages, or creating bookmarks and thumbnails is prohibited.
  TPdfEncryptionPermission = (epPrinting, epGeneralEditing, epContentCopy,
    epAuthoringComment, epFillingForms, epContentExtraction,
    epDocumentAssembly, epPrintingHighResolution);

  /// set of restrictions on PDF document operations
  TPdfEncryptionPermissions = set of TPdfEncryptionPermission;

  /// abstract class to handle PDF security
  TPdfEncryption = class
  protected
    fLevel: TPdfEncryptionLevel;
    fFlags: integer;
    fInternalKey: TByteDynArray;
    fPermissions: TPdfEncryptionPermissions;
    fUserPassword: string;
    fOwnerPassword: string;
    fDoc: TPdfDocument;
    procedure EncodeBuffer(const BufIn; var BufOut; Count: cardinal); virtual; abstract;
  public
    /// initialize the internal structures with the proper classes
    // - do not call this method directly, but class function TPdfEncryption.New()
    constructor Create(aLevel: TPdfEncryptionLevel; aPermissions: TPdfEncryptionPermissions;
      const aUserPassword, aOwnerPassword: string); virtual;
    /// prepare a specific document to be encrypted
    // - internally used by TPdfDocument.NewDoc method
    procedure AttachDocument(aDoc: TPdfDocument); virtual;
    /// will create the expected TPdfEncryption instance, depending on aLevel
    // - to be called as parameter of TPdfDocument/TPdfDocumentGDI.Create()
    // - currently, only elRC4_40 and elRC4_128 levels are implemented
    // - both passwords are expected to be ASCII-7 characters only
    // - aUserPassword will be asked at file opening: to be set to '' for not
    // blocking display, but optional permission
    // - aOwnerPassword shall not be '', and will be used internally to cypher
    // the pdf file content
    // - aPermissions can be either one of the PDF_PERMISSION_ALL /
    // PDF_PERMISSION_NOMODIF / PDF_PERSMISSION_NOPRINT / PDF_PERMISSION_NOCOPY /
    // PDF_PERMISSION_NOCOPYNORPRINT set of options
    // - typical use may be:
    // ! Doc := TPdfDocument.Create(false,0,false,
    // !   TPdfEncryption.New(elRC4_40,'','toto',PDF_PERMISSION_NOMODIF));
    // ! Doc := TPdfDocument.Create(false,0,false,
    // !   TPdfEncryption.New(elRC4_128,'','toto',PDF_PERMISSION_NOCOPYNORPRINT));
    class function New(aLevel: TPdfEncryptionLevel;
      const aUserPassword, aOwnerPassword: string;
      aPermissions: TPdfEncryptionPermissions): TPdfEncryption;
  end;

  /// internal 32 bytes buffer, used during encryption process
  TPdfBuffer32 = array[0..31] of byte;

  /// handle PDF security with RC4+MD5 scheme in 40-bit and 128-bit
  // - allowed aLevel parameters for Create() are only elRC4_40 and elRC4_128
  TPdfEncryptionRC4MD5 = class(TPdfEncryption)
  protected
    fLastObjectNumber: integer;
    fLastGenerationNumber: Integer;
    fUserPass, fOwnerPass: TPdfBuffer32;
    fLastRC4Key: TRC4;
    procedure EncodeBuffer(const BufIn; var BufOut; Count: cardinal); override;
  public
    /// prepare a specific document to be encrypted
    // - will compute the internal keys
    procedure AttachDocument(aDoc: TPdfDocument); override;
  end;
{$endif USE_PDFSECURITY}

  /// buffered writer class, specialized for PDF encoding
  TPdfWrite = class
  protected
    B, BEnd, BEnd4: PAnsiChar;
    fDestStream: TStream;
    fDestStreamPosition: integer;
    fCodePage: integer;
    fAddGlyphFont: (fNone, fMain, fFallBack);
    fDoc: TPdfDocument;
    Tmp: array[0..511] of AnsiChar;
    /// internal Ansi->Unicode conversion, using the CodePage used in Create()
    // - caller must release the returned memory via FreeMem()
    function ToWideChar(const Ansi: PDFString; out DLen: Integer): PWideChar;
    {$ifdef USE_UNISCRIBE}
    /// internal method using the Windows Uniscribe API
    // - return FALSE if PW was not appened to the PDF content, TRUE if OK
    function AddUnicodeHexTextUniScribe(PW: PWideChar; WinAnsiTTF: TPdfFontTrueType;
      NextLine: boolean; Canvas: TPdfCanvas): boolean;
    {$endif}
    /// internal method NOT using the Windows Uniscribe API
    procedure AddUnicodeHexTextNoUniScribe(PW: PWideChar; TTF: TPdfFontTrueType;
      NextLine: boolean; Canvas: TPdfCanvas);
    /// internal methods handling font fall-back
    procedure AddGlyphFromChar(Char: WideChar; Canvas: TPdfCanvas;
      TTF: TPdfFontTrueType; NextLine: PBoolean);
    procedure AddGlyphFlush(Canvas: TPdfCanvas; TTF: TPdfFontTrueType; NextLine: PBoolean);
  public
    /// create the buffered writer, for a specified destination stream
    constructor Create(Destination: TPdfDocument; DestStream: TStream);
    /// add a character to the buffer
    function Add(c: AnsiChar): TPdfWrite; overload; {$ifdef HASINLINE}inline;{$endif}
    /// add an integer numerical value to the buffer
    function Add(Value: Integer): TPdfWrite; overload;
    /// add an integer numerical value to the buffer
    // - and append a trailing space
    function AddWithSpace(Value: Integer): TPdfWrite; overload;
    /// add an integer numerical value to the buffer
    // - with a specified fixed number of digits (left filled by '0')
    function Add(Value, DigitCount: Integer): TPdfWrite; overload;
    /// add a floating point numerical value to the buffer
    // - up to 2 decimals are written
    function Add(Value: TSynExtended): TPdfWrite; overload;
    /// add a floating point numerical value to the buffer
    // - up to 2 decimals are written, together with a trailing space
    function AddWithSpace(Value: TSynExtended): TPdfWrite; overload;
    /// add a floating point numerical value to the buffer
    // - this version handles a variable number of decimals, together with
    // a trailing space - this is used by ConcatToCTM e.g. or enhanced precision
    function AddWithSpace(Value: TSynExtended; Decimals: cardinal): TPdfWrite; overload;
    /// direct raw write of some data
    // - no conversion is made
    function Add(Text: PAnsiChar; Len: integer): TPdfWrite; overload;
    /// direct raw write of some data
    // - no conversion is made
    function Add(const Text: RawByteString): TPdfWrite; overload;
    /// hexadecimal write of some row data
    // - row data is written as hexadecimal byte values, one by one
    function AddHex(const Bin: PDFString): TPdfWrite;
    /// add a word value, as Big-Endian 4 hexadecimal characters
    function AddHex4(aWordValue: cardinal): TPdfWrite;
    /// convert some text into unicode characters, then write it as as Big-Endian
    // 4 hexadecimal characters
    // - Ansi to Unicode conversion uses the CodePage set by Create() constructor
    function AddToUnicodeHex(const Text: PDFString): TPdfWrite;
    /// write some unicode text as as Big-Endian 4 hexadecimal characters
    function AddUnicodeHex(PW: PWideChar; WideCharCount: integer): TPdfWrite;
    /// convert some text into unicode characters, then write it as PDF Text
    // - Ansi to Unicode conversion uses the CodePage set by Create() constructor
    // - use (...) for all WinAnsi characters, or <..hexa..> for Unicode characters
    // - if NextLine is TRUE, the first written PDF Text command is not Tj but '
    // - during the text process, corresponding TPdfTrueTypeFont properties are
    // updated (Unicode version created if necessary, indicate used glyphs for
    // further Font properties writting to the PDF file content...)
    // - if the current font is not True Type, all Unicode characters are
    // drawn as '?'
    function AddToUnicodeHexText(const Text: PDFString; NextLine: boolean;
      Canvas: TPdfCanvas): TPdfWrite;
    /// write some Unicode text, as PDF text
    // - incoming unicode text must end with a #0
    // - use (...) for all WinAnsi characters, or <..hexa..> for Unicode characters
    // - if NextLine is TRUE, the first written PDF Text command is not Tj but '
    // - during the text process, corresponding TPdfTrueTypeFont properties are
    // updated (Unicode version created if necessary, indicate used glyphs for
    // further Font properties writting to the PDF file content...)
    // - if the current font is not True Type, all Unicode characters are
    // drawn as '?'
    function AddUnicodeHexText(PW: PWideChar; NextLine: boolean;
      Canvas: TPdfCanvas): TPdfWrite;
    /// write some Unicode text, encoded as Glyphs indexes, corresponding
    // to the current font
    function AddGlyphs(Glyphs: PWord; GlyphsCount: integer; Canvas: TPdfCanvas;
      AVisAttrsPtr: Pointer=nil): TPdfWrite;
    /// add some WinAnsi text as PDF text
    // - used by TPdfText object
    // - will optionally encrypt the content
    function AddEscapeContent(const Text: RawByteString): TPdfWrite;
    /// add some WinAnsi text as PDF text
    // - used by TPdfText object
    function AddEscape(Text: PAnsiChar; TextLen: integer): TPdfWrite;
    /// add some WinAnsi text as PDF text
    // - used by TPdfCanvas.ShowText method for WinAnsi text
    function AddEscapeText(Text: PAnsiChar; Font: TPdfFont): TPdfWrite;
    /// add some PDF /property value
    function AddEscapeName(Text: PAnsiChar): TPdfWrite;
    {$ifdef MSWINDOWS}
    /// add a PDF color, from its TPdfColorRGB RGB value
    function AddColorStr(Color: TPdfColorRGB): TPdfWrite;
    {$endif}
    /// add a TBitmap.Scanline[] content into the stream
    procedure AddRGB(P: PAnsiChar; PInc, Count: integer);
    /// add an ISO 8601 encoded date time (e.g. '2010-06-16T15:06:59-07:00')
    function AddIso8601(DateTime: TDateTime): TPdfWrite;
    /// add an integer value as binary, specifying a storage size in bytes
    function AddIntegerBin(value: integer; bytesize: cardinal): TPdfWrite;
  public
    /// flush the internal buffer to the destination stream
    procedure Save; {$ifdef HASINLINE}inline;{$endif}
    /// return the current position
    // - add the current internal buffer stream position to the destination
    // stream position
    function Position: Integer; {$ifdef HASINLINE}inline;{$endif}
    /// get the data written to the Writer as a PDFString
    // - this method could not use Save to flush the data, if all input was
    // inside the internal buffer (save some CPU and memory): so don't intend
    // the destination stream to be flushed after having called this method
    function ToPDFString: PDFString;
  end;

  /// object manager is a virtual class to manage instance of indirect PDF objects
  TPdfObjectMgr = class(TObject)
  public
    procedure AddObject(AObject: TPdfObject); virtual; abstract;
    function GetObject(ObjectID: integer): TPdfObject; virtual; abstract;
  end;

  /// master class for most PDF objects declaration
  TPdfObject = class(TObject)
  private
    FObjectType: TPdfObjectType;
    FObjectNumber: integer;
    FGenerationNumber: integer;
    FSaveAtTheEnd: boolean;
  protected
    procedure InternalWriteTo(W: TPdfWrite); virtual;
    procedure SetObjectNumber(Value: integer);
    function SpaceNotNeeded: boolean; virtual;
  public
    /// create the PDF object instance
    constructor Create; virtual;
    /// Write object to specified stream
    // - If object is indirect object then write references to stream
    procedure WriteTo(var W: TPdfWrite);
    /// write indirect object to specified stream
    // - this method called by parent object
    procedure WriteValueTo(var W: TPdfWrite);
    /// low-level force the object to be saved now
    // - you should not use this low-level method, unless you want to force
    // the FSaveAtTheEnd internal flag to be set to force, so that
    // TPdfDocument.SaveToStreamDirectPageFlush would flush the object content
    procedure ForceSaveNow;
    /// the associated PDF Object Number
    // - If you set an object number higher than zero, the object is considered
    // as indirect. Otherwise, the object is considered as direct object.
    property ObjectNumber: integer read FObjectNumber write SetObjectNumber;
    /// the associated PDF Generation Number
    property GenerationNumber: integer read FGenerationNumber;
    /// the corresponding type of this PDF object
    property ObjectType: TPdfObjectType read FObjectType;
  end;

  /// a virtual PDF object, with an associated PDF Object Number
  TPdfVirtualObject = class(TPdfObject)
  public
    constructor Create(AObjectId: integer); reintroduce;
  end;

  /// a PDF object, storing a boolean value
  TPdfBoolean = class(TPdfObject)
  private
    FValue: boolean;
  protected
    procedure InternalWriteTo(W: TPdfWrite); override;
  public
    constructor Create(AValue: Boolean); reintroduce;
    property Value: boolean read FValue write FValue;
  end;

  /// a PDF object, storing a NULL value
  TPdfNull = class(TPdfObject)
  protected
    procedure InternalWriteTo(W: TPdfWrite); override;
  end;

  /// a PDF object, storing a numerical (integer) value
  TPdfNumber = class(TPdfObject)
  private
    FValue: integer;
  protected
    procedure InternalWriteTo(W: TPdfWrite); override;
  public
    constructor Create(AValue: Integer); reintroduce;
    property Value: integer read FValue write FValue;
  end;

  /// a PDF object, storing a numerical (floating point) value
  TPdfReal = class(TPdfObject)
  private
    FValue: double;
  protected
    procedure InternalWriteTo(W: TPdfWrite); override;
  public
    constructor Create(AValue: double); reintroduce;
    property Value: double read FValue write FValue;
  end;

  /// a PDF object, storing a textual value
  // - the value is specified as a PDFString
  // - this object is stored as '(escapedValue)'
  // - in case of MBCS, conversion is made into Unicode before writing, and
  // stored as '<FEFFHexUnicodeEncodedValue>'
  TPdfText = class(TPdfObject)
  private
    FValue: RawByteString;
  protected
    procedure InternalWriteTo(W: TPdfWrite); override;
    function SpaceNotNeeded: boolean; override;
  public
    constructor Create(const AValue: RawByteString); reintroduce;
    property Value: RawByteString read FValue write FValue;
  end;

  /// a PDF object, storing a textual value
  // - the value is specified as an UTF-8 encoded string
  // - this object is stored as '(escapedValue)'
  // - in case characters with ANSI code higher than 8 Bits, conversion is made
  // into Unicode before writing, and '<FEFFHexUnicodeEncodedValue>'
  TPdfTextUTF8 = class(TPdfObject)
  private
    FValue: RawUTF8;
  protected
    procedure InternalWriteTo(W: TPdfWrite); override;
    function SpaceNotNeeded: boolean; override;
  public
    constructor Create(const AValue: RawUTF8); reintroduce;
    property Value: RawUTF8 read FValue write FValue;
  end;

  /// a PDF object, storing a textual value
  // - the value is specified as a generic VCL string
  // - this object is stored as '(escapedValue)'
  // - in case characters with ANSI code higher than 8 Bits, conversion is made
  // into Unicode before writing, and '<FEFFHexUnicodeEncodedValue>'
  TPdfTextString = class(TPdfTextUTF8)
  private
    function GetValue: string;
    procedure SetValue(const Value: string);
  public
    constructor Create(const AValue: string); reintroduce;
    property Value: string read GetValue write SetValue;
  end;

  /// a PDF object, storing a raw PDF content
  // - this object is stored into the PDF stream as the defined Value
  TPdfRawText = class(TPdfText)
  protected
    function SpaceNotNeeded: boolean; override;
    procedure InternalWriteTo(W: TPdfWrite); override;
  end;

  /// a PDF object, storing a textual value with no encryption
  // - the value is specified as a memory buffer
  // - this object is stored as '(escapedValue)'
  TPdfClearText = class(TPdfText)
  protected
    procedure InternalWriteTo(W: TPdfWrite); override;
  public
    constructor Create(Buffer: pointer; Len: integer); reintroduce;
  end;

  /// a PDF object, storing a PDF name
  // - this object is stored as '/Value'
  TPdfName = class(TPdfText)
  protected
    procedure InternalWriteTo(W: TPdfWrite); override;
  public
    /// append the 'SUBSET+' prefix to the Value
    // - used e.g. to notify that a font is included as a subset
    function AppendPrefix: RawUtf8;
  end;

  /// used to store an array of PDF objects
  TPdfArray = class(TPdfObject)
  private
    FArray: TList;
    FObjectMgr: TPdfObjectMgr;
    function GetItems(Index: integer): TPdfObject; {$ifdef HASINLINE}inline;{$endif}
    function GetItemCount: integer; {$ifdef HASINLINE}inline;{$endif}
  protected
    procedure InternalWriteTo(W: TPdfWrite); override;
    function SpaceNotNeeded: boolean; override;
  public
    /// create an array of PDF objects
    constructor Create(AObjectMgr: TPdfObjectMgr); reintroduce; overload;
    /// create an array of PDF objects, with some specified TPdfNumber values
    constructor Create(AObjectMgr: TPdfObjectMgr;
      const AArray: array of Integer); reintroduce; overload;
    /// create an array of PDF objects, with some specified TPdfNumber values
    constructor Create(AObjectMgr: TPdfObjectMgr;
      AArray: PWordArray; AArrayCount: integer); reintroduce; overload;
    /// create an array of PDF objects, with some specified TPdfName values
    constructor CreateNames(AObjectMgr: TPdfObjectMgr;
      const AArray: array of PDFString); reintroduce; overload;
    /// create an array of PDF objects, with some specified TPdfReal values
    constructor CreateReals(AObjectMgr: TPdfObjectMgr;
      const AArray: array of double); reintroduce; overload;
    /// release the instance memory, and all embedded objects instances
    destructor Destroy; override;
    /// Add a PDF object to the array
    // - if AItem already exists, do nothing
    function AddItem(AItem: TPdfObject): integer;
    /// insert a PDF object to the array
    // - if AItem already exists, do nothing
    procedure InsertItem(Index: Integer; AItem: TPdfObject);
    /// retrieve a TPDFName object stored in the array
    function FindName(const AName: PDFString): TPdfName;
    /// remove a specified TPDFName object stored in the array
    function RemoveName(const AName: PDFString): boolean;
    /// retrieve an object instance, stored in the array
    property Items[Index: integer]: TPdfObject read GetItems; default;
    /// retrieve the array size
    property ItemCount: integer read GetItemCount;
    /// the associated PDF Object Manager
    property ObjectMgr: TPdfObjectMgr read FObjectMgr;
    /// direct access to the internal TList instance
    // - not to be used normally
    property List: TList read FArray;
  end;

  /// PDF dictionary element definition
  TPdfDictionaryElement = class(TObject)
  private
    FKey: TPdfName;
    FValue: TPdfObject;
    FIsInternal: boolean;
    function GetKey: PDFString;
  public
    /// create the corresponding Key / Value pair
    constructor Create(const AKey: PDFString; AValue: TPdfObject; AInternal: Boolean=false);
    /// release the element instance, and both associated Key and Value
    destructor Destroy; override;
    /// the associated Key Name
    property Key: PDFString read GetKey;
    /// the associated Value stored in this element
    property Value: TPdfObject read FValue;
    /// if this element was created as internal, i.e. not to be saved to the PDF content
    property IsInternal: boolean read FIsInternal;
  end;

  /// a PDF Dictionary is used to manage Key / Value pairs
  TPdfDictionary = class(TPdfObject)
  private
    FArray: TList;
    FObjectMgr: TPdfObjectMgr;
    function GetItems(Index: integer): TPdfDictionaryElement; {$ifdef HASINLINE}inline;{$endif}
    function GetItemCount: integer; {$ifdef HASINLINE}inline;{$endif}
  protected
    function getTypeOf: PDFString;
    function SpaceNotNeeded: boolean; override;
    procedure DirectWriteto(W: TPdfWrite; Secondary: TPdfDictionary);
    procedure InternalWriteTo(W: TPdfWrite); override;
  public
    /// create the PDF dictionary
    constructor Create(AObjectMgr: TPdfObjectMgr); reintroduce;
    /// release the dictionay instance, and all associated elements
    destructor Destroy; override;
    /// fast find a value by its name
    function ValueByName(const AKey: PDFString): TPdfObject;
    /// fast find a boolean value by its name
    function PdfBooleanByName(const AKey: PDFString): TPdfBoolean; {$ifdef HASINLINE}inline;{$endif}
    /// fast find a numerical (integer) value by its name
    function PdfNumberByName(const AKey: PDFString): TPdfNumber; {$ifdef HASINLINE}inline;{$endif}
    /// fast find a textual value by its name
    function PdfTextByName(const AKey: PDFString): TPdfText; {$ifdef HASINLINE}inline;{$endif}
    /// fast find a textual value by its name
    // - return '' if not found, the TPdfText.Value otherwise
    function PdfTextValueByName(const AKey: PDFString): PDFString; {$ifdef HASINLINE}inline;{$endif}
    /// fast find a textual value by its name
    // - return '' if not found, the TPdfTextUTF8.Value otherwise
    function PdfTextUTF8ValueByName(const AKey: PDFString): RawUTF8; {$ifdef HASINLINE}inline;{$endif}
    /// fast find a textual value by its name
    // - return '' if not found, the TPdfTextString.Value otherwise
    function PdfTextStringValueByName(const AKey: PDFString): string; {$ifdef HASINLINE}inline;{$endif}
    /// fast find a numerical (floating-point) value by its name
    function PdfRealByName(const AKey: PDFString): TPdfReal; {$ifdef HASINLINE}inline;{$endif}
    /// fast find a name value by its name
    function PdfNameByName(const AKey: PDFString): TPdfName; {$ifdef HASINLINE}inline;{$endif}
    /// fast find a dictionary value by its name
    function PdfDictionaryByName(const AKey: PDFString): TPdfDictionary; {$ifdef HASINLINE}inline;{$endif}
    /// fast find an array value by its name
    function PdfArrayByName(const AKey: PDFString): TPdfArray; {$ifdef HASINLINE}inline;{$endif}
    /// add a specified Key / Value pair to the dictionary
    // - create PdfDictionaryElement with given key and value, and add it to list
    // - if the element exists, replace value of element by given value
    // - internal items are local to the framework, and not to be saved to the PDF content
    procedure AddItem(const AKey: PDFString; AValue: TPdfObject; AInternal: Boolean=false); overload;
    /// add a specified Key / Value pair (of type TPdfName) to the dictionary
    procedure AddItem(const AKey, AValue: PDFString); overload; {$ifdef HASINLINE}inline;{$endif}
    /// add a specified Key / Value pair (of type TPdfNumber) to the dictionary
    procedure AddItem(const AKey: PDFString; AValue: integer); overload; {$ifdef HASINLINE}inline;{$endif}
    /// add a specified Key / Value pair (of type TPdfText) to the dictionary
    procedure AddItemText(const AKey, AValue: PDFString); overload; {$ifdef HASINLINE}inline;{$endif}
    /// add a specified Key / Value pair (of type TPdfTextUTF8) to the dictionary
    // - the value can be any UTF-8 encoded text: it will be written as
    // Unicode hexadecimal to the PDF stream, if necessary
    procedure AddItemTextUTF8(const AKey: PDFString; const AValue: RawUTF8); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// add a specified Key / Value pair (of type TPdfTextUTF8) to the dictionary
    // - the value is a generic VCL string: it will be written as
    // Unicode hexadecimal to the PDF stream, if necessary
    procedure AddItemTextString(const AKey: PDFString; const AValue: string); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// remove the element specified by its Key from the dictionary
    // - if the element does not exist, do nothing
    procedure RemoveItem(const AKey: PDFString);
    /// retrieve any dictionary element
    property Items[Index: integer]: TPdfDictionaryElement read GetItems; default;
    /// retrieve the dictionary element count
    property ItemCount: integer read GetItemCount;
    /// retrieve the associated Object Manager
    property ObjectMgr: TPdfObjectMgr read FObjectMgr;
    /// retrieve the type of the pdfdictionary object, i.e. the 'Type' property name
    property TypeOf: PDFString read getTypeOf;
    /// direct access to the internal TList instance
    // - not to be used normally
    property List: TList read FArray;
  end;

  /// a temporary memory stream, to be stored into the PDF content
  // - typicaly used for the page content
  // - can be compressed, if the FlateDecode filter is set
  TPdfStream = class(TPdfObject)
  protected
    FAttributes: TPdfDictionary;
    FSecondaryAttributes: TPdfDictionary;
{$ifdef USE_PDFSECURITY}
    FDoNotEncrypt: boolean;
{$endif}
    FFilter: PDFString;
    FWriter: TPdfWrite;
    procedure InternalWriteTo(W: TPdfWrite); override;
  public
    /// create the temporary memory stream
    // - an optional DontAddToFXref is available, if you don't want to add
    // this object to the main XRef list of the PDF file
    constructor Create(ADoc: TPdfDocument; DontAddToFXref: boolean=false); reintroduce;
    /// release the memory stream
    destructor Destroy; override;
    /// retrieve the associated attributes, e.g. the stream Length
    property Attributes: TPdfDictionary read FAttributes;
    /// retrieve the associated buffered writer
    // - use this TPdfWrite instance to write some data into the stream
    property Writer: TPdfWrite read FWriter;
    /// retrieve the associated filter name
    property Filter: PDFString read FFilter write FFilter;
  end;

  /// used to handle object which are not defined in this library
  TPdfBinary = class(TPdfObject)
  protected
    FStream: TMemoryStream;
    procedure InternalWriteTo(W: TPdfWrite); override;
  public
    /// create the instance, i.e. its associated stream
    constructor Create; override;
    /// release the instance
    destructor Destroy; override;
    /// the associated memory stream, used to store the corresponding data
    // - the content of this stream will be written to the resulting
    property Stream: TMemoryStream read FStream;
  end;

  TPdfXref = class;
  TPdfObjectStream = class;

  /// the Trailer of the PDF File
  TPdfTrailer = class(TObject)
  private
    FAttributes: TPdfDictionary;
    FXrefAddress: integer;
    FCrossReference: TPdfStream;
    FObjectStream: TPdfObjectStream;
    FXRef: TPdfXref;
  protected
    procedure WriteTo(var W: TPdfWrite);
  public
    constructor Create(AObjectMgr: TPdfObjectMgr);
    destructor Destroy; override;
    procedure ToCrossReference(Doc: TPdfDocument);
    property XrefAddress: integer read FXrefAddress write FXrefAddress;
    property Attributes: TPdfDictionary read FAttributes;
  end;

  /// store one entry in the XRef list of the PDF file
  TPdfXrefEntry = class(TObject)
  private
    FEntryType: PDFString;
    FByteOffset: integer;
    FGenerationNumber: integer;
    FObjectStreamIndex: integer;
    FValue: TPdfObject;
  public
    /// create the entry, with the specified value
    // - if the value is nil (e.g. root entry), the type is 'f' (PDF_FREE_ENTRY),
    // otherwise the entry type is 'n' (PDF_IN_USE_ENTRY)
    constructor Create(AValue: TPdfObject);
    /// release the memory, and the associated value, if any
    destructor Destroy; override;
    /// write the XRef list entry
    procedure SaveToPdfWrite(var W: TPdfWrite);
    /// return either 'f' (PDF_FREE_ENTRY), either 'n' (PDF_IN_USE_ENTRY)
    property EntryType: PDFString read FEntryType write FEntryType;
    /// the position (in bytes) in the PDF file content stream
    // - to be ignored if ObjectStreamIndex>=0
    property ByteOffset: integer read FByteOffSet;
    /// the index of this object in the global compressed /ObjStm object stream
    // - equals -1 by default, i.e. if stored within the main file content stream
    property ObjectStreamIndex: Integer read FObjectStreamIndex;
    /// the associated Generation Number
    // - mostly 0, or 65535 (PDF_MAX_GENERATION_NUM) for the root 'f' entry
    property GenerationNumber: integer read FGenerationNumber write FGenerationNumber;
    /// the associated PDF object
    property Value: TPdfObject read FValue;
  end;

  /// store the XRef list of the PDF file
  TPdfXref = class(TPdfObjectMgr)
  private
    FXrefEntries: TList;
    function GetItem(ObjectID: integer): TPdfXrefEntry; {$ifdef HASINLINE}inline;{$endif}
    function GetItemCount: integer; {$ifdef HASINLINE}inline;{$endif}
  protected
    procedure WriteTo(var W: TPdfWrite);
  public
    /// initialize the XRef object list
    // - create first a void 'f' (PDF_FREE_ENTRY) as root
    constructor Create;
    /// release instance memory and all associated XRef objects
    destructor Destroy; override;
    /// register object to the xref table, and set corresponding object ID
    procedure AddObject(AObject: TPdfObject); override;
    /// retrieve an object from its object ID
    function GetObject(ObjectID: integer): TPdfObject; override;
    /// retrieve a XRef object instance, from its object ID
    property Items[ObjectID: integer]: TPdfXrefEntry read GetItem; default;
    /// retrieve the XRef object count
    property ItemCount: integer read GetItemCount;
  end;

  /// any object stored to the PDF file
  // - these objects are the main unit of the PDF file content
  // - these objects are written in the PDF file, followed by a "xref" table
  TPdfXObject = class(TPdfStream);

  /// generic PDF Outlines entries, stored as a PDF dictionary
  TPdfOutlines = class(TPdfDictionary);

  /// generic PDF Optional Content entry
  TPdfOptionalContentGroup = class(TPdfDictionary);

  TPdfInfo = class;
  TPdfCatalog = class;
  TPdfDestination = class;
  TPdfOutlineEntry = class;
  TPdfOutlineRoot = class;
  TPdfPage = class;
  TPdfPageClass = class of TPdfPage;

  /// potential font styles
  TPdfFontStyle = (pfsBold, pfsItalic, pfsUnderline, pfsStrikeOut);
  /// set of font styles
  TPdfFontStyles = set of TPdfFontStyle;

  /// the main class of the PDF engine, processing the whole PDF document
  TPdfDocument = class(TObject)
  protected
    FRoot: TPdfCatalog;
    FCurrentPages: TPdfDictionary;
    FOutputIntents: TPdfArray;
    FMetaData: TPdfStream;
    FCanvas: TPdfCanvas;
    FTrailer: TPdfTrailer;
    FXref: TPdfXref;
    FInfo: TPdfInfo;
    FFontList: TList;
    FObjectList: TList;
    FOutlineRoot: TPdfOutlineRoot;
    FStructTree: TPdfDictionary;
    FXObjectList: TPdfArray;
    FDefaultPageWidth: cardinal;
    FDefaultPageHeight: Cardinal;
    FDefaultPaperSize: TPDFPaperSize;
    FCompressionMethod: TPdfCompressionMethod;
    FUseOutlines: boolean;
    FUseOptionalContent: boolean;
    FCharSet: integer;
    FCodePage: cardinal;
    FTrueTypeFonts: TRawUTF8DynArray;
    FTrueTypeFontLastName: RawUTF8;
    FTrueTypeFontLastIndex: integer;
    FDC: HDC;
    FScreenLogPixels: Integer;
    FPrinterPxPerInch: TPoint;
    FStandardFontsReplace: boolean;
    fEmbeddedTTF: boolean;
    fEmbeddedWholeTTF: boolean;
    fEmbeddedTTFIgnore: TRawUTF8List;
    fRawPages: TList;
    {$ifdef USE_UNISCRIBE}
    fUseUniscribe: boolean;
    {$endif}
    fSelectedDCFontOld: HDC;
    fForceJPEGCompression: Integer;
    fForceNoBitmapReuse: boolean;
    fUseFontFallBack: boolean;
    fFontFallBackIndex: integer;
    /// a list of Bookmark text keys, associated to a TPdfDest object
    fBookMarks: TRawUTF8List;
    fMissingBookmarks: TRawUTF8List;
    /// internal temporary variable - used by CreateOutline
    fLastOutline: TPdfOutlineEntry;
    fFileFormat: TPdfFileFormat;
    fPDFA: TPdfALevel;
    fSaveToStreamWriter: TPdfWrite;
    {$ifdef USE_PDFSECURITY}
    fEncryption: TPdfEncryption;
    fFileID: TMD5Digest;
    fEncryptionObject: TPdfDictionary;
    fCurrentObjectNumber: integer;
    fCurrentGenerationNumber: integer;
    {$endif USE_PDFSECURITY}
    function GetGeneratePDF15File: boolean;
    procedure SetGeneratePDF15File(const Value: boolean);
    function GetInfo: TPdfInfo;     {$ifdef HASINLINE}inline;{$endif}
    function GetOutlineRoot: TPdfOutlineRoot; {$ifdef HASINLINE}inline;{$endif}
    procedure SetStandardFontsReplace(const Value: boolean); {$ifdef HASINLINE}inline;{$endif}
    function GetEmbeddedTTFIgnore: TRawUTF8List;
    procedure SetDefaultPaperSize(const Value: TPDFPaperSize);
    procedure SetDefaultPageHeight(const Value: cardinal);
    procedure SetDefaultPageWidth(const Value: cardinal);
    procedure SetUseOptionalContent(const Value: boolean);
    procedure SetPDFA(const Value: TPdfALevel);
    {$ifndef USE_PDFALEVEL}
    function  GetPDFA1: boolean;
    procedure SetPDFA1(const Value: boolean);
    {$endif}
    function GetDefaultPageLandscape: boolean;
    procedure SetDefaultPageLandscape(const Value: boolean);
    procedure SetFontFallBackName(const Value: string);
    function GetFontFallBackName: string;
  protected
    /// can be useful in descendant objects in other units
    fTPdfPageClass: TPdfPageClass;
    procedure RaiseInvalidOperation;
    procedure CreateInfo;
    /// get the PostScript Name of a TrueType Font
    // - use the Naming Table ('name') of the TTF content if not 7 bit ascii
    function TTFFontPostcriptName(aFontIndex: integer; AStyle: TPdfFontStyles;
      AFont: TPdfFontTrueType): PDFString;
    /// register the font in the font list
    procedure RegisterFont(aFont: TPdfFont);
    /// get the PDF font, from its internal PDF name (e.g. 'Helvetica-Bold')
    // - if the specified font exists in the font list, returns the corresponding object
    // - if the font doesn't exist yet, returns NIL
    function GetRegisteredNotTrueTypeFont(const APDFFontName: PDFString): TPdfFont;
    /// get the supplied TrueType Font from the internal font list
    // - warning: the font index is FTrueTypeFonts.IndexOf(AName)+1, since
    // font index 0 is reserved for all not True Type fonts
    // - if the true type font doesn't exist yet, returns NIL
    // - always return the WinAnsi version of the font: the caller has to
    // use the UnicodeFont property to get the corresponding Unicode aware
    // version, if it was used
    function GetRegisteredTrueTypeFont(AFontIndex: integer;
      AStyle: TPdfFontStyles; ACharSet: byte): TPdfFont; overload;
    /// get the supplied TrueType Font from the internal font list
    // - if the true type font doesn't exist yet, returns NIL
    function GetRegisteredTrueTypeFont(const AFontLog: TLogFontW): TPdfFont; overload;
    /// find an index of in FTrueTypeFonts[]
    function GetTrueTypeFontIndex(const AName: RawUTF8): integer;
    // select the specified font object, then return the fDC value
    function GetDCWithFont(TTF: TPdfFontTrueType): HDC;
    /// release the current document content
    procedure FreeDoc;
  public
    /// create the PDF document instance, with a Canvas and a default A4 paper size
    // - the current charset and code page are retrieved from the SysLocale
    // value, so the PDF engine is MBCS ready
    // - note that only Win-Ansi encoding allows use of embedded standard fonts
    // - you can specify a Code Page to be used for the PDFString encoding;
    // by default (ACodePage left to 0), the current system code page is used
    // - you can create a PDF/A compliant document by setting APDFA to PDF/A Level 
    // or APDFA1 to true
    // - you can set an encryption instance, by using TPdfEncryption.New()
    constructor Create(AUseOutlines: Boolean=false; ACodePage: integer=0;
      {$ifdef USE_PDFALEVEL]}APDFA: TPdfALevel=pdfaNone{$else}APDFA1: boolean=false{$endif}
      {$ifdef USE_PDFSECURITY}; AEncryption: TPdfEncryption=nil{$endif}); reintroduce;
    /// release the PDF document instance
    destructor Destroy; override;
    /// create a new document
    // - this method is called first, by the Create constructor
    // - you can call it multiple time if you want to reset the whole document content
    procedure NewDoc;
    /// add a Page to the current PDF document
    function AddPage: TPdfPage; virtual;
    /// register a font to the internal TTF font list
    // - some fonts may not be enumerated in the system, e.g. after calling
    // AddFontMemResourceEx, so could be registered by this method
    // - to be called just after Create(), before anything is written
    function AddTrueTypeFont(const TTFName: RawUtf8): boolean;
    /// create a Pages object
    // - Pages objects can be nested, to save memory used by the Viewer
    // - only necessary if you have more than 8000 pages (this method is called
    // by TPdfDocument.NewDoc, so you shouldn't have to use it)
    function CreatePages(Parent: TPdfDictionary): TPdfDictionary;
    /// register an object (typicaly a TPdfImage) to the PDF document
    // - returns the internal index as added in FXObjectList[]
    function RegisterXObject(AObject: TPdfXObject; const AName: PDFString): integer;
    /// add then register an object (typicaly a TPdfImage) to the PDF document
    // - returns the internal index as added in FXObjectList[]
    function AddXObject(const AName: PDFString; AXObject: TPdfXObject): integer;
    /// save the PDF file content into a specified Stream
    procedure SaveToStream(AStream: TStream; ForceModDate: TDateTime=0); virtual;
    /// prepare to save the PDF file content into a specified Stream
    // - is called by SaveToStream() method
    // - you can then append other individual pages with SaveToStreamCurrentPage
    // to avoid most resource usage (e.g. for report creation)
    // - shall be finished by a SaveToStreamDirectEnd call
    procedure SaveToStreamDirectBegin(AStream: TStream; ForceModDate: TDateTime=0);
    /// save the current page content to the PDF file
    // - shall be made one or several times after a SaveToStreamDirectBegin() call
    // and before a final SaveToStreamDirectEnd call
    // - see TPdfDocumentGDI.SaveToStream() in this unit, and
    // TGDIPages.ExportPDFStream() in mORMotReport.pas for real use cases
    // - you can set FlushCurrentPageNow=true to force the current page to be
    // part of the flushed content
    procedure SaveToStreamDirectPageFlush(FlushCurrentPageNow: boolean=false); virtual;
    /// prepare to save the PDF file content into a specified Stream
    // - shall be made once after a SaveToStreamDirectBegin() call
    // - is called by SaveToStream() method
    procedure SaveToStreamDirectEnd;
    /// save the PDF file content into a specified file
    // - return FALSE on any writing error (e.g. if the file is opened in the
    // Acrobar Reader)
    function SaveToFile(const aFileName: TFileName): boolean;
    /// retrieve a XObject from its name
    // - this method will handle also the Virtual Objects
    function GetXObject(const AName: PDFString): TPdfXObject;
    /// retrieve a XObject index from its name
    // - this method won't handle the Virtual Objects
    function GetXObjectIndex(const AName: PDFString): integer;
    {$ifdef USE_BITMAP}
    /// retrieve a XObject TPdfImage index from its picture attributes
    // - returns '' if this image is not already there
    // - uses 4 hash codes, created with 4 diverse seeds, in order to avoid
    // false positives
    function GetXObjectImageName(const Hash: THash128Rec; Width, Height: Integer): PDFString;
    {$endif USE_BITMAP}
    /// wrapper to create an annotation
    // - the annotation is set to a specified position of the current page
    function CreateAnnotation(AType: TPdfAnnotationSubType; const ARect: TPdfRect;
      BorderStyle: TPdfAnnotationBorder=abSolid; BorderWidth: integer=1): TPdfDictionary;
    /// wrapper to create a Link annotation, specified by a bookmark
    // - the link is set to a specified rectangular position of the current page
    // - if the bookmark name is not existing (i.e. if it no such name has been
    // defined yet via the CreateBookMark method), it's added to the internal
    // fMissingBookmarks list, and will be linked at CreateBookMark method call
    function CreateLink(const ARect: TPdfRect; const aBookmarkName: RawUTF8;
      BorderStyle: TPdfAnnotationBorder=abSolid; BorderWidth: integer=1): TPdfDictionary;
    /// wrapper to create a hyper-link, with a specific URL value
    function CreateHyperLink(const ARect: TPdfRect; const url: RawUTF8;
      BorderStyle: TPdfAnnotationBorder=abSolid; BorderWidth: integer=0): TPdfDictionary;
    /// create an Outline entry at a specified position of the current page
    // - the outline tree is created from the specified numerical level (0=root),
    // just after the item added via the previous CreateOutline call
    // - the title is a generic VCL string, to handle fully Unicode support
    function CreateOutline(const Title: string; Level: integer; TopPosition: Single): TPdfOutlineEntry;
    /// create a Destination
    // - the current PDF Canvas page is associated with this destination object
    function CreateDestination: TPdfDestination;
    /// create an internal bookmark entry at a specified position of the current page
    // - the current PDF Canvas page is associated with the destination object
    // - a dtXYZ destination with the corresponding TopPosition Y value is defined
    // - the associated bookmark name must be unique, otherwise an exception is raised
    procedure CreateBookMark(TopPosition: Single; const aBookmarkName: RawUTF8);
    {$ifdef USE_BITMAP}
    /// create an image from a supplied bitmap
    // - returns the internal XObject name of the resulting TPDFImage
    // - if you specify a PPdfBox to draw the image at the given position/size
    // - if the same bitmap content is sent more than once, the TPDFImage will
    // be reused (it will therefore spare resulting pdf file space) - if the
    // ForceNoBitmapReuse is FALSE
    // - if ForceCompression property is set, the picture will be stored as a JPEG
    // - you can specify a clipping rectangle region as ClipRc parameter
    function CreateOrGetImage(B: TBitmap; DrawAt: PPdfBox=nil; ClipRc: PPdfBox=nil): PDFString;
    {$endif USE_BITMAP}
    // create a new optional content group (layer)
    // - returns a TPdfOptionalContentGroup needed for TPDFCanvas.BeginMarkedContent
    // - if ParentContentGroup is not nil, the new content group is a subgroup to ParentContentGroup
    // - Title is the string shown in the PDF Viewer
    // - Visible controls the initial state of the content group
    function CreateOptionalContentGroup(ParentContentGroup: TPdfOptionalContentGroup;
      const Title: string; Visible: Boolean=true): TPdfOptionalContentGroup;
    // create a Radio Optional ContentGroup
    // - ContentGroups is a array of TPdfOptionalContentGroups which should behave like
    // radiobuttons, i.e. only one active at a time
    // - visibility must be set with CreateOptionalContentGroup, only one group should be visible
    procedure CreateOptionalContentRadioGroup(const ContentGroups: array of TPdfOptionalContentGroup);
    /// retrieve the current PDF Canvas, associated to the current page
    property Canvas: TPdfCanvas read fCanvas;
    /// retrieve the PDF information, associated to the PDF document
    property Info: TPdfInfo read GetInfo;
    // retrieve the PDF Document Catalog, as root of the document's object hierarchy
    property Root: TPdfCatalog read fRoot;
    /// retrieve the PDF Outline, associated to the PDF document
    // - UseOutlines must be set to TRUE before any use of the OutlineRoot property
    property OutlineRoot: TPdfOutlineRoot read GetOutlineRoot;
    /// the default page width, used for new every page creation (i.e. AddPage method call)
    property DefaultPageWidth: cardinal read FDefaultPageWidth write SetDefaultPageWidth;
    /// the default page height, used for new every page creation (i.e. AddPage method call)
    property DefaultPageHeight: cardinal read FDefaultPageHeight write SetDefaultPageHeight;
    /// the default page orientation
    // - a call to this property will swap default page width and height if the
    // orientation is not correct
    property DefaultPageLandscape: boolean read GetDefaultPageLandscape write SetDefaultPageLandscape;
    /// the default page size, used for every new page creation (i.e. AddPage method call)
    // - a write to this property this will reset the default paper orientation
    // to Portrait: you must explicitely set DefaultPageLandscape to true, if needed
    property DefaultPaperSize: TPDFPaperSize read FDefaultPaperSize write SetDefaultPaperSize;
    /// the compression method used for page content storage
    // - is set by default to cmFlateDecode when the class instance is created
    property CompressionMethod: TPdfCompressionMethod read FCompressionMethod write FCompressionMethod;
    /// if set to TRUE, the used True Type fonts will be embedded to the PDF content
    // - not set by default, to save disk space and produce tiny PDF
    property EmbeddedTTF: boolean read fEmbeddedTTF write fEmbeddedTTF;
    /// you can add some font names to this list, if you want these fonts
    // NEVER to be embedded to the PDF file, even if the EmbeddedTTF property is set
    // - if you want to ignore all standard windows fonts, use:
    // !   EmbeddedTTFIgnore.Text := MSWINDOWS_DEFAULT_FONTS;
    property EmbeddedTTFIgnore: TRawUTF8List read GetEmbeddedTTFIgnore;
    /// if set to TRUE, the embedded True Type fonts will be totaly Embeddeded
    // - by default, is set to FALSE, meaning that a subset of the TTF font is
    // stored into the PDF file, i.e. only the used glyphs are stored
    // - this option is only available if running on Windows XP or later
    property EmbeddedWholeTTF: boolean read fEmbeddedWholeTTF write fEmbeddedWholeTTF;
    /// used to define if the PDF document will use outlines
    // - must be set to TRUE before any use of the OutlineRoot property
    property UseOutlines: boolean read FUseoutlines write FUseoutlines;
    // used to define if the PDF document will use optional content (layers)
    // - will also force PDF 1.5 as minimal file format
    // - must be set to TRUE before calling NewDoc
    // - warning: setting a value to this propery after creation will call the
    // NewDoc method, therefore will erase all previous content and pages
    // (including Info properties)
    property UseOptionalContent: boolean read FUseOptionalContent write SetUseOptionalContent;
    /// the current Code Page encoding used for this PDF Document
    property CodePage: cardinal read FCodePage;
    /// the current CharSet used for this PDF Document
    property CharSet: integer read FCharSet;
    /// set if the PDF engine must use standard fonts substitution
    // - if TRUE, 'Arial', 'Times New Roman' and 'Courier New' will be
    // replaced by the corresponding internal Type 1 fonts, defined in the Reader
    // - only works with current ANSI_CHARSET, i.e. if you want to display
    // some other unicode characters, don't enable this property: all non WinAnsi
    // glyphs would be replaced by a '?' sign
    // - default value is false (i.e. not embedded standard font)
    property StandardFontsReplace: boolean read FStandardFontsReplace write SetStandardFontsReplace;
{$ifdef USE_UNISCRIBE}
    /// set if the PDF engine must use the Windows Uniscribe API to
    // render Ordering and/or Shaping of the text
    // - useful for Hebrew, Arabic and some Asiatic languages handling
    // - set to FALSE by default, for faster content generation
    // - you can set this property temporary to TRUE, when using the Canvas
    // property, but this property must be set appropriately before the content
    // generation if you use any TPdfDocumentGdi.VCLCanvas text output with
    // such scripting (since the PDF rendering is done once just before the
    // saving, e.g. before SaveToFile() or SaveToStream() methods calls)
    // - the PDF engine don't handle Font Fallback yet: the font you use
    // must contain ALL glyphs necessary for the supplied unicode text - squares
    // or blanks will be drawn for any missing glyph/character
    property UseUniscribe: boolean read fUseUniscribe write fUseUniscribe;
{$endif}
    /// used to define if the PDF document will handle "font fallback" for
    // characters not existing in the current font: it will avoid rendering
    // block/square symbols instead of the correct characters (e.g. for Chinese text)
    // - will use the font specified by FontFallBackName property to add any
    // Unicode glyph not existing in the currently selected font
    // - default value is TRUE
    property UseFontFallBack: boolean read fUseFontFallBack write fUseFontFallBack;
    /// set the font name to be used for missing characters
    // - used only if UseFontFallBack is TRUE
    // - default value is 'Lucida Sans Unicode' or 'Arial Unicode MS', if
    // available - but you may also consider https://fonts.google.com/noto/fonts
    property FontFallBackName: string read GetFontFallBackName write SetFontFallBackName;

    /// this property can force saving all canvas bitmaps images as JPEG
    // - handle bitmaps added by VCLCanvas/TMetaFile and bitmaps added as TPdfImage
    // - by default, this property is set to 0 by the constructor of this class,
    // meaning that the JPEG compression is not forced, and the engine will use
    // the native resolution of the bitmap - in this case, the resulting
    // PDF file content will be bigger in size (e.g. use this for printing)
    // - 60 is the prefered way e.g. for publishing PDF over the internet
    // - 80/90 is a good ratio if you want to have a nice PDF to see on screen
    // - of course, this doesn't affect vectorial (i.e. emf) pictures
    property ForceJPEGCompression: integer read fForceJPEGCompression write fForceJPEGCompression;
    /// this property can force all canvas bitmaps to be stored directly
    // - by default, the library will try to match an existing same bitmap
    // content, and reuse the existing pdf object - you can set this property
    // for a faster process, if you do not want to use this feature
    property ForceNoBitmapReuse: boolean read fForceNoBitmapReuse write fForceNoBitmapReuse;
    /// direct read-only access to all corresponding TPdfPage
    // - can be useful in inherited classe
    property RawPages: TList read fRawPages;
    /// the resolution used for pixel to PDF coordinates conversion
    // - by default, contains the Number of pixels per logical inch
    // along the screen width
    // - you can override this value if you really need additional resolution
    // for your bitmaps and such - this is useful only with TPdfDocumentGDI and
    // its associated TCanvas: all TPdfDocument native TPdfCanvas methods use
    // the native resolution of the PDF, i.e. more than 7200 DPI (since we
    // write coordinates with 2 decimals per point - which is 1/72 inch)
    property ScreenLogPixels: Integer read FScreenLogPixels write FScreenLogPixels;
    /// is pdfaXXX if the file was created in order to be PDF/A compliant
    // - set APDFA parameter to a level for Create constructor in order to use it
    // - warning: setting a value to this propery after creation will call the
    // NewDoc method, therefore will erase all previous content and pages
    // (including Info properties)
    property PDFA: TPdfALevel read fPDFA write SetPDFA;
    {$ifndef USE_PDFALEVEL}
    /// is TRUE if the file was created in order to be PDF/A-1 compliant
    // - set APDFA1 parameter to true for Create constructor in order to use it
    // - warning: setting a value to this propery after creation will call the
    // NewDoc method, therefore will erase all previous content and pages
    // (including Info properties)
    property PDFA1: boolean read GetPDFA1 write SetPDFA1;
    {$endif}
    /// set to TRUE to force PDF 1.5 format, which may produce smaller files
    property GeneratePDF15File: boolean read GetGeneratePDF15File write SetGeneratePDF15File;
  end;

  /// a PDF page
  TPdfPage = class(TPdfDictionary)
  private
    function GetPageLandscape: Boolean;
    procedure SetPageLandscape(const Value: Boolean);
  protected
    fDoc: TPdfDocument;
    FMediaBox: TPdfArray;
    FWordSpace: Single;
    FCharSpace: Single;
    FFontSize: Single;
    FFont: TPdfFont;
    FLeading: Single;
    FHorizontalScaling: Single;
    procedure SetWordSpace(Value: Single);
    procedure SetCharSpace(Value: Single);
    procedure SetFontSize(Value: Single);
    procedure SetHorizontalScaling(Value: Single);
    procedure SetLeading(Value: Single);
    procedure SetPageWidth(AValue: integer); virtual;
    procedure SetPageHeight(AValue: integer); virtual;
    function GetPageWidth: Integer;
    function GetPageHeight: Integer;
    function GetResources(const AName: PDFString): TPdfDictionary; {$ifdef HASINLINE}inline;{$endif}
  public
    /// create the page with its internal VCL Canvas
    constructor Create(ADoc: TPdfDocument); reintroduce; virtual;
    /// calculate width of specified text according to current attributes
    // - this function is compatible with MBCS strings
    function TextWidth(const Text: PDFString): Single;
    /// calculate the number of chars which can be displayed in the specified
    // width, according to current attributes
    // - this function is compatible with MBCS strings, and returns
    // the index in Text, not the glyphs index
    function MeasureText(const Text: PDFString; Width: Single): integer;
  public
    /// retrieve or set the word Space attribute, in PDF coordinates of 1/72 inch
    property WordSpace: Single read FWordSpace write SetWordSpace;
    /// retrieve or set the Char Space attribute, in PDF coordinates of 1/72 inch
    property CharSpace: Single read FCharSpace write SetCharSpace;
    /// retrieve or set the Horizontal Scaling attribute, in PDF coordinates of 1/72 inch
    property HorizontalScaling: Single read FHorizontalScaling write SetHorizontalScaling;
    /// retrieve or set the text Leading attribute, in PDF coordinates of 1/72 inch
    property Leading: Single read FLeading write SetLeading;
    /// retrieve or set the font Size attribute, in system TFont.Size units
    property FontSize: Single read FFontSize write SetFontSize;
    /// retrieve the current used font
    // - for TPdfFontTrueType, this points not always to the WinAnsi version of
    // the Font, but can also point to the Unicode Version, if the last
    // drawn character by ShowText() was unicode - see TPdfWrite.AddUnicodeHexText
    property Font: TPdfFont read FFont write FFont;
    /// retrieve or set the current page width, in PDF coordinates of 1/72 inch
    property PageWidth: integer read GetPageWidth write SetPageWidth;
    /// retrieve or set the current page height, in PDF coordinates of 1/72 inch
    property PageHeight: integer read GetPageHeight write SetPageHeight;
    /// retrieve or set the paper orientation
    property PageLandscape: Boolean read GetPageLandscape write SetPageLandscape;
  end;

  /// is used to define how TMetaFile text positioning is rendered
  // - tpSetTextJustification will handle efficiently the fact that TMetaFileCanvas
  // used SetTextJustification() API calls to justify text: it will converted
  // to SetWordSpace() pdf rendering
  // - tpExactTextCharacterPositining will use the individual glyph positioning
  // information as specified within the TMetaFile content: resulting pdf size
  // will be bigger, but font kerning will be rendered as expected
  // - tpKerningFromAveragePosition will use global font kerning via
  // SetHorizontalScaling() pdf rendering
  TPdfCanvasRenderMetaFileTextPositioning = (
    tpKerningFromAveragePosition, tpSetTextJustification, tpExactTextCharacterPositining);

  /// is used to define how TMetaFile text is clipped
  // - by default, text will be clipped with the specified TEMRText.ptlReference
  // - you could set tcClipExplicit to clip following the specified rclBounds
  // - or tcAlwaysClip to use the current clipping region (if any)
  // - finally, tcNeverClip would disable whole text clipping process, which
  // has been reported to be preferred e.g. on Wine
  TPdfCanvasRenderMetaFileTextClipping = (
    tcClipReference, tcClipExplicit, tcAlwaysClip, tcNeverClip);

  {$ifdef USE_ARC}
  /// is used to define the TMetaFile kind of arc to be drawn
  TPdfCanvasArcType =(
    acArc, acArcTo, acArcAngle, acPie, acChoord);
  {$endif USE_ARC}

  /// access to the PDF Canvas, used to draw on the page
  TPdfCanvas = class(TObject)
  protected
    FContents: TPdfStream;
    FPage: TPdfPage;
    FPageFontList: TPdfDictionary;
    FDoc: TPdfDocument;
    // = 72/FDoc.FScreenLogPixels
    FFactor: single;
    // = ViewSize.cx/WinSize.cx*FFactor
    FFactorX: single;
    // = ViewSize.cy/WinSize.cy*FFactor
    FFactorY: single;
    // = (MulDiv(ViewOrg.x, WinSize.cx, ViewSize.cx) - WinOrg.x)*FFactor
    FOffsetX: single;
    // = FHeight - (MulDiv(ViewOrg.y, WinSize.cy, ViewSize.cy) - WinOrg.y)*FFactor
    FOffsetY: single;
    // = XOff,YOff parameters specified in RenderMetaFile()
    FOffsetXDef, FOffsetYDef: Single;
    // WorldTransform factor and offs
    FWorldFactorX, FWorldFactorY, FWorldOffsetX, FWorldOffsetY, FAngle,
    FWorldCos, FWorldSin: single;
    FDevScaleX, FDevScaleY: single;
    FWinSize, FViewSize: TSize;
    FWinOrg, FViewOrg: TPoint;
    FMappingMode: Integer;
    FEmfBounds: TRect;
    FPrinterPxPerInch: TPoint;
    FNewPath: Boolean;
    {$ifdef USE_UNISCRIBE}
    /// if Uniscribe-related methods must handle the text from right to left
    fRightToLeftText: Boolean;
    {$endif}
    /// parameters taken from RenderMetaFile() call
    fUseMetaFileTextPositioning: TPdfCanvasRenderMetaFileTextPositioning;
    fUseMetaFileTextClipping: TPdfCanvasRenderMetaFileTextClipping;
    fKerningHScaleBottom: Single;
    fKerningHScaleTop: Single;
    // some cache
    FPreviousRasterFontName: RawUTF8;
    FPreviousRasterFontIndex: integer;
    // result := FOffsetX + (X * fFactorX);
    function I2X(X: Integer): Single; overload;
    // result := FOffsetX + (X * fFactorX);
    function I2X(X: Single): Single; overload;
    // result := FOffsetY - Y * fFactorY;
    function I2Y(Y: Integer): Single; overload;
    // result := FOffsetY - Y * fFactorY;
    function I2Y(Y: Single): Single; overload;
    // wrapper call I2X() and I2Y() for conversion
    procedure LineToI(x, y: Integer); overload;
    procedure LineToI(x, y: Single); overload;
    // wrapper call I2X() and I2Y() for conversion
    procedure MoveToI(x, y: Integer); overload;
    procedure MoveToI(x, y: Single); overload;
    // wrapper call I2X() and I2Y() for conversion
    procedure CurveToCI(x1, y1, x2, y2, x3, y3: integer);
    // wrapper call I2X() and I2Y() for conversion
    procedure RoundRectI(x1,y1,x2,y2,cx,cy: integer);
   {$ifdef USE_ARC}
   procedure ARCI(centerx, centery, W, H, Sx, Sy, Ex, Ey: integer;
     clockwise: boolean; arctype: TPdfCanvasArcType; var position: TPoint);
   {$endif USE_ARC}
    // wrapper call I2X() and I2Y() for conversion (points to origin+size)
    function BoxI(Box: TRect; Normalize: boolean): TPdfBox; {$ifdef HASINLINE}inline;{$endif}
    // wrapper call I2X() and I2Y() for conversion
    procedure PointI(x, y: Single); {$ifdef HASINLINE}inline;{$endif}
    function RectI(Rect: TRect; Normalize: boolean): TPdfRect;
    procedure DrawXObjectPrepare(const AXObjectName: PDFString);
    // wrappers about offset calculation
    function ViewOffsetX(X: Single): Single;
    function ViewOffsetY(Y: Single): Single;
    function GetWorldFactorX: Single;
    function GetWorldFactorY: Single;
    property WorldFactorX: Single read GetWorldFactorX write FWorldFactorX;
    property WorldFactorY: Single read GetWorldFactorY write FWorldFactorY;
    // property getters
    function GetDoc: TPdfDocument;    {$ifdef HASINLINE}inline;{$endif}
    function GetPage: TPdfPage;       {$ifdef HASINLINE}inline;{$endif}
  public
    /// create the PDF canvas instance
    constructor Create(APdfDoc: TPdfDocument);

    /// pushes a copy of the entire graphics state onto the stack
    procedure GSave;                                             {  q   }
    /// restores the entire graphics state to its former value by popping
    // it from the stack
    procedure GRestore;                                          {  Q   }
    /// Modify the CTM by concatenating the specified matrix
    // - The current transformation matrix (CTM) maps positions from user
    // coordinates to device coordinates
    // - This matrix is modified by each application of the ConcatToCTM method
    // - CTM Initial value is  a matrix that transforms default user coordinates
    // to device coordinates
    // - since floating-point precision does make sense for a transformation
    // matrix, we added a custom decimal number parameter here
    procedure ConcatToCTM(a, b, c, d, e, f: Single; Decimals: Cardinal=6); {  cm  }

    /// Set the flatness tolerance in the graphics state
    // - see Section 6.5.1, "Flatness Tolerance" of the PDF 1.3 reference:
    // The flatness tolerance controls the maximum permitted distance in
    // device pixels between the mathematically correct path and an
    // approximation constructed from straight line segments
    // - Flatness is a number in the range 0 to 100; a value of 0 specifies
    // the output device's default flatness tolerance
    procedure SetFlat(flatness: Byte);                           {  i   }
    /// Set the line cap style in the graphics state
    // - The line cap style specifies the shape to be used at the
    // ends of open subpaths (and dashes, if any) when they are stroked
    procedure SetLineCap(linecap: TLineCapStyle);                {  J   }
    /// Set the line dash pattern in the graphics state
    // - The line dash pattern controls the pattern of dashes and gaps
    // used to stroke paths. It is specified by a dash array and a dash phase.
    // The dash array's elements are numbers that specify the lengths of
    // alternating dashes and gaps; the dash phase specifies the distance into
    // the dash pattern at which to start the dash. The elements of both the
    // dash array and the dash phase are expressed in user space units.
    // Before beginning to stroke a path, the dash array is cycled through,
    // adding up the lengths of dashes and gaps. When the accumulated length
    // equals the value specified by the dash phase, stroking of the path begins,
    // using the dash array cyclically from that point onward.
    procedure SetDash(const aarray: array of integer; phase: integer=0); {  d   }
    /// Set the line join style in the graphics state
    // - The  line join style specifies the shape to be used at the
    // corners of paths that are stroked
    procedure SetLineJoin(linejoin: TLineJoinStyle);             {  j   }
    /// Set the line width in the graphics state
    // - The line width parameter specifies the thickness of the line used
    // to stroke a path. It is a nonnegative number expressed in user space
    // units; stroking a path entails painting all points whose perpendicular
    // distance from the path in user space is less than or equal to half the
    // line width. The effect produced in device space depends on the current
    // transformation matrix (CTM) in effect at the time the path is stroked.
    // If the CTM specifies scaling by different factors in the x and y
    // dimensions, the thickness of stroked lines in device space will vary
    // according to their orientation. The actual line width achieved can differ
    // from the requested width by as much as 2 device pixels, depending on
    // the positions of lines with respect to the pixel grid.
    procedure SetLineWidth(linewidth: Single);                   {  w   }
    /// Set the miter limit in the graphics state
    // - When two line segments meet at a sharp angle and mitered joins have been
    // specified as the line join style, it is possible for the miter to extend
    // far beyond the thickness of the line stroking the path. The miter limit
    // imposes a maximum on the ratio of the miter length to the line width.
    // When the limit is exceeded, the join is converted from a miter to a bevel
    procedure SetMiterLimit(miterlimit: Single);                 {  M   }

    /// change the current coordinates position
    // - Begin a new subpath by moving the current point to coordinates
    // (x, y), omitting any connecting line segment. If the previous path
    // construction operator in the current path was also MoveTo(), the new MoveTo()
    // overrides it; no vestige of the previous MoveTo() call remains in the path.
    procedure MoveTo(x, y: Single);                              {  m   }
    /// Append a straight line segment from the current point to the point (x, y).
    // -  The new current point is (x, y)
    procedure LineTo(x, y: Single);                              {  l   }
    /// Append a cubic Bezier curve to the current path
    // - The curve extends from the current point to the point (x3, y3),
    // using (x1, y1) and (x2, y2) as the Bezier control points
    // - The new current point is (x3, y3)
    procedure CurveToC(x1, y1, x2, y2, x3, y3: Single);          {  c   }
    /// Append a cubic Bezier curve to the current path
    // - The curve extends from the current point to the point (x3, y3),
    // using the current point and (x2, y2) as the Bezier control points
    // - The new current point is (x3, y3)
    procedure CurveToV(x2, y2, x3, y3: Single);                  {  v   }
    /// Append a cubic Bezier curve to the current path
    // - The curve extends from the current point to the point (x3, y3),
    // using (x1, y1) and (x3, y3) as the Bezier control points
    // - The new current point is (x3, y3)
    procedure CurveToY(x1, y1, x3, y3: Single);                  {  y   }
    /// Append a rectangle to the current path as a complete subpath, with
    // lower-left corner (x, y) and dimensions  width and  height in user space
    procedure Rectangle(x, y, width, height: Single);            {  re  }
    /// Close the current subpath by appending a straight line segment
    // from the current point to the starting point of the subpath
    // - This operator terminates the current subpath; appending another
    // segment to the current path will begin a new subpath, even if the new
    // segment begins at the endpoint reached by the h operation
    // - If the current subpath is already closed or the current path is empty,
    // it does nothing
    procedure Closepath;                                         {  h   }
    /// End the path object without filling or stroking it
    // - This operator is a "path-painting no-op", used primarily for the
    // side effect of changing the clipping path
    procedure NewPath;                                           {  n   }
    /// Stroke the path
    procedure Stroke;                                            {  S   }
    /// Close and stroke the path
    // - This operator has the same effect as the sequence ClosePath; Stroke;
    procedure ClosePathStroke;                                   {  s   }
    /// Fill the path, using the nonzero winding number rule to determine
    // the region to fill
    procedure Fill;                                              {  f   }
    /// Fill the path, using the even-odd rule to determine the region to fill
    procedure EoFill;                                            {  f*  }
    /// Fill and then stroke the path, using the nonzero winding number rule
    // to determine the region to fill
    // - This produces the same result as constructing two identical path
    // objects, painting the first with Fill and the second with Stroke. Note,
    // however, that the filling and stroking portions of the operation consult
    // different values of several graphics state parameters, such as the color
    procedure FillStroke;                                        {  B   }
    /// Close, fill, and then stroke the path, using the nonzero winding number
    // rule to determine the region to fill
    // - This operator has the same effect as the sequence ClosePath; FillStroke;
    procedure ClosepathFillStroke;                               {  b   }
    /// Fill and then stroke the path, using the even-odd rule to determine
    // the region to fill
    // - This operator produces the same result as FillStroke, except that
    // the path is filled as if with Eofill instead of Fill
    procedure EofillStroke;                                      {  B*  }
    /// Close, fill, and then stroke the path, using the even-odd rule to
    // determine the region to fill
    // - This operator has the same effect as the sequence Closepath; EofillStroke;
    procedure ClosepathEofillStroke;                             {  b*  }
    /// Nonzero winding clipping path set
    // - Modify the current clipping path by intersecting it with the current path,
    // using the nonzero winding number rule to determine which regions
    // lie inside the clipping path
    // - The graphics state contains a clipping path that limits the regions of
    // the page affected by painting operators. The closed subpaths of this path
    // define the area that can be painted. Marks falling inside this area will
    // be applied to the page; those falling outside it will not. (Precisely what
    // is considered to be inside a path is discussed under "Filling", above.)
    // - The initial clipping path includes the entire page. Both clipping path
    // methods (Clip and EoClip) may appear after the last path construction operator
    // and before the path-painting operator that terminates a path object.
    // Although the clipping path operator appears before the painting operator,
    // it does not alter the clipping path at the point where it appears. Rather,
    // it modifies the effect of the succeeding painting operator. After the path
    // has been painted, the clipping path in the graphics state is set to the
    // intersection of the current clipping path and the newly constructed path.
    procedure Clip;                                              {  W   }
    /// Even-Odd winding clipping path set
    // - Modify the current clipping path by intersecting it with the current path,
    // using the even-odd rule to determine which regions lie inside the clipping path
    procedure EoClip;                                            {  W*  }

    /// Set the character spacing
    // - CharSpace is a number expressed in unscaled text space units.
    // - Character spacing is used by the ShowText and ShowTextNextLine methods
    // - Default value is 0
    procedure SetCharSpace(charSpace: Single);                   {  Tc  }
    /// Set the word spacing
    // - WordSpace is a number expressed in unscaled text space units
    // - word spacing is used by the ShowText and ShowTextNextLine methods
    // - Default value is 0
    procedure SetWordSpace(wordSpace: Single);                   {  Tw  }
    /// Set the horizontal scaling to (scale/100)
    // - hScaling is a number specifying the percentage of the normal width
    // - Default value is 100 (e.g. normal width)
    procedure SetHorizontalScaling(hScaling: Single);              {  Tz  }
    /// Set the text leading, Tl, to the specified leading value
    // - leading which is a number expressed in unscaled text space units;
    // it specifies the vertical distance between the baselines of adjacent
    // lines of text
    // - Text leading is used only by the MoveToNextLine and ShowTextNextLine methods
    // - you can force the next line to be just below the current one by calling:
    // ! SetLeading(Attributes.FontSize);
    // - Default value is 0
    procedure SetLeading(leading: Single);                       {  TL  }
    /// Set the font, Tf, to  font and the font size, Tfs , to size.
    // - font is the name of a font resource in the Font subdictionary of the
    // current resource dictionary (e.g. 'F0')
    // - size is a number representing a scale factor
    // - There is no default value for either font or size; they must be specified
    // using this method before any text is shown
    procedure SetFontAndSize(const fontshortcut: PDFString; size: Single);    {  Tf  }
      {$ifdef HASINLINE}inline;{$endif}
    /// Set the text rendering mode
    // - the text rendering mode determines whether text is stroked, filled,
    // or used as a clipping path
    procedure SetTextRenderingMode(mode: TTextRenderingMode);    {  Tr  }
    /// Set the text rise, Trise, to the specified value
    // - rise is a number expressed in unscaled text space units, which
    // specifies the distance, in unscaled text space units, to move the
    // baseline up or down from its default location. Positive values of
    // text rise move the baseline up. Adjustments to the baseline are
    // useful for drawing superscripts or subscripts. The default location of
    // the baseline can be restored by setting the text rise to 0.
    // - Default value is 0
    procedure SetTextRise(rise: word);                           {  Ts  }
    /// Begin a text object
    // - Text objects cannot be nested
    procedure BeginText;   {$ifdef HASINLINE}inline;{$endif}     {  BT  }
    /// End a text object, discarding the text matrix
    procedure EndText;     {$ifdef HASINLINE}inline;{$endif}     {  ET  }
    /// Move to the start of the next line, offset from the start of the current
    // line by (tx ,ty)
    // - tx and ty are numbers expressed in unscaled text space units
    procedure MoveTextPoint(tx, ty: Single); {$ifdef HASINLINE}inline;{$endif} {  Td  }
    /// set the Text Matrix to a,b,c,d and the text line Matrix x,y
    procedure SetTextMatrix(a, b, c, d, x, y: Single);           {  Tm  }
    /// Move to the start of the next line
    procedure MoveToNextLine;                                    {  T*  }
    {$ifdef HASVARUSTRING}
    /// Show a text string
    // - text is expected to be Unicode encoded
    // - if NextLine is TRUE, moves to the next line and show a text string;
    // in this case, method as the same effect as MoveToNextLine; ShowText(s);
    procedure ShowText(const text: UnicodeString; NextLine: boolean=false); overload; inline; {  Tj  or ' }
    {$endif}
    /// Show a text string
    // - text is expected to be Ansi-Encoded, in the current CharSet; if
    // some Unicode or MBCS conversion is necessary, it will be notified to the
    // corresponding
    // - if NextLine is TRUE, moves to the next line and show a text string;
    // in this case, method as the same effect as MoveToNextLine; ShowText(s);
    procedure ShowText(const text: PDFString; NextLine: boolean=false); overload; {  Tj  or ' }
    /// Show an Unicode Text string
    // - if NextLine is TRUE, moves to the next line and show a text string;
    // in this case, method as the same effect as MoveToNextLine; ShowText(s);
    procedure ShowText(PW: PWideChar; NextLine: boolean=false); overload;
      {$ifdef HASINLINE}inline;{$endif}
    /// Show an Unicode Text string, encoded as Glyphs or the current font
    // - PW must follow the ETO_GLYPH_INDEX layout, i.e. refers to an array as
    // returned from the GetCharacterPlacement: all glyph indexes are 16-bit values
    procedure ShowGlyph(PW: PWord; Count: integer); {$ifdef HASINLINE}inline;{$endif}
    /// Paint the specified XObject
    procedure ExecuteXObject(const xObject: PDFString);                   {  Do  }

    /// Set the color space to a Device-dependent RGB value
    // - this method set the color to use for nonstroking operations
    procedure SetRGBFillColor(Value: TPdfColor);                 {  rg  }
    /// Set the color space to a Device-dependent RGB value
    // - this method set the color to use for stroking operations
    procedure SetRGBStrokeColor(Value: TPdfColor);               {  RG  }
    /// Set the color space to a CMYK percent value
    // - this method set the color to use for nonstroking operations
    procedure SetCMYKFillColor(C, M, Y, K: integer);                 {  k  }
    /// Set the color space to a CMYK value
    // - this method set the color to use for stroking operations
    procedure SetCMYKStrokeColor(C, M, Y, K: integer);               {  K  }

    /// assign the canvas to the specified page
    procedure SetPage(APage: TPdfPage); virtual;
    /// set the current font for the PDF Canvas
    procedure SetPDFFont(AFont: TPdfFont; ASize: Single);
    /// set the current font for the PDF Canvas
    // - expect the font name to be either a standard embedded font
    // ('Helvetica','Courier','Times') or its Windows equivalency (i.e.
    // 'Arial','Courier New','Times New Roman'), either a UTF-8 encoded
    // True Type font name available on the system
    // - if no CharSet is specified (i.e. if it remains -1), the current document
    // CharSet parameter is used
    function SetFont(const AName: RawUTF8; ASize: Single; AStyle: TPdfFontStyles;
      ACharSet: integer=-1; AForceTTF: integer=-1; AIsFixedWidth: boolean=false): TPdfFont; overload;
    /// set the current font for the PDF Canvas
    // - this method use the Win32 structure that defines the characteristics
    // of the logical font
    function SetFont(ADC: HDC; const ALogFont: TLogFontW; ASize: single): TPdfFont; overload;

    /// show some text at a specified page position
    procedure TextOut(X, Y: Single; const Text: PDFString);
    /// show some unicode text at a specified page position
    procedure TextOutW(X, Y: Single; PW: PWideChar);
    /// show the text in the specified rectangle and alignment
    // - optional clipping can be applied
    procedure TextRect(ARect: TPdfRect; const Text: PDFString;
        Alignment: TPdfAlignment; Clipping: boolean);
    /// show the text in the specified rectangle and alignment
    // - text can be multiline, separated by CR + LF (i.e. #13#10)
    // - text can optionaly word wrap
    // - note: this method only work with embedded fonts by now, not true type
    // fonts (because it use text width measuring)
    procedure MultilineTextRect(ARect: TPdfRect;
        const Text: PDFString; WordWrap: boolean);
    /// draw the specified object (typicaly an image) with stretching
    procedure DrawXObject(X, Y, AWidth, AHeight: Single;
        const AXObjectName: PDFString);
    /// draw the specified object (typicaly an image) with stretching and clipping
    procedure DrawXObjectEx(X, Y, AWidth, AHeight: Single;
        ClipX, ClipY, ClipWidth, ClipHeight: Single; const AXObjectName: PDFString);
    /// draw an ellipse
    // - use Bezier curves internaly to draw the ellipse
    procedure Ellipse(x, y, width, height: Single);
    /// draw a rounded rectangle
    // - use Bezier curves internaly to draw the rounded rectangle
    procedure RoundRect(x1,y1,x2,y2,cx,cy: Single);
    /// calculate width of specified text according to current Canvas attributes
    // - works with MBCS strings
    function TextWidth(const Text: PDFString): Single;
    /// calculate width of specified text according to current Canvas attributes
    // - this function compute the raw width of the specified text, and won't
    // use HorizontalScaling, CharSpace nor WordSpace in its calculation
    function UnicodeTextWidth(PW: PWideChar): Single;
    /// calculate the number of chars which can be displayed in the specified
    // width, according to current attributes
    // - this function is compatible with MBCS strings, and returns
    // the index in Text, not the glyphs index
    // - note: this method only work with embedded fonts by now, not true type
    // fonts (because text width measuring is not yet implemented for them)
    function MeasureText(const Text: PDFString; AWidth: Single): integer;
    /// get the index of the next word in the supplied text
    // - this function is compatible with MBCS strings, and returns
    // the index in Text, not the glyphs index
    function GetNextWord(const S: PDFString; var Index: integer): PDFString;
    {$ifdef USE_METAFILE}
    /// draw a metafile content into the PDF page
    // - not 100% of content is handled yet, but most common are (even
    // metafiles embedded inside metafiles)
    // - UseSetTextJustification is to be set to true to ensure better rendering
    // if the EMF content used SetTextJustification() API call to justify text
    // - KerningHScaleBottom/KerningHScaleTop are limits below which and over
    // which Font Kerning is transformed into PDF Horizontal Scaling commands
    // - TextClipping can be set to fix some issues e.g. when using Wine
    procedure RenderMetaFile(MF: TMetaFile; ScaleX: Single=1.0; ScaleY: Single=0.0;
      XOff: single=0.0; YOff: single=0.0;
      TextPositioning: TPdfCanvasRenderMetaFileTextPositioning=tpSetTextJustification;
      KerningHScaleBottom: single=99.0; KerningHScaleTop: single=101.0;
      TextClipping: TPdfCanvasRenderMetaFileTextClipping=tcAlwaysClip);
    {$endif USE_METAFILE}
    // starts optional content (layer)
    // - Group must be registered with TPdfDocument.CreateOptionalContentGroup
    // - each BeginMarkedContent must have a corresponding EndMarkedContent
    // - nested BeginMarkedContent/EndMarkedContent are possible
    procedure BeginMarkedContent(Group: TPdfOptionalContentGroup);
    // ends optional content (layer)
    procedure EndMarkedContent;
  public
    /// retrieve the current Canvas content stream, i.e. where the PDF
    // commands are to be written to
    property Contents: TPdfStream read FContents;
    /// retrieve the current Canvas Page
    property Page: TPdfPage read GetPage;
    /// retrieve the associated PDF document instance which created this Canvas
    property Doc: TPdfDocument read GetDoc;
{$ifdef USE_UNISCRIBE}
    /// if Uniscribe-related methods must handle the text from right to left
    property RightToLeftText: Boolean read fRightToLeftText write fRightToLeftText;
{$endif}
  end;

  /// common ancestor to all dictionary wrapper classes
  TPdfDictionaryWrapper = class(TPersistent)
  private
    FData: TPdfDictionary;
    function GetHasData: boolean;
  protected
    procedure SetData(AData: TPdfDictionary);
  public
    /// the associated dictionary, containing all data
    property Data: TPdfDictionary read FData write SetData;
    /// return TRUE if has any data stored within
    property HasData: boolean read GetHasData;
  end;

  /// defines the data stored inside a EMR_GDICOMMENT message
  // - pgcOutline can be used to add an outline at the current position (i.e.
  // the last Y parameter of a Move): the text is the associated title, UTF-8 encoded
  // and the outline tree is created from the number of leading spaces in the title
  // - pgcBookmark will create a destination at the current position (i.e.
  // the last Y parameter of a Move), with some text supplied as bookmark name
  // - pgcLink/pgcLinkNoBorder will create a asLink annotation, expecting the data
  // to be filled with TRect inclusive-inclusive bounding rectangle coordinates,
  // followed by the corresponding bookmark name
  // - use the GDIComment*() functions to append the corresponding
  // EMR_GDICOMMENT message to a metafile content
  TPdfGDIComment =
    (pgcOutline, pgcBookmark, pgcLink, pgcLinkNoBorder, pgcJpegDirect);

  /// a dictionary wrapper class for the PDF document information fields
  // - all values use the generic VCL string type, and will be encoded
  // as Unicode if necessary
  TPdfInfo = class(TPdfDictionaryWrapper)
  private
    function GetAuthor: string;
    procedure SetAuthor(const Value: string);
    function GetCreationDate: TDateTime;
    procedure SetCreationDate(Value: TDateTime);
    function GetCreator: string;
    procedure SetCreator(const Value: string);
    function GetKeywords: string;
    procedure SetKeywords(const Value: string);
    function GetSubject: string;
    procedure SetSubject(const Value: string);
    function GetTitle: string;
    procedure SetTitle(const Value: string);
    function GetModDate: TDateTime;
    procedure SetModDate(Value: TDateTime);
  public
    /// the PDF document Author
    property Author: string read GetAuthor write SetAuthor;
    /// the PDF document Creation Date
    property CreationDate: TDateTime read GetCreationDate write SetCreationDate;
    /// the Software or Library name which created this PDF document
    property Creator: string read GetCreator write SetCreator;
    /// the PDF document associated key words
    property Keywords: string read GetKeywords write SetKeywords;
    /// the PDF document modification date
    property ModDate: TDateTime read GetModDate write SetModDate;
    /// the PDF document subject
    property Subject: string read GetSubject write SetSubject;
    /// the PDF document title
    property Title: string read GetTitle write SetTitle;
  end;

  /// a dictionary wrapper class for the PDF document catalog fields
  // - It contains references to other objects defining the document's contents,
  // outline, article threads (PDF 1.1), named destinations, and other attributes.
  // In addition, it contains information about how the document should be displayed
  // on the screen, such as whether its outline and thumbnail page images should be
  // displayed automatically and whether some location other than the first page
  // should be shown when the document is opened
  TPdfCatalog = class(TPdfDictionaryWrapper)
  private
    FOpenAction: TPdfDestination;
    FOwner: TPdfDocument;
    procedure SetPageLayout(Value: TPdfPageLayout);
    procedure SetPageMode(Value: TPdfPageMode);
    procedure SetNonFullScreenPageMode(Value: TPdfPageMode);
    procedure SetViewerPreference(Value: TPdfViewerPreferences);
    procedure SetPages(APages: TPdfDictionary);
    function GetPageLayout: TPdfPageLayout;
    function GetPageMode: TPdfPageMode;
    function GetNonFullScreenPageMode: TPdfPageMode;
    function GetViewerPreference: TPdfViewerPreferences;
    function GetPages: TPdfDictionary;
  protected
    procedure SaveOpenAction;
  public
    /// a Destination to be displayed when the document is opened
    property OpenAction: TPdfDestination read FOpenAction write FOpenAction;
    /// The page layout to be used when the document is opened
    property PageLayout: TPdfPageLayout read GetPageLayout write SetPageLayout;
    /// Page mode determines how the document should appear when opened
    property NonFullScreenPageMode: TPdfPageMode read GetNonFullScreenPageMode write SetNonFullScreenPageMode;
    /// Page mode determines how the document should appear when opened
    property PageMode: TPdfPageMode read GetPageMode write SetPageMode;
    /// A viewer preferences dictionary specifying the way the document is to be
    // displayed on the screen
    // - If this entry is absent, viewer applications should use their own current
    // user preference settings
    property ViewerPreference: TPdfViewerPreferences read GetViewerPreference write SetViewerPreference;
    /// The page tree node that is the root of the document's page tree
    // - Required, must be an indirect reference
    // - you can set a value to it in order to add some nested pages
    property Pages: TPdfDictionary read GetPages write SetPages;
  end;

  /// a generic PDF font object
  TPdfFont = class(TPdfDictionaryWrapper)
  protected
    fName: PDFString;
    fShortCut: PDFString;
    fFirstChar, fLastChar: integer;
    fDefaultWidth: word;
    fAscent, fDescent: integer;
    fUnicode: boolean;
    /// index in TrueTypeFontsIndex[] + 1, 0 if not a TPdfFontTrueType
    // - same TPdfFontTrueType index may appear multiple times in the font list,
    // e.g. with normal, bold and/or italic attributes
    // - this hidden property is used by TPdfDocument for faster font list handling
    fTrueTypeFontsIndex: integer;
    /// contains a bit for every WinAnsi encoded char
    // - encoding in TPdfFont, even if used by TPdfFontWinAnsi descendent only
    fWinAnsiUsed: set of AnsiChar;
  public
    /// create the PDF font object instance
    constructor Create(AXref: TPdfXref; const AName: PDFString);
    /// mark some WinAnsi char as used
    procedure AddUsedWinAnsiChar(aChar: AnsiChar); {$ifdef HASINLINE}inline;{$endif}
    /// retrieve the width of a specified character
    // - implementation of this method is either WinAnsi (by TPdfFontWinAnsi),
    // either compatible with MBCS strings (TPdfFontCIDFontType2)
    // - return 0 by default (descendant must handle the Ansi charset)
    function GetAnsiCharWidth(const AText: PDFString; APos: integer): integer; virtual;
    /// the internal PDF font name (e.g. 'Helvetica-Bold')
    // - postscript font names are inside the unit: these postscript names
    // could not match the "official" True Type font name, stored as
    // UTF-8 in FTrueTypeFonts
    property Name: PDFString read FName;
    /// the internal PDF shortcut (e.g. 'F3')
    property ShortCut: PDFString read FShortCut;
    /// is set to TRUE if the font is dedicated to Unicode Chars
    property Unicode: boolean read fUnicode;
  end;

  PPdfWinAnsiWidth = ^TPdfWinAnsiWidth;
  TPdfWinAnsiWidth = array[#32..#255] of word;

  /// a generic PDF font object, handling at least WinAnsi encoding
  // - TPdfFontTrueType descendent will handle also Unicode chars,
  // for all WideChar which are outside the WinAnsi selection
  TPdfFontWinAnsi = class(TPdfFont)
  protected
    /// contain the Width array of the corresponding WinAnsi encoded char
    fWinAnsiWidth: PPdfWinAnsiWidth;
  public
    /// retrieve the width of a specified character
    // - implementation of this method expect WinAnsi encoding
    // - return the value contained in fWinAnsiWidth[] by default
    function GetAnsiCharWidth(const AText: PDFString; APos: integer): integer; override;
    /// release the used memory
    destructor Destroy; override;
  end;

  /// an embedded WinAnsi-Encoded standard Type 1 font
  // - handle Helvetica, Courier and Times font by now
  TPdfFontType1 = class(TPdfFontWinAnsi)
  protected
  public
    /// create a standard font instance, with a given name and char widths
    // - if WidthArray is nil, it will create a fixed-width font of 600 units
    // - WidthArray[0]=Ascent, WidthArray[1]=Descent, WidthArray[2..]=Width(#32..)
    constructor Create(AXref: TPdfXref; const AName: PDFString;
      WidthArray: PSmallIntArray); reintroduce;
  end;

  /// an embedded Composite CIDFontType2
  // - i.e. a CIDFont whose glyph descriptions are based on TrueType font technology
  // - typicaly handle Japan or Chinese standard fonts
  // - used with MBCS encoding, not WinAnsi
  TPdfFontCIDFontType2 = class(TPdfFont)
    { TODO: implement standard TPdfFontCIDFontType2 MBCS font }
  end;

  /// handle Unicode glyph description for a True Type Font
  // - cf http://www.microsoft.com/typography/OTSPEC/otff.htm#otttables
  // - handle Microsoft cmap format 4 encoding (i.e. most used
  // true type fonts on Windows)
  TPdfTTF = class
  protected
    // we use TWordDynArray for auto garbage collection and generic handling
    // - since the TTF file is big endian, we swap all words at loading, to
    // be used directly by the Intel x86 code; integer (longint) values
    // must take care of this byte swapping
    fcmap,
    fhead,
    fhhea,
    fhmtx: TWordDynArray;
  public
    // these are pointers to the useful data of the True Type Font:
    /// Font header
    head: ^TCmapHEAD;
    /// Horizontal header
    hhea: ^TCmapHHEA;
    /// Character to glyph mapping (cmap) table, in format 4
    fmt4: ^TCmapFmt4;
    /// Start character code for each cmap format 4 segment
    startCode: PWordArray;
    /// End characterCode for each cmap format 4 segment
    endCode: PWordArray;
    /// Delta for all character codes in each cmap format 4 segment
    idDelta: PSmallIntArray;
    /// Offsets into glyphIndexArray or 0
    idRangeOffset: PWordArray;
    /// Glyph index array (arbitrary length)
    glyphIndexArray: PWordArray;
  public
    /// create Unicode glyph description for a supplied True Type Font
    // - the HDC of its corresponding document must have selected the font first
    // - this constructor will fill fUsedWide[] and fUsedWideChar of aUnicodeTTF
    // with every available unicode value, and its corresponding glyph and width
    constructor Create(aUnicodeTTF: TPdfFontTrueType); reintroduce;
  end;

  /// this dynamic array stores details about used unicode characters
  // - every used unicode character has its own width and glyph index in the
  // true type font content
  TUsedWide = array of packed record
      case byte of
      0: (
        Width: word;
        Glyph: word; );
      1: (
        Int: integer; );
    end;

  /// handle TrueType Font
  // - handle both WinAnsi text and Unicode characters in two separate
  // TPdfFontTrueType instances (since PDF need two separate fonts with
  // diverse encoding)
  TPdfFontTrueType = class(TPdfFontWinAnsi)
  private
    function GetWideCharUsed: Boolean; {$ifdef HASINLINE}inline;{$endif}
  protected
    fStyle: TPdfFontStyles;
    fDoc: TPdfDocument;
    // note: fUsedWide[] and fUsedWideChar are used:
    // - in WinAnsi Fonts for glyphs used by ShowText
    // - in Unicode Fonts for all available glyphs from TPdfTTF values
    fUsedWideChar: TSortedWordArray;
    fUsedWide: TUsedWide;
    fHGDI: HGDIOBJ;
    fFixedWidth: boolean;
    fFontDescriptor: TPdfDictionary;
    fFontFile2: TPdfStream;
    fUnicodeFont: TPdfFontTrueType;
    fWinAnsiFont: TPdfFontTrueType;
    fIsSymbolFont: Boolean;
    // below are some bigger structures
    fLogFont: TLogFontW;
    fM: TTextMetric;
    fOTM: TOutlineTextmetric;
    procedure CreateAssociatedUnicodeFont;
    // update font description from used chars
    procedure PrepareForSaving;
    // low level adding of a glyph (returns the real glyph index found, 0 if none)
    function GetAndMarkGlyphAsUsed(aGlyph: word): word;
  public
    /// create the TrueType font object instance
    constructor Create(ADoc: TPdfDocument; AFontIndex: integer;
      AStyle: TPdfFontStyles; const ALogFont: TLogFontW; AWinAnsiFont: TPdfFontTrueType); reintroduce;
    /// release the associated memory and handles
    destructor Destroy; override;
    /// mark some UTF-16 codepoint as used
    // - return the index in fUsedWideChar[] and fUsedWide[]
    // - this index is the one just added, or the existing one if the value
    // was found to be already in the fUserWideChar[] array
    function FindOrAddUsedWideChar(aWideChar: WideChar): integer;
    /// retrieve the width of an UTF-16 codepoint
    // - WinAnsi characters are taken from fWinAnsiWidth[], unicode chars from
    // fUsedWide[].Width
    function GetWideCharWidth(aWideChar: WideChar): Integer;
    /// is set to TRUE if the PDF used any true type encoding
    property WideCharUsed: Boolean read GetWideCharUsed;
    /// the associated Font Styles
    property Style: TPdfFontStyles read fStyle;
    /// is set to TRUE if the font has a fixed width
    property FixedWidth: boolean read fFixedWidth;
    /// points to the corresponding Unicode font
    // - returns NIL if the Unicode font has not yet been created by the
    // CreateUnicodeFont method
    // - may return SELF if the font is itself the Unicode version
    property UnicodeFont: TPdfFontTrueType read fUnicodeFont;
    /// points to the corresponding WinAnsi font
    // - always return a value, whatever it is self
    property WinAnsiFont: TPdfFontTrueType read fWinAnsiFont;
  end;

  /// A destination defines a particular view of a document, consisting of the following:
  // - The page of the document to be displayed
  // - The location of the display window on that page
  // - The zoom factor to use when displaying the page
  TPdfDestination = class(TObject)
  private
    FDoc: TPdfDocument;
    FPage: TPdfPage;
    FType: TPdfDestinationType;
    FValues: array[0..3] of Integer;
    FZoom: Single;
    FReference: TObject;
    procedure SetElement(Index: integer; Value: Integer);
    procedure SetZoom(Value: Single);
    function GetElement(Index: integer): Integer;
    function GetPageWidth: Integer;
    function GetPageHeight: Integer;
  public
    /// create the PDF destination object
    // - the current document page is associated with this destination
    constructor Create(APdfDoc: TPdfDocument);
    /// release the object
    destructor Destroy; override;
    /// retrieve the array containing the location of the display window
    // - the properties values which are not used are ignored
    function GetValue: TPdfArray;
    /// Destination Type determines default user space coordinate system of
    // Explicit destinations
    property DestinationType: TPdfDestinationType read FType write FType;
    /// the associated PDF document which created this Destination object
    property Doc: TPdfDocument read FDoc;
    /// the associated Page
    property Page: TPdfPage read FPage;
    /// retrieve the left coordinate of the location of the display window
    property Left: Integer index 0 read GetElement write SetElement;
    /// retrieve the top coordinate of the location of the display window
    property Top: Integer index 1 read GetElement write SetElement;
    /// retrieve the righ tcoordinate of the location of the display window
    property Right: Integer index 2 read GetElement write SetElement;
    /// retrieve the bottom coordinate of the location of the display window
    property Bottom: Integer index 3 read GetElement write SetElement;
    /// the page height of the current page
    // - return the corresponding MediaBox value
    property PageHeight: Integer read GetPageHeight;
    /// the page width of the current page
    // - return the corresponding MediaBox value
    property PageWidth: Integer read GetPageWidth;
    /// the associated Zoom factor
    // - by default, the Zoom factor is 1
    property Zoom: Single read FZoom write SetZoom;
    /// an object associated to this destination, to be used for conveniance
    property Reference: TObject read FReference write FReference;
  end;

  /// an Outline entry in the PDF document
  TPdfOutlineEntry = class(TPdfDictionaryWrapper)
  private
    FParent: TPdfOutlineEntry;
    FNext: TPdfOutlineEntry;
    FPrev: TPdfOutlineEntry;
    FFirst: TPdfOutlineEntry;
    FLast: TPdfOutlineEntry;
    FDest: TPdfDestination;
    FDoc: TPdfDocument;
    FTitle: string;
    FOpened: boolean;
    FCount: integer;
    FReference: TObject;
    FLevel: integer;
  protected
    procedure Save; virtual;
  public
    /// create the Outline entry instance
    // - if TopPosition is set, a corresponding destination is created
    // on the current PDF Canvas page, at this Y position
    constructor Create(AParent: TPdfOutlineEntry;
      TopPosition: integer=-1); reintroduce;
    /// release the associated memory and reference object
    destructor Destroy; override;
    /// create a new entry in the outline tree
    // - this is the main method to create a new entry
    function AddChild(TopPosition: integer=-1): TPdfOutlineEntry;
    /// the associated PDF document which created this Destination object
    property Doc: TPdfDocument read FDoc;
    /// the parent outline entry of this entry
    property Parent: TPdfOutlineEntry read FParent;
    /// the next outline entry of this entry
    property Next: TPdfOutlineEntry read FNext;
    /// the previous outline entry of this entry
    property Prev: TPdfOutlineEntry read FPrev;
    /// the first outline entry of this entry list
    property First: TPdfOutlineEntry read FFirst;
    /// the last outline entry of this entry list
    property Last: TPdfOutlineEntry read FLast;
    /// the associated destination
    property Dest: TPdfDestination read FDest write FDest;
    /// the associated title
    // - is a generic VCL string, so is Unicode ready
    property Title: string read FTitle write FTitle;
    /// if the outline must be opened
    property Opened: boolean read FOpened write FOpened;
    /// an object associated to this destination, to be used for conveniance
    property Reference: TObject read FReference write FReference;
    /// an internal property (not exported to PDF content)
    property Level: integer read FLevel write FLevel;
  end;

  /// Root entry for all Outlines of the PDF document
  // - this is a "fake" entry which must be used as parent for all true
  // TPdfOutlineEntry instances, but must not be used as a true outline entry
  TPdfOutlineRoot = class(TPdfOutlineEntry)
  public
    /// create the Root entry for all Outlines of the PDF document
    constructor Create(ADoc: TPdfDocument); reintroduce;
    /// update internal parameters (like outline entries count) before saving
    procedure Save; override;
  end;

  {$ifdef USE_METAFILE}
  /// a PDF page, with its corresponding Meta File and Canvas
  TPdfPageGDI = class(TPdfPage)
  private
    // don't use these fVCL* properties directly, but via TPdfDocumentGdi.VCLCanvas
    fVCLMetaFileCompressed: RawByteString;
    fVCLCanvasSize: TSize;
    // it is in fact a TMetaFileCanvas instance from fVCLCurrentMetaFile
    fVCLCurrentCanvas: TCanvas;
    fVCLCurrentMetaFile: TMetaFile;
    // allow to create the meta file and its canvas only if necessary, and
    // compress the page content using SynLZ to reduce memory usage
    procedure CreateVCLCanvas;
    procedure SetVCLCurrentMetaFile;
    procedure FlushVCLCanvas;
  public
    /// release associated memory
    destructor Destroy; override;
  end;

  /// class handling PDF document creation using GDI commands
  // - this class allows using a VCL standard Canvas class
  // - handles also PDF creation directly from TMetaFile content
  TPdfDocumentGDI = class(TPdfDocument)
  private
    fUseMetaFileTextPositioning: TPdfCanvasRenderMetaFileTextPositioning;
    fUseMetaFileTextClipping: TPdfCanvasRenderMetaFileTextClipping;
    fKerningHScaleTop: Single;
    fKerningHScaleBottom: Single;
    function GetVCLCanvas: TCanvas;   {$ifdef HASINLINE}inline;{$endif}
    function GetVCLCanvasSize: TSize; {$ifdef HASINLINE}inline;{$endif}
  public
    /// create the PDF document instance, with a VCL Canvas property
    // - see TPdfDocument.Create connstructor for the arguments expectations
    constructor Create(AUseOutlines: Boolean=false; ACodePage: integer=0;
      {$ifdef USE_PDFALEVEL]}APDFA: TPdfALevel=pdfaNone{$else}APDFA1: boolean=false{$endif}
      {$ifdef USE_PDFSECURITY}; AEncryption: TPdfEncryption=nil{$endif});
    /// add a Page to the current PDF document
    function AddPage: TPdfPage; override;
    /// save the PDF file content into a specified Stream
    // - this overridden method draw first the all VCLCanvas content into the PDF
    procedure SaveToStream(AStream: TStream; ForceModDate: TDateTime=0); override;
    /// save the current page content to the PDF file
    // - this overridden method flush the content from the VCLCanvas into the PDF
    // - it will reduce the used memory as much as possible, by-passing page
    // content compression
    // - typical use may be:
    // ! with TPdfDocumentGDI.Create do
    // !   try
    // !     Stream := TFileStream.Create(FileName, fmCreate);
    // !     try
    // !       SaveToStreamDirectBegin(Stream);
    // !       for i := 1 to 9 do
    // !       begin
    // !         AddPage;
    // !         with VCLCanvas do
    // !         begin
    // !           Font.Name := 'Times new roman';
    // !           Font.Size := 150;
    // !           Font.Style := [fsBold, fsItalic];
    // !           Font.Color := clNavy;
    // !           TextOut(100, 100, 'Page ' + IntToStr(i));
    // !         end;
    // !         SaveToStreamDirectPageFlush; // direct writing
    // !       end;
    // !       SaveToStreamDirectEnd;
    // !     finally
    // !       Stream.Free;
    // !     end;
    // !   finally
    // !     Free;
    // !   end;
    procedure SaveToStreamDirectPageFlush(FlushCurrentPageNow: boolean=false); override;
    /// the VCL Canvas of the current page
    property VCLCanvas: TCanvas read GetVCLCanvas;
    /// the VCL Canvas size of the current page
    // - useful to calculate coordinates for the current page
    // - filled with (0,0) before first call to VCLCanvas property
    property VCLCanvasSize: TSize read GetVCLCanvasSize;
    /// defines how TMetaFile text positioning is rendered
    // - default is tpSetTextJustification
    // - tpSetTextJustification if content used SetTextJustification() API calls
    // - tpExactTextCharacterPositining for exact font kerning, but resulting
    // in bigger pdf size
    // - tpKerningFromAveragePosition will compute average pdf Horizontal Scaling
    // in association with KerningHScaleBottom/KerningHScaleTop properties
    // - replace deprecated property UseSetTextJustification
    property UseMetaFileTextPositioning: TPdfCanvasRenderMetaFileTextPositioning
      read fUseMetaFileTextPositioning write fUseMetaFileTextPositioning;
    /// defines how TMetaFile text clipping should be applied
    // - tcNeverClip has been reported to work better e.g. when app is running
    // on Wine
    property UseMetaFileTextClipping: TPdfCanvasRenderMetaFileTextClipping
      read fUseMetaFileTextClipping write fUseMetaFileTextClipping;
    /// the % limit below which Font Kerning is transformed into PDF Horizontal
    // Scaling commands (when text positioning is tpKerningFromAveragePosition)
    // - set to 99.0 by default
    property KerningHScaleBottom: Single read fKerningHScaleBottom write fKerningHScaleBottom;
    /// the % limit over which Font Kerning is transformed into PDF Horizontal
    // Scaling commands (when text positioning is tpKerningFromAveragePosition)
    // - set to 101.0 by default
    property KerningHScaleTop: Single read fKerningHScaleTop write fKerningHScaleTop;
  end;
  {$endif USE_METAFILE}

  {$ifdef USE_BITMAP}
  /// generic image object
  // - is either bitmap encoded or jpeg encoded
  TPdfImage = class(TPdfXObject)
  private
    fPixelHeight: Integer;
    fPixelWidth: Integer;
    fHash: THash128Rec;
  public
    /// create the image from a supplied VCL TGraphic instance
    // - handle TBitmap and SynGdiPlus picture types, i.e. TJpegImage
    // (stored as jpeg), and TGifImage/TPngImage (stored as bitmap)
    // - use TPdfForm to handle TMetafile in vectorial format
    // - an optional DontAddToFXref is available, if you don't want to add
    // this object to the main XRef list of the PDF file
    constructor Create(aDoc: TPdfDocument; aImage: TGraphic; DontAddToFXref: boolean); reintroduce;
    /// create an image from a supplied JPEG file name
    // - will raise an EFOpenError exception if the file doesn't exist
    // - an optional DontAddToFXref is available, if you don't want to add
    // this object to the main XRef list of the PDF file
    constructor CreateJpegDirect(aDoc: TPdfDocument; const aJpegFileName: TFileName;
      DontAddToFXref: boolean=true); reintroduce; overload;
    /// create an image from a supplied JPEG content
    // - an optional DontAddToFXref is available, if you don't want to add
    // this object to the main XRef list of the PDF file
    constructor CreateJpegDirect(aDoc: TPdfDocument; aJpegFile: TMemoryStream;
      DontAddToFXref: boolean=true); reintroduce; overload;
    /// width of the image, in pixels units
    property PixelWidth: Integer read fPixelWidth;
    /// height of the image, in pixels units
    property PixelHeight: Integer read fPixelHeight;
  end;
  {$endif USE_BITMAP}

  {$ifdef USE_METAFILE}
  /// handle any form XObject
  // - A form XObject (see Section 4.9, of PDF reference 1.3) is a self-contained
  // description of an arbitrary sequence of graphics objects, defined as a
  // PDF content stream
  TPdfForm = class(TPdfXObject)
  private
    FFontList: TPdfDictionary;
  public
    /// create a form XObject from a supplied TMetaFile
    constructor Create(aDoc: TPdfDocumentGDI; aMetaFile: TMetafile); reintroduce;
  end;
  {$endif USE_METAFILE}

  /// a form XObject with a Canvas for drawing
  // - once created, you can create this XObject, then draw it anywhere on
  // any page - see sample
  TPdfFormWithCanvas = class(TPdfXObject)
  private
    FFontList: TPdfDictionary;
    FPage: TPdfPage;
    FCanvas: TPdfCanvas;
  public
    /// create a form XObject with TPDFCanvas
    constructor Create(aDoc: TPdfDocument; W, H: Integer); reintroduce;
    /// release used memory
    destructor Destroy; override;
    /// close the internal canvas
    procedure CloseCanvas;
    /// access to the private canvas associated with the PDF form XObject
    property Canvas: TPdfCanvas read FCanvas;
  end;

  /// used to handle compressed object stream (in PDF 1.5 format)
  TPdfObjectStream = class(TPdfXObject)
  protected
    fObjectCount: integer;
    fAddingStream: TPdfWrite;
    fObject: array of record
      Number: integer;
      Position: integer;
    end;
    procedure InternalWriteTo(W: TPdfWrite); override;
  public
    /// create the instance, i.e. its associated stream
    constructor Create(aDoc: TPdfDocument); reintroduce;
    /// release internal memory structures
    destructor Destroy; override;
    /// add an object to this compressed object stream
    // - returns the object index in this object stream
    function AddObject(Value: TPdfObject): integer;
    /// the number of compressed objects within this object stream
    property ObjectCount: integer read fObjectCount;
  end;


/// this function returns TRUE if the supplied text contain any MBCS character
// - typical call must check first if MBCS is currently enabled
// ! if SysLocale.FarEast and _HasMultiByteString(pointer(Text)) then ...
function _HasMultiByteString(Value: PAnsiChar): boolean;

/// convert a specified UTF-8 content into a PDFString value
function RawUTF8ToPDFString(const Value: RawUTF8): PDFString;

/// convert an unsigned integer into a PDFString text
function UInt32ToPDFString(Value: Cardinal): PDFString;

/// convert a date, into PDF string format, i.e. as 'D:20100414113241Z'
function _DateTimeToPdfDate(ADate: TDateTime): TPdfDate;

/// decode PDF date, encoded as 'D:20100414113241'
function _PdfDateToDateTime(const AText: TPdfDate): TDateTime;

/// wrapper to create a temporary PDF coordinates rectangle
function PdfRect(Left, Top, Right, Bottom: Single): TPdfRect; overload; {$ifdef HASINLINE}inline;{$endif}

/// wrapper to create a temporary PDF coordinates rectangle
function PdfRect(const Box: TPdfBox): TPdfRect; overload; {$ifdef HASINLINE}inline;{$endif}

/// wrapper to create a temporary PDF box
function PdfBox(Left, Top, Width, Height: Single): TPdfBox; {$ifdef HASINLINE}inline;{$endif}

/// reverse char orders for every hebrew and arabic words
// - just reverse all the UTF-16 codepoints in the supplied buffer
procedure L2R(W: PWideChar; L: integer);

/// convert some milli meters dimension to internal PDF twips value
function PdfCoord(MM: single): integer;
  {$ifdef HASINLINE}inline;{$endif}

/// retrieve the paper size used by the current selected printer
function CurrentPrinterPaperSize: TPDFPaperSize;

/// retrieve the current printer resolution
function CurrentPrinterRes: TPoint;

/// append a EMR_GDICOMMENT message for handling PDF bookmarks
// - will create a PDF destination at the current position (i.e. the last Y
// parameter of a Move), with some text supplied as bookmark name
procedure GDICommentBookmark(MetaHandle: HDC; const aBookmarkName: RawUTF8);

/// append a EMR_GDICOMMENT message for handling PDF outline
// - used to add an outline at the current position (i.e. the last Y parameter of
// a Move): the text is the associated title, UTF-8 encoded and the outline tree
// is created from the specified numerical level (0=root)
procedure GDICommentOutline(MetaHandle: HDC; const aTitle: RawUTF8; aLevel: Integer);

/// append a EMR_GDICOMMENT message for creating a Link into a specified bookmark
procedure GDICommentLink(MetaHandle: HDC; const aBookmarkName: RawUTF8; const aRect: TRect;
  NoBorder: boolean);

/// append a EMR_GDICOMMENT message for adding jpeg direct
procedure GDICommentJpegDirect(MetaHandle: HDC; const aFileName: RawUTF8; const aRect: TRect);

{$ifdef USE_PDFSECURITY}
const
  /// allow all actions for a pdf encrypted file
  // - to be used as parameter for TPdfEncryption.New() class method
  PDF_PERMISSION_ALL: TPdfEncryptionPermissions =
    [Low(TPdfEncryptionPermission)..high(TPdfEncryptionPermission)];

  /// disable modification and annotation of a pdf encrypted file
  // - to be used as parameter for TPdfEncryption.New() class method
  PDF_PERMISSION_NOMODIF: TPdfEncryptionPermissions = [epPrinting,
    epContentCopy, epPrintingHighResolution, epFillingForms,
    epContentExtraction, epDocumentAssembly];

  /// disable printing for a pdf encrypted file
  // - to be used as parameter for TPdfEncryption.New() class method
  PDF_PERSMISSION_NOPRINT: TPdfEncryptionPermissions = [epGeneralEditing,
    epContentCopy, epAuthoringComment, epContentExtraction, epDocumentAssembly];

  /// disable content extraction or copy for a pdf encrypted file
  // - to be used as parameter for TPdfEncryption.New() class method
  PDF_PERMISSION_NOCOPY: TPdfEncryptionPermissions = [epPrinting,
    epAuthoringComment, epPrintingHighResolution, epFillingForms];

  /// disable printing and content extraction or copy for a pdf encrypted file
  // - to be used as parameter for TPdfEncryption.New() class method
  PDF_PERMISSION_NOCOPYNORPRINT: TPdfEncryptionPermissions = [];
{$endif USE_PDFSECURITY}


(*
    Windows Uniscribe APIs

    Uniscribe is a set of APIs that allow a high degree of control for fine
    typography and for processing complex scripts
    - see http://msdn.microsoft.com/en-us/library/dd374091(v=VS.85).aspx
    - used by both SynPDF.pas and mORMotReport.pas (for TGDIPages)
    - NO_USE_UNISCRIBE conditional can be set globaly for an application
      which doesn't need the UniScribe features
*)


{$ifdef USE_UNISCRIBE}
const
  Usp10 = 'usp10.dll';
  /// error returned by Uniscribe when the current selected font
  // does not contain sufficient glyphs or shaping tables
  USP_E_SCRIPT_NOT_IN_FONT = HRESULT((SEVERITY_ERROR shl 31) or (FACILITY_ITF shl 16)) or $200;

type
  /// UniScribe script state flag elements
  // - r0,r1,r2,r3,r4: map TScriptState.uBidiLevel
  // - fOverrideDirection: Set when in LRO/RLO embedding
  // - fInhibitSymSwap: Set by U+206A (ISS), cleared by U+206B (ASS)
  // - fCharShape: Set by U+206D (AAFS), cleared by U+206C (IAFS)
  // - fDigitSubstitute: Set by U+206E (NADS), cleared by U+206F (NODS)
  // - fInhibitLigate: Equiv !GCP_Ligate, no Unicode control chars yet
  // - fDisplayZWG: Equiv GCP_DisplayZWG, no Unicode control characters yet
  // - fArabicNumContext: For EN->AN Unicode rule
  // - fGcpClusters: For Generating Backward Compatible GCP Clusters (legacy Apps)
  TScriptState_enum = (
    r0,r1,r2,r3,r4,
    fOverrideDirection, fInhibitSymSwap, fCharShape, fDigitSubstitute,
    fInhibitLigate, fDisplayZWG, fArabicNumContext, fGcpClusters);

  /// a set of UniScribe script state flags
  TScriptState_set = set of TScriptState_enum;

  PScriptState = ^TScriptState;

  /// an UniScribe script state
  // - uBidiLevel: Unicode Bidi algorithm embedding level (0..16)
  // - fFlags: Script state flags
  TScriptState = packed record
   case Byte of
    0: (uBidiLevel: Byte)    {:5};
    1: (fFlags: TScriptState_set)
  end;
  /// Uniscribe script analysis flag elements
  // - s0,s1,s2,s3,s4,s5,s6,s7,s8,s9: map TScriptAnalysis.eScript
  // - fRTL: Rendering direction
  // - fLayoutRTL: Set for GCP classes ARABIC/HEBREW and LOCALNUMBER
  // - fLinkBefore: Implies there was a ZWJ before this item
  // - fLinkAfter: Implies there is a ZWJ following this item.
  // - fLogicalOrder: Set by client as input to ScriptShape/Place
  // - fNoGlyphIndex: Generated by ScriptShape/Place - this item does not use
  // glyph indices
  TScriptAnalysis_enum = (
    s0,s1,s2,s3,s4,s5,s6,s7,s8,s9,
    fRTL, fLayoutRTL, fLinkBefore, fLinkAfter, fLogicalOrder, fNoGlyphIndex);

  /// a set of Uniscribe script analysis flags
  TScriptAnalysis_set = set of TScriptAnalysis_enum;

  PScriptAnalysis = ^TScriptAnalysis;
  /// an Uniscribe script analysis
  // - eScript:  Shaping engine
  // - fFlags: Script analysis flags
  // - s: Script state
  TScriptAnalysis = packed record
   case Byte of
    0: (eScript: Word);
    1: (fFlags: TScriptAnalysis_set;
        s: TScriptState);
  end;
  PScriptItem = ^TScriptItem;
  /// a Uniscribe script item, after analysis of a unicode text
  TScriptItem = packed record
    /// Logical offset to first character in this item
    iCharPos: Integer;
    /// corresponding Uniscribe script analysis
    a: TScriptAnalysis;
  end;

  /// all possible Uniscribe processing properties of a given language
  // - fNumeric:  if a script contains only digits
  // - fComplex: Script requires special shaping or layout
  // - fNeedsWordBreaking: Requires ScriptBreak for word breaking information
  // - fNeedsCaretInfo: Requires caret restriction to cluster boundaries
  // - bCharSet0 .. bCharSet7: Charset to use when creating font
  // - fControl: Contains only control characters
  // - fPrivateUseArea: This item is from the Unicode range U+E000 through U+F8FF
  // - fNeedsCharacterJustify: Requires inter-character justification
  // - fInvalidGlyph: Invalid combinations generate glyph wgInvalid in the glyph buffer
  // - fInvalidLogAttr: Invalid combinations are marked by fInvalid in the logical attributes
  // - fCDM: Contains Combining Diacritical Marks
  // - fAmbiguousCharSet: Script does not correspond 1// :1 with a charset
  // - fClusterSizeVaries: Measured cluster width depends on adjacent clusters
  // - fRejectInvalid: Invalid combinations should be rejected
  TScriptProperties_enum = (
    fNumeric, fComplex, fNeedsWordBreaking, fNeedsCaretInfo,
    bCharSet0, bCharSet1, bCharSet2, bCharSet3, bCharSet4, bCharSet5,
    bCharSet6, bCharSet7,
    fControl, fPrivateUseArea, fNeedsCharacterJustify, fInvalidGlyph,
    fInvalidLogAttr, fCDM, fAmbiguousCharSet, fClusterSizeVaries, fRejectInvalid);

  /// set of possible Uniscribe processing properties of a given language
  TScriptProperties_set = set of TScriptProperties_enum;
  PScriptProperties = ^TScriptProperties;

  /// Contains information about Uniscribe special processing for each script
  TScriptProperties = packed record
    /// Primary and sublanguage associated with script
    langid: Word;
    /// set of possible Uniscribe processing properties for a given language
    fFlags: TScriptProperties_set;
  end;

  PScriptPropertiesArray = ^TPScriptPropertiesArray;
  /// an array of Uniscribe processing information
  TPScriptPropertiesArray = array[byte] of PScriptProperties;

  /// Uniscribe visual (glyph) attributes
  // - a0 .. a3: map the Justification class number
  // - fClusterStart: First glyph of representation of cluster
  // - fDiacritic: Diacritic
  // - fZeroWidth: Blank, ZWJ, ZWNJ etc, with no width
  // - fReserved: General reserved bit
  TScriptVisAttr_enum = (
    a0,a1,a2,a3,
    fClusterStart,     {:1}  // First glyph of representation of cluster
    fDiacritic,        {:1}  // Diacritic
    fZeroWidth,        {:1}  // Blank, ZWJ, ZWNJ etc, with no width
    fReserved          {:1}  // General reserved
  );
  /// set of Uniscribe visual (glyph) attributes
  TScriptVisAttr_set = set of TScriptVisAttr_enum;

  PScriptVisAttr = ^TScriptVisAttr;
  /// Contains the visual (glyph) attributes that identify clusters and
  // justification points, as generated by ScriptShape
  // - uJustification: Justification class
  // - fFlags: Uniscribe visual (glyph) attributes
  // - fShapeReserved: Reserved for use by shaping engines
  TScriptVisAttr = packed record
   case Byte of
    0: (uJustification: Byte) {:4};
    1: (fFlags: TScriptVisAttr_set;
        fShapeReserved: Byte) {:8};
  end;

  TScriptControlAttr_enum = (
    fContextDigits,
    fInvertPreBoundDir,
    fInvertPostBoundDir,
    fLinkStringBefore,
    fLinkStringAfter,
    fNeutralOverride,
    fNumericOverride,
    fLegacyBidiClass,
    fScr0, fScr1, fScr2, fScr3, fScr4, fScr5, fScr6, fScr7);

  TScriptControlAttr_set = set of TScriptControlAttr_enum;

  TScriptControl = packed record
    uDefaultLanguage: Word;
    fFlags: TScriptControlAttr_set;
  end;
  PScriptControl = ^TScriptControl;

/// Uniscribe function to break a Unicode string into individually shapeable items
// - pwcInChars: Pointer to a Unicode string to itemize.
// - cInChars: Number of characters in pwcInChars to itemize.
// - cMaxItems: Maximum number of SCRIPT_ITEM structures defining items to process.
// - psControl: Optional. Pointer to a SCRIPT_CONTROL structure indicating the
// type of itemization to perform. Alternatively, the application can set this
// parameter to NULL if no SCRIPT_CONTROL properties are needed.
// - psState: Optional. Pointer to a SCRIPT_STATE structure indicating
// the initial bidirectional algorithm state. Alternatively, the application
// can set this parameter to NULL if the script state is not needed.
// - pItems: Pointer to a buffer in which the function retrieves SCRIPT_ITEM
// structures representing the items that have been processed. The buffer
// should be cMaxItems*sizeof(SCRIPT_ITEM) + 1 bytes in length. It is invalid
// to call this function with a buffer to hold less than two SCRIPT_ITEM
// structures. The function always adds a terminal item to the item analysis
// array so that the length of the item with zero-based index "i" is
// always available as:
// ! pItems[i+1].iCharPos - pItems[i].iCharPos;
// - pcItems: Pointer to the number of SCRIPT_ITEM structures processed
function ScriptItemize(
    const pwcInChars: PWideChar; cInChars: Integer; cMaxItems: Integer;
    const psControl: pointer; const psState: pointer;
    pItems: PScriptItem; var pcItems: Integer): HRESULT; stdcall; external Usp10;

/// Uniscribe function to retrieve information about the current scripts
// - ppSp: Pointer to an array of pointers to SCRIPT_PROPERTIES structures
// indexed by script.
// - piNumScripts: Pointer to the number of scripts. The valid range for this
// value is 0 through piNumScripts-1.
function ScriptGetProperties(out ppSp: PScriptPropertiesArray;
  out piNumScripts: Integer): HRESULT; stdcall; external Usp10;

/// Uniscribe function to convert an array of run embedding levels to a map
// of visual-to-logical position and/or logical-to-visual position
// - cRuns: Number of runs to process
// - pbLevel: Array of run embedding levels
// - piVisualToLogical: List of run indices in visual order
// - piLogicalToVisual: List of visual run positions
function ScriptLayout(cRuns: Integer; const pbLevel: PByte;
    piVisualToLogical: PInteger; piLogicalToVisual: PInteger): HRESULT; stdcall; external Usp10;

/// Uniscribe function to generate glyphs and visual attributes for an Unicode run
// - hdc: Optional (see under caching)
// - psc: Uniscribe font metric cache handle
// - pwcChars: Logical unicode run
// - cChars: Length of unicode run
// - cMaxGlyphs: Max glyphs to generate
// - psa: Result of ScriptItemize (may have fNoGlyphIndex set)
// - pwOutGlyphs: Output glyph buffer
// - pwLogClust: Logical clusters
// - psva: Visual glyph attributes
// - pcGlyphs: Count of glyphs generated
function ScriptShape(hdc: HDC; var psc: pointer; const pwcChars: PWideChar;
    cChars: Integer; cMaxGlyphs: Integer; psa: PScriptAnalysis;
    pwOutGlyphs: PWord; pwLogClust: PWord; psva: PScriptVisAttr;
    var pcGlyphs: Integer): HRESULT; stdcall; external Usp10;

/// Uniscribe function to apply the specified digit substitution settings
// to the specified script control and script state structures
function ScriptApplyDigitSubstitution(
    const psds: Pointer; const psControl: pointer;
    const psState: pointer): HRESULT; stdcall; external Usp10;

// C++Builder code should #include <usp10.h> directly instead of using these
{$NODEFINE TScriptState }
{$NODEFINE PScriptState }
{$NODEFINE TScriptAnalysis }
{$NODEFINE PScriptAnalysis }
{$NODEFINE TScriptVisAttr }
{$NODEFINE PScriptVisAttr }
{$NODEFINE TScriptItem }
{$NODEFINE PScriptItem }
{$NODEFINE ScriptItemize }
{$NODEFINE ScriptGetProperties }
{$NODEFINE ScriptLayout }
{$NODEFINE ScriptShape }
{$NODEFINE ScriptApplyDigitSubstitution }

{$endif USE_UNISCRIBE}


implementation

const
  // those constants are not defined in earlier Delphi revisions
  cPI: single = 3.141592654;
  cPIdiv180: single = 0.017453292;
  c180divPI: single = 57.29577951;
  c2PI: double = 6.283185307;
  cPIdiv2: double = 1.570796326;

function RGBA(r, g, b, a: cardinal): COLORREF; {$ifdef HASINLINE}inline;{$endif}
begin
  Result := ((r shr 8) or ((g shr 8) shl 8) or ((b shr 8) shl 16) or ((a shr 8) shl 24));
end;

procedure SwapBuffer(P: PWordArray; PLen: Integer);
var i: integer;
begin
  for i := 0 to PLen-1 do
    P^[i] := swap(P^[i]);
end;

function GetTTFData(aDC: HDC; aTableName: PAnsiChar; var Ref: TWordDynArray): pointer;
var L: cardinal;
begin
  result := nil;
  L := GetFontData(aDC,PCardinal(aTableName)^,0,nil,0);
  if L=GDI_ERROR then
    exit;
  SetLength(ref,L shr 1+1);
  if GetFontData(aDC,PCardinal(aTableName)^,0,pointer(ref),L)=GDI_ERROR then
    exit;
  result := pointer(ref);
  SwapBuffer(Result,L shr 1);
end;

function PrinterDriverExists: boolean;
var Flags, Count, NumInfo: dword;
    Level: Byte;
begin
  // avoid using fPrinter.printers.count as this will raise an
  // exception if no printer driver is installed...
  Count := 0;
  Flags := PRINTER_ENUM_CONNECTIONS or PRINTER_ENUM_LOCAL;
  Level := 4;
  EnumPrinters(Flags, nil, Level, nil, 0, Count, NumInfo);
  result := (count > 0);
end;

function ParseFetchedPrinterStr(Str: PChar): PChar;
var
  P: PChar;
begin
  Result := Str;
  if Str=nil then Exit;
  P := Str;
  while P^=' ' do Inc(P);
  Result := P;
  while (P^<>#0) and (P^<>',') do Inc(P);
  if P^=',' then
    P^ := #0;
end;

function CurrentPrinterPaperSize: TPDFPaperSize;
var PtrHdl: THandle;
    PtrPPI: TPoint;
    size: TSize;
    tmp: integer;
    PtrDestSize: TSize;
    DefaultPrinter: array[0..1023] of Char;
    PC: PChar;
begin
  result := psUserDefined;
  if not PrinterDriverExists then
    exit;
  GetProfileString('windows','device',nil,DefaultPrinter,SizeOf(DefaultPrinter)-1);
  PC := ParseFetchedPrinterStr(DefaultPrinter);
  if (PC=nil) or (PC^=#0) then
    exit;
  try
    PtrHdl := CreateDC(nil,PC,nil,nil);
    try
      PtrPPI.x := GetDeviceCaps(PtrHdl, LOGPIXELSX);
      PtrPPI.y := GetDeviceCaps(PtrHdl, LOGPIXELSY);
      PtrDestSize.cx := GetDeviceCaps(PtrHdl, PHYSICALWIDTH);
      PtrDestSize.cy := GetDeviceCaps(PtrHdl, PHYSICALHEIGHT);
      size.cx := mulDiv(PtrDestSize.cx, 254,PtrPPI.x *10);
      size.cy := mulDiv(PtrDestSize.cy, 254,PtrPPI.y *10);
    finally
      DeleteDC(PtrHdl);
    end;
  except
    On Exception do // raised e.g. if no Printer is existing
      exit;
  end;
  with size do begin
    if cx < cy then begin // handle landscape or portrait at once
      tmp := cx;
      cx := cy;
      cy := tmp;
    end;
    case cy of
      148: result := psA5;
      210: result := psA4; // A4 (297 x 210mm)
      216: if cx=279 then
             result := psLetter else
           if cx=356 then
             result := psLegal;
      297: if cx=420 then
             result := psA3;
    end;
  end;
end;

function CurrentPrinterRes: TPoint;
var DefaultPrinter: array[0..1023] of Char;
    PC: PChar;
    PtrHdl: THandle;
begin
  result.X := 300;
  result.Y := 300; // default standard printer resolution
  if not PrinterDriverExists then
    exit;
  GetProfileString('windows','device',nil,DefaultPrinter,SizeOf(DefaultPrinter)-1);
  PC := ParseFetchedPrinterStr(DefaultPrinter);
  if (PC=nil) or (PC^=#0) then
    exit;
  try
    PtrHdl := CreateDC(nil,PC,nil,nil);
    try
      result.x := GetDeviceCaps(PtrHdl, LOGPIXELSX);
      result.y := GetDeviceCaps(PtrHdl, LOGPIXELSY);
    finally
      DeleteDC(PtrHdl);
    end;
  except
    On Exception do // raised e.g. if no Printer is existing
      exit;
  end;
end;

procedure GDICommentBookmark(MetaHandle: HDC; const aBookmarkName: RawUTF8);
var Data: RawByteString;
    D: PAnsiChar;
    L: integer;
begin // high(TPdfGDIComment)<$47 so it will never begin with GDICOMMENT_IDENTIFIER
  L := length(aBookmarkName);
  SetLength(Data,L+1);
  D := pointer(Data);
  D^ := AnsiChar(pgcBookmark);
  MoveFast(pointer(aBookmarkName)^,D[1],L);
  Windows.GdiComment(MetaHandle,L+1,D);
end;

procedure GDICommentOutline(MetaHandle: HDC; const aTitle: RawUTF8; aLevel: Integer);
var Data: RawByteString;
    D: PAnsiChar;
    L: integer;
begin // high(TPdfGDIComment)<$47 so it will never begin with GDICOMMENT_IDENTIFIER
  L := length(aTitle);
  SetLength(Data,L+2);
  D := pointer(Data);
  D[0] := AnsiChar(pgcOutline);
  D[1] := AnsiChar(aLevel);
  MoveFast(pointer(aTitle)^,D[2],L);
  Windows.GdiComment(MetaHandle,L+2,D);
end;

procedure GDICommentLink(MetaHandle: HDC; const aBookmarkName: RawUTF8; const aRect: TRect;
  NoBorder: boolean);
var Data: RawByteString;
    D: PAnsiChar;
    L: integer;
begin // high(TPdfGDIComment)<$47 so it will never begin with GDICOMMENT_IDENTIFIER
  L := length(aBookmarkName);
  SetLength(Data,L+(1+sizeof(TRect)));
  D := pointer(Data);
  if NoBorder then
    D^ := AnsiChar(pgcLinkNoBorder) else
    D^ := AnsiChar(pgcLink);
  PRect(D+1)^ := aRect;
  MoveFast(pointer(aBookmarkName)^,D[1+sizeof(TRect)],L);
  Windows.GdiComment(MetaHandle,L+(1+sizeof(TRect)),D);
end;

procedure GDICommentJpegDirect(MetaHandle: HDC; const aFileName: RawUTF8; const aRect: TRect);
var Data: RawByteString;
    D: PAnsiChar;
    L: integer;
begin // high(TPdfGDIComment)<$47 so it will never begin with GDICOMMENT_IDENTIFIER
  L := length(aFileName);
  SetLength(Data,L+(1+sizeof(TRect)));
  D := pointer(Data);
  D^ := AnsiChar(pgcJpegDirect);
  PRect(D+1)^ := aRect;
  MoveFast(pointer(aFileName)^,D[1+sizeof(TRect)],L);
  Windows.GdiComment(MetaHandle,L+(1+sizeof(TRect)),D);
end;

{$ifndef DELPHI5OROLDER}
// used by TPdfFontTrueType.PrepareForSaving()
function GetTTCIndex(const FontName: RawUTF8; var ttcIndex: Word;
  const FontCount: LongWord): Boolean;
// Looks up ttcIndex from list of font names in known ttc font collections.
// For some locales, the lookup may fail
// Result must not be greater than FontCount-1
const
  // lower-cased Font names for Simpl/Trad Chinese, Japanese, Korean locales
  BATANG_KO = #48148#53461;
  BATANGCHE_KO = BATANG_KO + #52404;
  GUNGSUH_KO = #44417#49436;
  GUNGSUHCHE_KO = GUNGSUH_KO + #52404;
  GULIM_KO = #44404#47548;
  GULIMCHE_KO = GULIM_KO + #52404;
  DOTUM_KO = #46027#50880;
  DOTUMCHE_KO = DOTUM_KO + #52404;
  MINGLIU_CH = #32048#26126#39636;
  PMINGLIU_CH = #26032 + MINGLIU_CH;
  MINGLIU_HK_CH = MINGLIU_CH + '_hkscs';
  MINGLIU_XB_CH = MINGLIU_CH + '-extb';
  PMINGLIU_XB_CH = PMINGLIU_CH + '-extb';
  MINGLIU_XBHK_CH = MINGLIU_CH + '-extb_hkscs';
  MSGOTHIC_JA = #65357#65363#32#12468#12471#12483#12463;
  MSPGOTHIC_JA = #65357#65363#32#65328#12468#12471#12483#12463;
  MSMINCHO_JA = #65357#65363#32#26126#26397;
  MSPMINCHO_JA = #65357#65363#32#65328#26126#26397;
  SIMSUN_CHS = #23435#20307;
  NSIMSUN_CHS = #26032#23435#20307;
var
  lcfn: SynUnicode;
begin
  result := True;
  UTF8ToSynUnicode(fontName,lcfn);
  lcfn := {$ifdef UNICODE}SysUtils.LowerCase{$else}WideLowerCase{$endif}(lcfn);
  // batang.ttc (Korean)
  if (lcfn='batang') or (lcfn=BATANG_KO) then
    ttcIndex := 0 else
  if (lcfn='batangche') or (lcfn=BATANGCHE_KO) then
    ttcIndex := 1 else
  if (lcfn='gungsuh') or (lcfn=GUNGSUH_KO) then
    ttcIndex := 2 else
  if (lcfn='gungsuhche') or (lcfn=GUNGSUHCHE_KO) then
    ttcIndex := 3 else
  // cambria.ttc
  if lcfn='cambria' then
    ttcIndex := 0 else
  if lcfn='cambria math' then
    ttcIndex := 1 else
  // gulim.ttc (Korean)
  if (lcfn='gulim') or (lcfn=GULIM_KO) then
    ttcIndex := 0 else
  if (lcfn='gulimche') or (lcfn=GULIMCHE_KO) then
    ttcIndex := 1 else
  if (lcfn='dotum') or (lcfn=DOTUM_KO) then
    ttcIndex := 2 else
  if (lcfn='dotumche') or (lcfn=DOTUMCHE_KO) then
    ttcIndex := 3 else
  // mingliu.ttc (Traditional Chinese)
  if (lcfn='mingliu') or (lcfn=MINGLIU_CH) then
    ttcIndex := 0 else
  if (lcfn='pmingliu') or (lcfn=PMINGLIU_CH) then
    ttcIndex := 1 else
  if (lcfn='mingliu_hkscs') or (lcfn=MINGLIU_HK_CH) then
    ttcIndex := 2 else
  // mingliub.ttc (Traditional Chinese)
  if (lcfn='mingliu-extb') or (lcfn=MINGLIU_XB_CH) then
    ttcIndex := 0 else
  if (lcfn='pmingliu-extb') or (lcfn=PMINGLIU_XB_CH) then
    ttcIndex := 1 else
  if (lcfn='mingliu_hkscs-extb') or (lcfn=MINGLIU_XBHK_CH) then
    ttcIndex := 2 else
  // msgothic.ttc (Japanese)
  if (lcfn='ms gothic') or (lcfn=MSGOTHIC_JA) then
    ttcIndex := 0 
  else if (lcfn='ms pgothic') or (lcfn=MSPGOTHIC_JA) then
      ttcIndex := 1 else
  if lcfn='ms ui gothic' then
    ttcIndex := 2 else
  // msmincho.ttc (Japanese)
  if (lcfn='ms mincho') or (lcfn=MSMINCHO_JA) then
    ttcIndex := 0 else
  if (lcfn='ms pmincho') or (lcfn=MSPMINCHO_JA) then
    ttcIndex := 1 else
  // simsun.ttc (Simplified Chinese)
  if (lcfn='simsun') or (lcfn=SIMSUN_CHS) then
    ttcIndex := 0 else
  if (lcfn='nsimsun') or (lcfn=NSIMSUN_CHS) then
    ttcIndex := 1 else
    result := False;
  if result and (ttcIndex>(FontCount-1)) then
    result := False;
end;
{$endif DELPHI5OROLDER}


{$ifdef USE_ARC}
type
  tcaRes = (caMoveto, caLine, caCurve, caPosition);
  teaDrawtype = record
    res: tcaRes;
    pts: array[0..2] of record x, y: single;
  end;
  end;
  teaDrawArray = array of teaDrawtype;

function CalcCurveArcData(centerx, centery, W, H, Sx, Sy, Ex, Ey: integer;
  aClockWise: boolean; arctype: TPdfCanvasArcType; out res: teaDrawArray): boolean;
type
  TCoeff = array[0..3] of double;
  TCoeffArray = array[0..1, 0..3] of TCoeff;
const
  // coefficients for error estimation
  // while using cubic Bezier curves for approximation
  // 0 < b/a < 1/4
  coeffsLow: TCoeffArray = (
  ((3.85268, -21.229, -0.330434, 0.0127842),
   (-1.61486, 0.706564, 0.225945, 0.263682),
   (-0.910164, 0.388383, 0.00551445, 0.00671814),
   (-0.630184, 0.192402, 0.0098871, 0.0102527)),
  ((-0.162211, 9.94329, 0.13723, 0.0124084),
   (-0.253135, 0.00187735, 0.0230286, 0.01264),
   (-0.0695069, -0.0437594, 0.0120636, 0.0163087),
   (-0.0328856, -0.00926032, -0.00173573, 0.00527385)));
  // coefficients for error estimation
  // while using cubic Bezier curves for approximation
  // 1/4 <= b/a <= 1
  coeffsHigh: TCoeffArray = (
  ((0.0899116, -19.2349, -4.11711, 0.183362),
   (0.138148, -1.45804, 1.32044, 1.38474),
   (0.230903, -0.450262, 0.219963, 0.414038),
   (0.0590565, -0.101062, 0.0430592, 0.0204699)),
  ((0.0164649, 9.89394, 0.0919496, 0.00760802),
   (0.0191603, -0.0322058, 0.0134667, -0.0825018),
   (0.0156192, -0.017535, 0.00326508, -0.228157),
   (-0.0236752, 0.0405821, -0.0173086, 0.176187)));
  // safety factor to convert the "best" error approximation
  // into a "max bound" error
  safety: TCoeff = (0.001, 4.98, 0.207, 0.0067);

var fcx, fcy: double; //  center of the ellipse
    faRad, fbRad: double; // Semi-major axis
    feta1, feta2: double; //  Start End angle of the arc
    fx1, fy1, fx2, fy2: double;  //start and and endpoint
    fxLeft, fyUp: double;  // leftmost point of the arc
    fwidth, fheight: double; //   Horizontal width of the arc Vertical height of the arc
    fArctype: TPdfCanvasArcType;  //Indicator for center to endpoints line inclusion
    fClockWise : boolean;

procedure InitFuncData;
var lambda1, lambda2 : double;
begin
  fcx := centerx;
  fcy := centery;
  faRad := (W-1) / 2;
  fbRad := (H-1) / 2;
  fArctype := arctype;
  // Calculate Rotation at Start and EndPoint
  fClockWise := aClockWise;
  if aclockwise then begin
    lambda1 := ArcTan2(Sy - fcy, Sx - fcx);
    lambda2 := ArcTan2(Ey - fcy, Ex - fcx);
  end else begin
    lambda2 := ArcTan2(Sy - fcy, Sx - fcx);
    lambda1 := ArcTan2(Ey - fcy, Ex - fcx);
  end;
  feta1 := ArcTan2(sin(lambda1) / fbRad, cos(lambda1) / faRad);
  feta2 := ArcTan2(sin(lambda2) / fbRad, cos(lambda2) / faRad);
  // make sure we have eta1 <= eta2 <= eta1 + 2 PI
  feta2 := feta2 - (c2PI * floor((feta2 - feta1) / c2PI));
  // the preceding correction fails if we have exactly et2 - eta1 = 2 PI
  // it reduces the interval to zero length
  if SameValue(feta1, feta2) then
    feta2 := feta2 + c2PI;
  // start point
  fx1 := fcx + (faRad * cos(feta1));
  fy1 := fcy + (fbRad * sin(feta1));
  // end point
  fx2 := fcx + (faRad * cos(feta2));
  fy2 := fcy + (fbRad * sin(feta2));
  // Dimensions
  fxLeft := min(fx1, fx2);
  fyUp := min(fy1, fy2);
  fwidth := max(fx1, fx2) - fxLeft;
  fheight := max(fy1, fy2) - fyUp;
end;

function estimateError(etaA, etaB: double): double;
var coeffs: ^TCoeffArray;
    c0, c1, cos2, cos4, cos6, dEta, eta, x: double;

  function rationalFunction(x: double; const c: TCoeff): double;
  begin
    result := (x * (x * c[0] + c[1]) + c[2]) / (x + c[3]);
  end;

begin
  eta := 0.5 * (etaA + etaB);
  x := fbRad / faRad;
  dEta := etaB - etaA;
  cos2 := cos(2 * eta);
  cos4 := cos(4 * eta);
  cos6 := cos(6 * eta);
  // select the right coeficients set according to degree and b/a
  if x < 0.25 then
    coeffs := @coeffsLow else
    coeffs := @coeffsHigh;
  c0 := rationalFunction(x, coeffs[0][0]) +
    cos2 * rationalFunction(x, coeffs[0][1]) +
    cos4 * rationalFunction(x, coeffs[0][2]) +
    cos6 * rationalFunction(x, coeffs[0][3]);
  c1 := rationalFunction(x, coeffs[1][0]) +
    cos2 * rationalFunction(x, coeffs[1][1]) +
    cos4 * rationalFunction(x, coeffs[1][2]) +
    cos6 * rationalFunction(x, coeffs[1][3]);
  result := rationalFunction(x, safety) * faRad * exp(c0 + c1 * dEta);
end;

procedure BuildPathIterator;
var alpha: double;
    found: Boolean;
    n: integer;
    dEta, etaB, etaA: double;
    cosEtaB, sinEtaB, aCosEtaB, bSinEtaB, aSinEtaB, bCosEtaB, xB, yB, xBDot, yBDot: double;
    i: integer;
    t, xA, xADot, yA, yADot: double;
    ressize: integer; // Index var for result Array
    r: ^teaDrawtype;
    lstartx, lstarty : double;  // Start from
const
  defaultFlatness = 0.5; // half a pixel
begin
  // find the number of Bezier curves needed
  found := false;
  n := 1;
  while (not found) and (n < 1024) do begin
    dEta := (feta2 - feta1) / n;
    if dEta <= cPIdiv2 then begin
      etaB := feta1;
      found := true;
      for i := 0 to n - 1 do begin
        etaA := etaB;
        etaB := etaB + dEta;
        found := (estimateError(etaA, etaB) <= defaultFlatness);
        if not found then
          break;
      end;
    end;
    // if not found then
    n := n shl 1;
  end;
  dEta := (feta2 - feta1) / n;
  etaB := feta1;
  cosEtaB := cos(etaB);
  sinEtaB := sin(etaB);
  aCosEtaB := faRad * cosEtaB;
  bSinEtaB := fbRad * sinEtaB;
  aSinEtaB := faRad * sinEtaB;
  bCosEtaB := fbRad * cosEtaB;
  xB := fcx + aCosEtaB;
  yB := fcy + bSinEtaB;
  xBDot := -aSinEtaB;
  yBDot := +bCosEtaB;
  lstartx := xB;
  lstarty := yB;
  // calculate and reserve Space for the result
  ressize := n;
  case fArctype of
    acArc :     inc(ressize,1); // first move
    acArcTo:    inc(ressize,3); // first line and move
    acArcAngle: inc(ressize,1); // first move
    acPie:      inc(ressize,3); // first and last Line
    acChoord:   inc(ressize,2);
  end;
  SetLength(res, ressize);
  r := pointer(res);
  case fArctype of
    acArc: begin   // start with move
      r^.res := caMoveto;
      r^.pts[0].x := xB;
      r^.pts[0].y := yB;
      inc(r);
    end;
    acArcTo : begin   // start with line and move
      r^.res := caLine;
      if fClockwise then  begin
        r^.pts[0].x := fx1;
        r^.pts[0].y := fy1;
      end else begin
        r^.pts[0].x := fx2;
        r^.pts[0].y := fy2;
      end;
      inc(r);
      r^.res := caMoveto;
      r^.pts[0].x := fx1;
      r^.pts[0].y := fy1;
      inc(r);
    end;
    acArcAngle: ;
    acPie : begin
     r^.res := caMoveto;
     r^.pts[0].x := fcx;
     r^.pts[0].y := fcy;
     inc(r);
     r^.res := caLine;
     r^.pts[0].x := xB;
     r^.pts[0].y := yB;
     inc(r);
    end;
    acChoord : begin
     r^.res := caMoveto;
     r^.pts[0].x := xB;
     r^.pts[0].y := yB;
     inc(r);
    end;
  end;
  t := tan(0.5 * dEta);
  alpha := sin(dEta) * (sqrt(4 + 3 * t * t) - 1) / 3;
  for i := 0 to n - 1 do begin
    xA := xB;
    yA := yB;
    xADot := xBDot;
    yADot := yBDot;
    etaB := etaB + dEta;
    cosEtaB := cos(etaB);
    sinEtaB := sin(etaB);
    aCosEtaB := faRad * cosEtaB;
    bSinEtaB := fbRad * sinEtaB;
    aSinEtaB := faRad * sinEtaB;
    bCosEtaB := fbRad * cosEtaB;
    xB := fcx + aCosEtaB;
    yB := fcy + bSinEtaB;
    xBDot := -aSinEtaB;
    yBDot := bCosEtaB;
    r^.res := caCurve;
    r^.pts[0].x := xA + alpha * xADot;
    r^.pts[0].y := yA + alpha * yADot;
    r^.pts[1].x := xB - alpha * xBDot;
    r^.pts[1].y := yB - alpha * yBDot;
    r^.pts[2].x := xB;
    r^.pts[2].y := yB;
    inc(r);
  end; // Loop
  case fArctype of
  acArcTo: begin
    r^.res := caPosition;
    if fClockWise then begin
     r^.pts[0].x := fx2;
     r^.pts[0].y := fy2;
    end else begin
     r^.pts[0].x := fx1;
     r^.pts[0].y := fy1;
    end
  end;
  acPie: begin
    r^.res := caLine;
    r^.pts[0].x := fcx;
    r^.pts[0].y := fcy;
  end;
  acChoord: begin
    r^.res := caLine;
    r^.pts[0].x := lstartx;
    r^.pts[0].y := lstarty;
  end;
  end;
end;

begin
  res := nil;
  InitFuncData;  // Initialize Data
  buildPathIterator;
  result := length(res) > 1;
end;

{$endif USE_ARC}

{ TPdfObject }

constructor TPdfObject.Create;
begin
  FObjectNumber := -1;
end;

procedure TPdfObject.ForceSaveNow;
begin
  FSaveAtTheEnd := False;
end;

procedure TPdfObject.InternalWriteTo(W: TPdfWrite);
begin
{$ifdef USE_PDFSECURITY}
  if FObjectNumber>0 then
    with W.fDoc do begin
      fCurrentObjectNumber := FObjectNumber;
      fCurrentGenerationNumber := FGenerationNumber;
    end;
{$endif USE_PDFSECURITY}
end;

procedure TPdfObject.SetObjectNumber(Value: integer);
begin
  FObjectNumber := Value;
  if Value > 0 then
    FObjectType := otIndirectObject else
    FObjectType := otDirectObject;
end;

function TPdfObject.SpaceNotNeeded: boolean;
begin
  result := false;
end;

procedure TPdfObject.WriteTo(var W: TPdfWrite);
begin
  if FObjectType=otDirectObject then
    InternalWriteTo(W) else
    W.AddWithSpace(FObjectNumber).AddWithSpace(FGenerationNumber).Add('R');
end;

procedure TPdfObject.WriteValueTo(var W: TPdfWrite);
begin
  if FObjectType<>otIndirectObject then
    raise EPdfInvalidOperation.Create('WriteValueTo');
  W.AddWithSpace(FObjectNumber).AddWithSpace(FGenerationNumber).Add('obj'+CRLF);
  InternalWriteTo(W);
  W.Add(CRLF+'endobj'#10);
end;


{ PdfVirtualObject }

constructor TPdfVirtualObject.Create(AObjectId: integer);
begin
  inherited Create;
  FObjectNumber := AObjectId;
  FObjectType := otVirtualObject;
end;


{ TPdfNull }

procedure TPdfNull.InternalWriteTo(W: TPdfWrite);
begin
  W.Add('null');
end;


{ TPdfBoolean }

procedure TPdfBoolean.InternalWriteTo(W: TPdfWrite);
begin
  W.Add(BOOL_UTF8[Value]);
end;

constructor TPdfBoolean.Create(AValue: Boolean);
begin
  inherited Create;
  Value := AValue;
end;


{ TPdfNumber }

procedure TPdfNumber.InternalWriteTo(W: TPdfWrite);
begin
  W.Add(FValue);
end;

constructor TPdfNumber.Create(AValue: integer);
begin
  inherited Create;
  Value := AValue;
end;


{ TPdfReal }

procedure TPdfReal.InternalWriteTo(W: TPdfWrite);
begin
  W.Add(Value);
end;

constructor TPdfReal.Create(AValue: double);
begin
  inherited Create;
  Value := AValue;
end;


{ TPdfText }

procedure TPdfText.InternalWriteTo(W: TPdfWrite);
begin
  // if the value has multibyte character, convert the value to hex unicode.
  // otherwise, escape characters.
  if SysLocale.FarEast and _HasMultiByteString(pointer(FValue)) then
    W.Add('<FEFF').AddToUnicodeHex(FValue).Add('>') else
    W.Add('(').AddEscapeContent(FValue).Add(')');
end;

constructor TPdfText.Create(const AValue: RawByteString);
begin
  inherited Create;
  Value := AValue;
end;

function TPdfText.SpaceNotNeeded: boolean;
begin
  result := True;
end;


{ TPdfTextUTF8 }

constructor TPdfTextUTF8.Create(const AValue: RawUTF8);
begin
  inherited Create;
  Value := AValue;
end;

procedure TPdfTextUTF8.InternalWriteTo(W: TPdfWrite);
var Len: Integer;
begin
  // if the value has multibyte character, convert the value to hex unicode.
  // otherwise, escape characters
  if IsWinAnsiU8Bit(Pointer(FValue)) then
    W.Add('(').AddEscapeContent(Utf8ToWinAnsi(FValue)).Add(')') else
    W.Add('<FEFF').AddUnicodeHex(
      Pointer(Utf8DecodeToRawUnicodeUI(FValue,@Len)),Len shr 1).Add('>');
end;

function TPdfTextUTF8.SpaceNotNeeded: boolean;
begin
  result := True;
end;


{ TPdfTextString }

constructor TPdfTextString.Create(const AValue: string);
begin
  inherited Create(StringToUTF8(AValue));
end;

function TPdfTextString.GetValue: string;
begin
  result := UTF8ToString(FValue);
end;

procedure TPdfTextString.SetValue(const Value: string);
begin
  FValue := StringToUTF8(Value);
end;


{ TPdfRawText }

procedure TPdfRawText.InternalWriteTo(W: TPdfWrite);
begin
  W.Add(FValue);
end;

function TPdfRawText.SpaceNotNeeded: boolean;
begin
  result := false;
end;


{ TPdfClearText }

constructor TPdfClearText.Create(Buffer: pointer; Len: integer);
var tmp: RawByteString;
begin
  SetString(tmp,PAnsiChar(Buffer),Len);
  inherited Create(tmp);
end;

procedure TPdfClearText.InternalWriteTo(W: TPdfWrite);
begin
  W.Add('(').AddEscape(pointer(FValue),Length(FValue)).Add(')');
end;


{ TPdfName }

procedure TPdfName.InternalWriteTo(W: TPdfWrite);
begin
  W.Add('/').AddEscapeName(pointer(FValue));
end;

function TPdfName.AppendPrefix: RawUtf8;
var prefix: RawUtf8;
    c: cardinal;
    i: PtrInt;
begin
  if self=nil then
    exit;
  SetLength(prefix, 7);
  c := Random32; // we will consume only 24-bit of randomness
  for i := 1 to 6 do
  begin
    prefix[i] := AnsiChar((c and 15) + 65);
    c := c shr 4;
  end;
  prefix[7] := '+';
  FValue := prefix+FValue; // we ensured a single subset per font
  result := FValue;
end;


{ TPdfArray }

function TPdfArray.GetItems(Index: integer): TPdfObject;
begin
  result := TPdfObject(FArray[Index]);
  if result.ObjectType=otVirtualObject then
    if FObjectMgr<>nil then
      result := FObjectMgr.GetObject(result.ObjectNumber) else
      result := nil;
end;

function TPdfArray.GetItemCount: integer;
begin
  if self=nil then
    Result := 0 else
    Result := FArray.Count;
end;

procedure TPdfArray.InternalWriteTo(W: TPdfWrite);
var i: integer;
begin
  inherited;
  W.Add('[');
  for i := 0 to FArray.Count-1 do
  with TPdfObject(FArray.List[i]) do begin
    if (i<>0) and not SpaceNotNeeded then
      W.Add(' ');
    WriteTo(W);
  end;
  W.Add(']');
end;

constructor TPdfArray.Create(AObjectMgr: TPdfObjectMgr);
begin
  inherited Create;
  FArray := TList.Create;
  FObjectMgr := AObjectMgr;
end;

constructor TPdfArray.Create(AObjectMgr: TPdfObjectMgr;
  const AArray: array of Integer);
var i: integer;
begin
  Create(AObjectMgr);
  for i := 0 to High(AArray) do
    AddItem(TPdfNumber.Create(AArray[i]));
end;

constructor TPdfArray.Create(AObjectMgr: TPdfObjectMgr;
  AArray: PWordArray; AArrayCount: integer);
var i: integer;
begin
  Create(AObjectMgr);
  for i := 0 to AArrayCount-1 do
    AddItem(TPdfNumber.Create(AArray^[i]));
end;

constructor TPdfArray.CreateNames(AObjectMgr: TPdfObjectMgr;
  const AArray: array of PDFString);
var i: integer;
begin
  Create(AObjectMgr);
  for i := 0 to high(AArray) do
    AddItem(TPdfName.Create(AArray[i]));
end;

constructor TPdfArray.CreateReals(AObjectMgr: TPdfObjectMgr;
  const AArray: array of double);
var i: integer;
begin
  Create(AObjectMgr);
  for i := 0 to high(AArray) do
    AddItem(TPdfReal.Create(AArray[i]));
end;

destructor TPdfArray.Destroy;
var i: integer;
begin
  for i := 0 to FArray.Count-1 do
    TPdfObject(FArray.List[i]).Free;
  FArray.Free;
  inherited;
end;

function TPdfArray.AddItem(AItem: TPdfObject): integer;
begin
  result := FArray.IndexOf(AItem);
  if result>=0 then
    exit; // if AItem already exists, do nothing
  if AItem.ObjectType=otDirectObject then
    result := FArray.Add(AItem) else
    result := FArray.Add(TPdfVirtualObject.Create(AItem.ObjectNumber))
end;

procedure TPdfArray.InsertItem(Index: Integer; AItem: TPdfObject);
begin
  if FArray.IndexOf(AItem)>=0 then
    exit; // if AItem already exists, do nothing
  if AItem.ObjectType=otDirectObject then
    FArray.Insert(Index, AItem) else
    FArray.Insert(Index, TPdfVirtualObject.Create(AItem.ObjectNumber))
end;

function TPdfArray.FindName(const AName: PDFString): TPdfName;
var i: integer;
begin
  for i := 0 to ItemCount-1 do begin
    result := TPdfName(FArray.List[i]);
    if (result<>nil) and result.InheritsFrom(TPdfName) and
       (result.Value=AName) then
      Exit;
  end;
  result := nil;
end;

function TPdfArray.RemoveName(const AName: PDFString): boolean;
var AObject: TPdfObject;
begin
  result := false;
  AObject := FindName(AName);
  if AObject<>nil then begin
    FArray.Remove(AObject);
    if AObject.ObjectType=otDirectObject then
      AObject.Free;
    result := true;
  end;
end;

function TPdfArray.SpaceNotNeeded: boolean;
begin
  result := True;
end;


{ TPdfDictionaryElement }

function TPdfDictionaryElement.GetKey: PDFString;
begin
  if self=nil then
    result := '' else
    result := FKey.Value;
end;

constructor TPdfDictionaryElement.Create(const AKey: PDFString; AValue: TPdfObject;
  AInternal: Boolean);
begin
  if not (AValue is TPdfObject) then
    raise EPdfInvalidValue.Create('TPdfDictionaryElement');
  FKey := TPdfName.Create(AKey);
  FValue := AValue;
  FIsInternal := AInternal;
end;

destructor TPdfDictionaryElement.Destroy;
begin
  FKey.Free;
  FValue.Free;
  inherited;
end;


{ TPdfDictionary }

function TPdfDictionary.GetItems(Index: integer): TPdfDictionaryElement;
begin
  result := TPdfDictionaryElement(FArray[Index]);
end;

function TPdfDictionary.GetItemCount: integer;
begin
  if self=nil then
    Result := 0 else
    Result := FArray.Count;
end;

procedure TPdfDictionary.DirectWriteto(W: TPdfWrite; Secondary: TPdfDictionary);
procedure WriteArray(aArray: TList);
var i: integer;
    Element: TPdfDictionaryElement;
begin
  for i := 0 to aArray.Count-1 do begin
    Element := aArray.List[i];
    if not Element.IsInternal then begin
      Element.FKey.WriteTo(W);
      if not Element.FValue.SpaceNotNeeded then
        W.Add(' ');
      Element.FValue.WriteTo(W);
    end;
  end;
end;
begin
  inherited InternalWriteTo(W);
  W.Add('<<');
  WriteArray(FArray);
  if Secondary<>nil then
    WriteArray(Secondary.FArray);
  W.Add('>>');
end;

procedure TPdfDictionary.InternalWriteTo(W: TPdfWrite);
begin
  DirectWriteto(W,nil);
end;

constructor TPdfDictionary.Create(AObjectMgr: TPdfObjectMgr);
begin
  inherited Create;
  FArray := TList.Create;
  FObjectMgr := AObjectMgr;
end;

destructor TPdfDictionary.Destroy;
var i: integer;
begin
  for i := 0 to FArray.Count-1 do
    TPdfDictionaryElement(FArray[i]).Free;
  FArray.Free;
  inherited;
end;

function TPdfDictionary.ValueByName(const AKey: PDFString): TPdfObject;
var i: integer;
begin
  if self<>nil then
  for i := 0 to FArray.Count-1 do
  with TPdfDictionaryElement(FArray.List[i]) do
    if FKey.Value=AKey then begin
      result := Value;
      if result.ObjectType=otVirtualObject then
        if FObjectMgr<>nil then
          result := FObjectMgr.GetObject(result.ObjectNumber) else
          result := nil;
      exit;
    end;
  result := nil;
end;

function TPdfDictionary.PdfNumberByName(const AKey: PDFString): TPdfNumber;
begin
  result := TPdfNumber(ValueByName(AKey));
end;

function TPdfDictionary.PdfTextByName(const AKey: PDFString): TPdfText;
begin
  result := TPdfText(ValueByName(AKey));
end;

function TPdfDictionary.PdfTextValueByName(const AKey: PDFString): PDFString;
var P: TPdfText;
begin
  P := TPdfText(ValueByName(AKey));
  if P=nil then
    result := '' else
    result := P.Value;
end;

function TPdfDictionary.PdfTextStringValueByName(const AKey: PDFString): string;
var P: TPdfTextString;
begin
  P := TPdfTextString(ValueByName(AKey));
  if P=nil then
    result := '' else
    result := P.Value;
end;

function TPdfDictionary.PdfTextUTF8ValueByName(const AKey: PDFString): RawUTF8;
var P: TPdfTextUTF8;
begin
  P := TPdfTextUTF8(ValueByName(AKey));
  if P=nil then
    result := '' else
    result := P.Value;
end;

function TPdfDictionary.PdfRealByName(const AKey: PDFString): TPdfReal;
begin
  result := TPdfReal(ValueByName(AKey));
end;

function TPdfDictionary.PdfNameByName(const AKey: PDFString): TPdfName;
begin
  result := TPdfName(ValueByName(AKey));
end;

function TPdfDictionary.PdfDictionaryByName(const AKey: PDFString): TPdfDictionary;
begin
  result := TPdfDictionary(ValueByName(AKey));
end;

function TPdfDictionary.PdfArrayByName(const AKey: PDFString): TPdfArray;
begin
  result := TPdfArray(ValueByName(AKey));
end;

function TPdfDictionary.PdfBooleanByName(const AKey: PDFString): TPdfBoolean;
begin
  result := TPdfBoolean(ValueByName(AKey));
end;

procedure TPdfDictionary.AddItem(const AKey: PDFString; AValue: TPdfObject;
  AInternal: Boolean);
var FItem: TPdfDictionaryElement;
begin
  if self=nil then
    exit;
  RemoveItem(AKey);
  if AValue.ObjectType=otDirectObject then
    FItem := TPdfDictionaryElement.Create(AKey, AValue, AInternal) else
    FItem := TPdfDictionaryElement.Create(AKey,
      TPdfVirtualObject.Create(AValue.ObjectNumber), AInternal);
  FArray.Add(FItem);
end;

procedure TPdfDictionary.AddItem(const AKey, AValue: PDFString);
begin
  AddItem(AKey,TPdfName.Create(AValue));
end;

procedure TPdfDictionary.AddItem(const AKey: PDFString; AValue: integer);
begin
  AddItem(AKey,TPdfNumber.Create(AValue));
end;

procedure TPdfDictionary.AddItemText(const AKey, AValue: PDFString);
begin
  AddItem(AKey,TPdfText.Create(AValue));
end;

procedure TPdfDictionary.AddItemTextUTF8(const AKey: PDFString; const AValue: RawUTF8);
begin
  AddItem(AKey,TPdfTextUTF8.Create(AValue));
end;

procedure TPdfDictionary.AddItemTextString(const AKey: PDFString;
  const AValue: string);
begin
  AddItem(AKey,TPdfTextString.Create(AValue));
end;

procedure TPdfDictionary.RemoveItem(const AKey: PDFString);
var i: integer;
    FElement: TPdfDictionaryElement;
begin
  if Self<>nil then
  for i := 0 to FArray.Count-1 do begin
    FElement := FArray.List[i];
    if FElement.FKey.Value=AKey then begin
      FArray.Remove(FElement);
      FElement.Free;
      Break;
    end;
  end;
end;

function TPdfDictionary.getTypeOf: PDFString;
var PdfName: TPdfName;
begin
  PdfName := PdfNameByName('Type');
  if PdfName<>nil then
    result := PdfName.Value else
    result := '';
end;

function TPdfDictionary.SpaceNotNeeded: boolean;
begin
  result := True;
end;


{ TPdfStream }

procedure TPdfStream.InternalWriteTo(W: TPdfWrite);
var FLength: TPdfNumber;
    TmpStream: TMemoryStream;
    TmpSize: integer;
    Buf: pointer;
begin
  inherited;
  FLength := FAttributes.PdfNumberByName('Length');
  FWriter.Save; // flush FWriter content
  Buf := TMemoryStream(FWriter.fDestStream).Memory;
  TmpSize := FWriter.Position;
  TmpStream := nil;
  try
    if FFilter='FlateDecode' then
      if TmpSize<100 then // don't compress tiny blocks
        FFilter := '' else begin
        TmpStream := THeapMemoryStream.Create;
        {$ifdef USE_SYNZIP}
        TmpSize := CompressStream(Buf,TmpSize,TmpStream,7,true);
        {$else}
        with TCompressionStream.Create(clMax, TmpStream) do
        begin
          Write(Buf^,TmpSize);
          Free;
        end;
        TmpSize := TmpStream.Size;
        {$endif}
        Buf := TmpStream.Memory;
      end;
    FLength.Value := TmpSize;
    if FFilter<>'' then
      FAttributes.AddItem('Filter',FFilter);
    FAttributes.DirectWriteTo(W,FSecondaryAttributes);
  {$ifdef USE_PDFSECURITY}
    if (TmpSize>0) and (W.fDoc.fEncryption<>nil) and not FDoNotEncrypt then
      W.fDoc.fEncryption.EncodeBuffer(Buf^,Buf^,TmpSize);
  {$endif USE_PDFSECURITY}
    W.Add(#10'stream'#10).Add(Buf,TmpSize).
      Add(#10'endstream');
    FWriter.fDestStream.Size := 0; // release internal stream memory
  finally
    TmpStream.Free;
  end;
end;

constructor TPdfStream.Create(ADoc: TPdfDocument; DontAddToFXref: boolean=false);
var FXref: TPdfXRef;
begin
  inherited Create;
  if DontAddToFXref then
    FXRef := nil else begin
    FXRef := ADoc.FXref;
    FXRef.AddObject(self);
  end;
  FAttributes := TPdfDictionary.Create(FXref);
  FAttributes.AddItem('Length', TPdfNumber.Create(0));
  if ADoc.CompressionMethod=cmFlateDecode then
    FFilter := 'FlateDecode';
  FWriter := TPdfWrite.Create(ADoc,THeapMemoryStream.Create);
end;

destructor TPdfStream.Destroy;
begin
  FWriter.fDestStream.Free;
  FWriter.Free;
  FAttributes.Free;
  inherited;
end;


{ TPdfBinary }

procedure TPdfBinary.InternalWriteTo(W: TPdfWrite);
begin
  inherited;
  W.Add(Stream.Memory,FStream.Size);
end;

constructor TPdfBinary.Create;
begin
  inherited;
  FStream := THeapMemoryStream.Create;
end;

destructor TPdfBinary.Destroy;
begin
  FStream.Free;
  inherited;
end;


{ utility functions }

function _DateTimeToPdfDate(ADate: TDateTime): TPdfDate;
var D: array[2..8] of word;
    i: PtrInt;
begin
  DecodeDate(ADate,D[2],D[3],D[4]);
  DecodeTime(ADate,D[5],D[6],D[7],D[8]);
  SetLength(result,17);
  YearToPChar(D[2],pointer(PtrInt(result)+2));
  PWord(result)^ := ord('D')+ord(':')shl 8;
  for i := 3 to 7 do
    PWordArray(pointer(result))^[i] := TwoDigitLookupW[D[i]];
  PByteArray(result)[16] := ord('Z');
//  Assert(abs(_PdfDateToDateTime(result)-ADate)<MSecsPerSec);
end;

const // not existing before Delphi 7
  HoursPerDay   = 24;
  MinsPerHour   = 60;
  SecsPerMin    = 60;
  MSecsPerSec   = 1000;
  MinsPerDay    = HoursPerDay * MinsPerHour;
  SecsPerDay    = MinsPerDay * SecsPerMin;
  MSecsPerDay   = SecsPerDay * MSecsPerSec;

function _PdfDateToDateTime(const AText: TPdfDate): TDateTime;
var Y,M,D, H,MI,SS: cardinal;
begin
  if Length(AText)<16 then
    raise EConvertError.CreateRes(@SDateEncodeError);
  Y := ord(AText[3])*1000+ord(AText[4])*100+ord(AText[5])*10+ord(AText[6])
    -(48+480+4800+48000);
  M := ord(AText[7])*10+ord(AText[8])-(48+480);
  D := ord(AText[9])*10+ord(AText[10])-(48+480);
  result := EncodeDate(Y,M,D);
  H := ord(AText[11])*10+ord(AText[12])-(48+480);
  MI := ord(AText[13])*10+ord(AText[14])-(48+480);
  SS := ord(AText[15])*10+ord(AText[16])-(48+480);;
  if (H<24) and (MI<60) and (SS<60) then // inlined EncodeTime()
    result := result + (H * (MinsPerHour * SecsPerMin * MSecsPerSec) +
      MI * (SecsPerMin * MSecsPerSec) + SS * MSecsPerSec) / MSecsPerDay else
    raise EConvertError.CreateRes(@SDateEncodeError);
end;

function _HasMultiByteString(Value: PAnsiChar): boolean;
begin
  if Value<>nil then
    while true do
      if Value^=#0 then
        Break else
      if not (Value^ in LeadBytes) then
        inc(Value) else begin
        result := true;
        exit;
      end;
  result := false;
end;

function RawUTF8ToPDFString(const Value: RawUTF8): PDFString;
begin
  result := CurrentAnsiConvert.UTF8BufferToAnsi(pointer(Value),length(Value));
end;

function UInt32ToPDFString(Value : Cardinal): PDFString;
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  P := StrUInt32(@tmp[23],Value);
  SetString(result,P,@tmp[23]-P);
end;

function PdfRect(Left, Top, Right, Bottom: Single): TPdfRect;
begin
  result.Left := Left;
  result.Top := Top;
  result.Right := Right;
  result.Bottom := Bottom;
end;

function PdfRect(const Box: TPdfBox): TPdfRect;
begin
  result.Left := Box.Left;
  result.Top := Box.Top;
  result.Right := Box.Left+Box.Width;
  result.Bottom := Box.Top-Box.Height;
end;

function PdfBox(Left, Top, Width, Height: Single): TPdfBox;
begin
  result.Left := Left;
  result.Top := Top;
  result.Width := Width;
  result.Height := Height;
end;

function CombineTransform(xform1, xform2: XFORM): XFORM;
begin
  Result.eM11 := xform1.eM11 * xform2.eM11 + xform1.eM12 * xform2.eM21;
  Result.eM12 := xform1.eM11 * xform2.eM12 + xform1.eM12 * xform2.eM22;
  Result.eM21 := xform1.eM21 * xform2.eM11 + xform1.eM22 * xform2.eM21;
  Result.eM22 := xform1.eM21 * xform2.eM12 + xform1.eM22 * xform2.eM22;
  Result.eDx  := xform1.eDx  * xform2.eM11 + xform1.eDy  * xform2.eM21 + xform2.eDx;
  Result.eDy  := xform1.eDx  * xform2.eM12 + xform1.eDy  * xform2.eM22 + xform2.eDy;
end;

procedure InitTransformation(x: PXForm; var fIntFactorX, fIntFactorY,
  fIntOffsetX, fIntOffsetY: Single);
begin
  if Assigned(x) then
  begin
    fIntFactorX := x^.eM11;
    fIntFactorY := x^.eM22;
    fIntOffsetX := x^.eDx;
    fIntOffsetY := x^.eDy;
  end
  else
  begin
    fIntFactorX := 1;
    fIntFactorY := 1;
    fIntOffsetX := 0;
    fIntOffsetY := 0;
  end;
end;

function DefaultIdentityMatrix: XFORM;
begin
  Result.eM11 := 1;
  Result.eM12 := 0;
  Result.eM21 := 0;
  Result.eM22 := 1;
  Result.eDx := 0;
  Result.eDy := 0;
end;

function ScaleRect(r: TRect; fScaleX, fScaleY: Single): TRect;
begin
  Result.Left := Trunc(r.Left * fScaleX);
  Result.Top := Trunc(r.Top * fScaleY);
  Result.Right := Trunc(r.Right * fScaleX);
  Result.Bottom := Trunc(r.Bottom * fScaleY);
end;

function PrepareTransformation(fIntFactorX, fIntFactorY, fIntOffsetX,
  fIntOffsetY: Single): XForm;
begin
  Result.eM11 := fIntFactorX;
  Result.eM12 := 0;
  Result.eM21 := 0;
  Result.eM22 := fIntFactorY;
  Result.eDx := fIntOffsetX;
  Result.eDy := fIntOffsetY;
end;


{ TPdfWrite }

function TPdfWrite.Add(c: AnsiChar): TPdfWrite;
begin
  if B>=Bend then // avoid GPF
    Save;
  B^ := c;
  inc(B);
  result := self;
end;

function TPdfWrite.Add(Value: Integer): TPdfWrite;
var t: array[0..23] of AnsiChar;
    P: PAnsiChar;
begin
  if BEnd-B<=24 then
    Save;
  if Cardinal(Value)<1000 then
    if Cardinal(Value)<10 then begin
      B^ := AnsiChar(Value+48);
      inc(B);
    end else
    if Cardinal(Value)<100 then begin
      PWord(B)^ := TwoDigitLookupW[Value];
      inc(B,2);
    end else begin
      PCardinal(B)^ := PCardinal(SmallUInt32UTF8[Value])^;
      inc(B,3);
    end
  else begin
    P := StrInt32(@t[23],Value);
    MoveFast(P^,B^,@t[23]-P);
    inc(B,@t[23]-P);
  end;
  result := self;
end;

function TPdfWrite.Add(const Text: RawByteString): TPdfWrite;
var L: integer;
begin
  if PtrInt(Text)<>0 then begin
    {$ifdef HASINLINE}
    L := length(Text);
    {$else}
    L := PInteger(PtrInt(Text)-4)^;
    {$endif}
    if BEnd-B<=L then begin
      Save;
      inc(fDestStreamPosition,L);
      fDestStream.WriteBuffer(pointer(Text)^,L);
    end else begin
      MoveFast(pointer(Text)^,B^,L);
      inc(B,L);
    end;
  end;
  result := self;
end;

function TPdfWrite.Add(Text: PAnsiChar; Len: integer): TPdfWrite;
begin
  if BEnd-B<=Len then begin
    Save;
    inc(fDestStreamPosition,Len);
    fDestStream.WriteBuffer(Text^,Len);
  end else begin
    MoveFast(Text^,B^,Len);
    inc(B,Len);
  end;
  result := self;
end;

function TPdfWrite.Add(Value, DigitCount: Integer): TPdfWrite;
var t: array[0..15] of AnsiChar;
    i64: array[0..1] of Int64 absolute t;
begin
//  assert(DigitCount<high(t));
  if BEnd-B<=16 then
    Save;
  i64[0] := $3030303030303030; // t[0..14]='0'
  i64[1] := $2030303030303030; // t[15]=' '
  if Value<0 then
    Value := 0;
  StrUInt32(@t[15],Value);
  inc(DigitCount); // includes trailing t[15]=' '
  MoveFast(t[16-DigitCount],B^,DigitCount);
  inc(B,DigitCount);
  result := self;
end;

function TPdfWrite.Add(Value: TSynExtended): TPdfWrite;
var Buffer: ShortString;
    L: integer;
begin
  if BEnd-B<=32 then
    Save;
  str(Value:0:2,Buffer);
  L := ord(Buffer[0]);
  if Buffer[L]='0' then
    if Buffer[L-1]='0' then // '3.00' -> '3'
      dec(L,3) else
      dec(L); // '3.40' -> '3.4'
  MoveFast(Buffer[1],B^,L);
  inc(B,L);
  result := self;
end;

function TPdfWrite.AddColorStr(Color: TPdfColorRGB): TPdfWrite;
var X: array[0..3] of byte absolute Color;
begin
  {$ifdef MSWINDOWS}
  if integer(Color)<0 then
    Color := GetSysColor(Color and $ff);
  {$endif}
  result := AddWithSpace(X[0]/255).AddWithSpace(X[1]/255).AddWithSpace(X[2]/255);
end;

function TPdfWrite.AddEscapeContent(const Text: RawByteString): TPdfWrite;
{$ifdef USE_PDFSECURITY}
var tmp: TSynTempBuffer;
{$endif USE_PDFSECURITY}
begin
  if Text<>'' then
{$ifdef USE_PDFSECURITY}
    if fDoc.fEncryption<>nil then begin
      tmp.Init(length(Text));
      fDoc.fEncryption.EncodeBuffer(pointer(Text)^,tmp.buf^,tmp.len);
      AddEscape(tmp.buf,tmp.len);
      tmp.Done;
    end else
{$endif USE_PDFSECURITY}
    AddEscape(pointer(Text),length(Text));
  result := self;
end;

function TPdfWrite.AddEscape(Text: PAnsiChar; TextLen: integer): TPdfWrite;
var TextEnd: PAnsiChar;
begin
  TextEnd := Text+TextLen;
  while Text<TextEnd do begin
    if B>=Bend4 then
      Save;
    case Text^ of
     '(',')','\': PWord(B)^ := ord('\')+ord(Text^)shl 8;
     #0: begin
       PInteger(B)^ := ord('\')+ord('0')shl 8+ord('0')shl 16+ord('0')shl 24;
       inc(B,2);
     end;
     #8:  PWord(B)^ := ord('\')+ord('b')shl 8;
     #9:  PWord(B)^ := ord('\')+ord('t')shl 8;
     #10: PWord(B)^ := ord('\')+ord('n')shl 8;
     #12: PWord(B)^ := ord('\')+ord('f')shl 8;
     #13: PWord(B)^ := ord('\')+ord('r')shl 8;
     else begin
       B^ := Text^;
       Inc(B);
       Inc(Text);
       continue;
     end;
    end;
    Inc(B,2);
    Inc(Text);
  end;
  result := self;
end;

const // should be local for better code generation
  HexChars: array[0..15] of AnsiChar = '0123456789ABCDEF';

function TPdfWrite.AddEscapeName(Text: PAnsiChar): TPdfWrite;
const ESCAPENAME: set of AnsiChar =
   [#1..#31,'%','(',')','<','>','[',']','{','}','/','#',#127..#255];
var c: cardinal;
begin
  if Text<>nil then
  repeat
    if B>=Bend4 then
      Save;
    c := ord(Text^);
    if c=0 then
      break else
    if AnsiChar(c) in ESCAPENAME then begin
      B[0] := '#';
      B[1] := HexChars[c shr 4];
      B[2] := HexChars[c and $F];
      inc(B,3);
      Inc(Text);
     end else begin
       B^ := AnsiChar(c);
       Inc(B);
       Inc(Text);
     end;
  until false;
  result := self;
end;

function TPdfWrite.AddEscapeText(Text: PAnsiChar; Font: TPdfFont): TPdfWrite;
begin // this function is intented to use with Tj or '
  if Text<>nil then
  repeat
    if B>=Bend4 then
      Save;
    if Font<>nil then
      include(Font.fWinAnsiUsed,Text^);
    case Text^ of
     #0: Break;
     #160: begin        // fixed space is written as normal space
       B^ := ' ';
       inc(B);
       inc(Text);
     end;
     #40,#41,#92: begin // see PDF 2nd ed. p. 290
       B[1] := Text^;
       B[0] := '\';
       Inc(B,2);
       Inc(Text);
     end;
     else begin
       B^ := Text^;
       Inc(B);
       Inc(Text);
     end;
    end;
  until false;
  result := self;
end;

function TPdfWrite.AddHex(const Bin: PDFString): TPdfWrite;
var L, Len: integer;
    PW: Pointer;
begin
  Len := length(Bin);
  PW := pointer(Bin);
  repeat
    L := Len;
    if BEnd-B<=L*2 then begin
      Save;
      if L>high(Tmp) shr 1 then
        L := high(Tmp) shr 1;
    end;
    BinToHex(PW,B,L);
    inc(PtrInt(PW),L);
    inc(B,L*2);
    dec(Len,L);
  until Len=0;
  result := self;
end;

function TPdfWrite.AddHex4(aWordValue: cardinal): TPdfWrite;
var v: Cardinal;
begin
  if B>=BEnd4 then
    Save;
  v := aWordValue shr 8;
  aWordValue := aWordValue and $ff;
  B[0] := HexChars[v shr 4];            // MSB stored first (BigEndian)
  B[1] := HexChars[v and $F];
  B[2] := HexChars[aWordValue shr 4];   // LSB stored last (BigEndian)
  B[3] := HexChars[aWordValue and $F];
  inc(B,4);
  result := self;
end;

procedure TPdfWrite.AddRGB(P: PAnsiChar; PInc, Count: integer);
begin
  while Count>0 do begin
    dec(Count);
    if B>=BEnd4 then
      Save;
    B[0] := P[2];  // write the RGB value in expected order
    B[1] := P[1];
    B[2] := P[0];
    inc(B,3);
    inc(P,PInc);
  end;
end;

function TPdfWrite.AddIso8601(DateTime: TDateTime): TPdfWrite;
begin // add e.g. '2010-06-16T15:06:59'
  result := Add(DateTimeToIso8601(DateTime,true,'T'));
end;

function TPdfWrite.AddWithSpace(Value: TSynExtended): TPdfWrite;
var Buffer: ShortString;
    L: integer;
begin
  if BEnd-B<=32 then
    Save;
  // Value := Trunc(Value * 100 + 0.5) / 100; // 2 decim rounding done by str()
  if Abs(Value)<1E-2 then
    Add('0 ') else begin
    str(Value:0:2,Buffer); // fast conversion with no temp string, using '.'
    L := ord(Buffer[0]);
    if Buffer[L]='0' then
      if Buffer[L-1]='0' then // '3.00' -> '3 '
        dec(L,2) else // '3.40' -> '3.4 '
        else inc(L);  // '3.45' -> '3.45 '
    Buffer[L] := ' '; // append space at the end
    MoveFast(Buffer[1],B^,L);
    inc(B,L);
  end;
  result := self;
end;

function TPdfWrite.AddIntegerBin(value: integer; bytesize: cardinal): TPdfWrite;
var i: cardinal;
begin
  if BEnd-B<=4 then
    Save;
  for i := 1 to bytesize do
    B[i-1] := PAnsiChar(@value)[bytesize-i];
  inc(B,bytesize);
  result := self;
end;

function TPdfWrite.AddWithSpace(Value: TSynExtended; Decimals: cardinal): TPdfWrite;
var Buffer: ShortString;
    L: integer;
begin
  if BEnd-B<=32 then
    Save;
  str(Value:0:Decimals,Buffer);
  L := ord(Buffer[0])+1;
  Buffer[L] := ' '; // append space at the end
  MoveFast(Buffer[1],B^,L);
  inc(B,L);
  result := self;
end;

function TPdfWrite.ToWideChar(const Ansi: PDFString; out DLen: Integer): PWideChar;
var L: integer;
begin
  L := Length(Ansi)*2+2; // maximum possible length
  getmem(result,L);
  DLen := TSynAnsiConvert.Engine(fCodePage).AnsiBufferToUnicode(
    result,pointer(Ansi),Length(Ansi))-result; // use SynCommons fast conversion
end;

function TPdfWrite.AddToUnicodeHex(const Text: PDFString): TPdfWrite;
var PBuf: pointer;
    Len: integer;
begin
  PBuf := ToWideChar(Text,Len);
  AddUnicodeHex(PBuf,Len);
  FreeMem(PBuf);
  result := self;
end;

function TPdfWrite.AddUnicodeHex(PW: PWideChar; WideCharCount: integer): TPdfWrite;
procedure BinToHex4(Bin, Hex: PAnsiChar; BinWords: integer); // BigEndian order
var j, v: cardinal;
begin
  for j := 1 to BinWords do begin
    v := byte(Bin^);
    inc(Bin);
    Hex[2] := HexChars[v shr 4];   // LSB stored last (BigEndian)
    Hex[3] := HexChars[v and $F];
    v := byte(Bin^);
    inc(Bin);
    Hex[0] := HexChars[v shr 4];   // MSB stored first (BigEndian)
    Hex[1] := HexChars[v and $F];
    inc(Hex,4);
  end;
end;
var L: Integer;
{$ifdef USE_PDFSECURITY}
    sectmp: TSynTempBuffer;
{$endif USE_PDFSECURITY}
begin
  if WideCharCount>0 then begin
{$ifdef USE_PDFSECURITY}
    if fDoc.fEncryption<>nil then begin
      sectmp.Init(WideCharCount*2);
      fDoc.fEncryption.EncodeBuffer(PW^,sectmp.buf^,WideCharCount*2);
      PW := sectmp.buf;
    end;
{$endif USE_PDFSECURITY}
    repeat
      L := WideCharCount;
      if BEnd-B<=L*4 then begin
        Save;
        if L>high(Tmp) shr 2 then
          L := high(Tmp) shr 2; // max WideCharCount allowed in Tmp[]
      end;
      BinToHex4(pointer(PW),B,L);
      inc(PtrInt(PW),L*2);
      inc(B,L*4);
      dec(WideCharCount,L);
    until WideCharCount=0;
{$ifdef USE_PDFSECURITY}
    if fDoc.fEncryption<>nil then
      sectmp.Done;
{$endif USE_PDFSECURITY}
  end;
  result := self;
end;

function TPdfWrite.AddToUnicodeHexText(const Text: PDFString;
  NextLine: boolean; Canvas: TPdfCanvas): TPdfWrite;
var PBuf: pointer;
    Len: integer;
begin
  PBuf := ToWideChar(Text,Len);
  AddUnicodeHexText(PBuf,NextLine,Canvas);
  FreeMem(PBuf);
  result := self;
end;

const
  SHOWTEXTCMD: array[boolean] of PDFString = (' Tj'#10,' '''#10);

/// reverse char orders for every hebrew and arabic words
procedure L2R(W: PWideChar; L: integer);
var tmp: TSynTempBuffer;
    i: integer;
begin
  tmp.Init(W,L*2);
  dec(L);
  for i := 0 to L do
    W[i] := PWideChar(tmp.buf)[L-i];
end;

function PdfCoord(MM: single): integer;
begin
  result := round(2.8346456693*MM);
end;

{$ifdef USE_UNISCRIBE}

function TPdfWrite.AddUnicodeHexTextUniScribe(PW: PWideChar;
  WinAnsiTTF: TPdfFontTrueType; NextLine: boolean; Canvas: TPdfCanvas): boolean;
// see http://msdn.microsoft.com/en-us/library/dd317792(v=VS.85).aspx
var L, i,j: integer;
    res: HRESULT;
    max, count, numSp: integer;
    Sp: PScriptPropertiesArray;
    items: array of TScriptItem;
    level: array of byte;
    VisualToLogical: array of integer;
    psc: pointer; // opaque Uniscribe font metric cache
    complex,R2L: boolean;
    glyphs: array of TScriptVisAttr;
    glyphsCount: integer;
    OutGlyphs, LogClust: array of word;
    AScriptControl: TScriptControl;
    AScriptState: TScriptState;
procedure Append(i: Integer);
// local procedure used to add glyphs from items[i] to the PDF content stream
var L: integer;
    W: PWideChar;
procedure DefaultAppend;
var tmpU: array of WideChar;
begin
  SetLength(tmpU,L+1); // we need the text to be ending with #0
  MoveFast(W^,tmpU[0],L*2);
  AddUnicodeHexTextNoUniScribe(pointer(tmpU),WinAnsiTTF,false,Canvas);
end;
begin
  L := items[i+1].iCharPos-items[i].iCharPos; // length of this shapeable item
  if L=0 then
    exit; // nothing to append
  W := PW+items[i].iCharPos;
  res := ScriptShape(0,psc,W,L,max,@items[i].a,
    pointer(OutGlyphs),pointer(LogClust),pointer(glyphs),glyphsCount);
  case res of
    E_OUTOFMEMORY: begin // max was not big enough (should never happen)
      DefaultAppend;
      exit;
    end;
    E_PENDING, USP_E_SCRIPT_NOT_IN_FONT: begin // need HDC and a selected font object
      res := ScriptShape(Canvas.FDoc.GetDCWithFont(WinAnsiTTF),
        psc,W,L,max,@items[i].a,
        pointer(OutGlyphs),pointer(LogClust),pointer(glyphs),glyphsCount);
      if res<>0 then begin // we won't change font if necessary, sorry
        // we shall implement the complex technic as stated by
        // http://msdn.microsoft.com/en-us/library/dd374105(v=VS.85).aspx
        DefaultAppend;
        exit;
      end;
    end;
    0: ; // success -> will add glyphs just below
    else exit;
  end;
  // add glyphs to the PDF content
  // (NextLine has already been handled: not needed here)
  AddGlyphs(pointer(OutGlyphs),glyphsCount,Canvas,pointer(glyphs));
end;
begin
  result := false; // on UniScribe error, handle as Unicode
  // 1. Breaks a Unicode string into individually shapeable items
  L := StrLenW(PW)+1; // include last #0
  max := L+2; // should be big enough
  SetLength(items,max);
  count := 0;
  FillCharFast(AScriptControl, SizeOf(TScriptControl), 0);
  FillCharFast(AScriptState, SizeOf(TScriptState), 0);
  if ScriptApplyDigitSubstitution(nil,@AScriptControl,@AScriptState) <> 0 then
    exit;
  if Canvas.RightToLeftText then
    AScriptState.uBidiLevel := 1;
  if ScriptItemize(PW,L,max,@AScriptControl,@AScriptState,pointer(items),count) <> 0 then
    exit; // error trying processing Glyph Shaping -> fast return
  // 2. guess if requiring glyph shaping or layout
  ScriptGetProperties(sP,numSp);
  complex := false;
  R2L := false;
  for i := 0 to Count-2 do // don't need Count-1 = Terminator
    if fComplex in sP^[items[i].a.eScript and (1 shl 10-1)]^.fFlags then
      complex := true else
      if fRTL in items[i].a.fFlags then
        R2L := true;
  if not complex and not R2L then
    exit; // avoid slower UniScribe if content does not require it
  // 3. get Visual Order, i.e. how to render the content from left to right
  SetLength(level,count);
  for i := 0 to Count-1 do
    level[i] := items[i].a.s.uBidiLevel;
  SetLength(VisualToLogical,count);
  if ScriptLayout(Count,pointer(level),pointer(VisualToLogical),nil)<>0 then
    exit;
  // 4. now we have enough information to start drawing
  result := true;
  if NextLine then
    Canvas.MoveToNextLine; // manual NextLine handling
  // 5. add glyphs for all shapeable items
  max := (L*3)shr 1+32; // should be big enough - allocate only once
  SetLength(glyphs,max);
  SetLength(OutGlyphs,max);
  SetLength(LogClust,max);
  psc := nil; // cached for the same character style used
  // append following logical order
  for j := 0 to Count-2 do // Count-2: ignore last ending item
    Append(VisualToLogical[j]);
end;
{$endif}

procedure TPdfWrite.AddGlyphFromChar(Char: WideChar; Canvas: TPdfCanvas;
  TTF: TPdfFontTrueType; NextLine: PBoolean);
var aChanged: boolean;
    aTTF: TPdfFontTrueType;
    Glyph: word;
begin
  assert((TTF<>nil) and (TTF=TTF.WinAnsiFont));
  aChanged := fAddGlyphFont=fNone;
  Glyph := TTF.fUsedWide[TTF.FindOrAddUsedWideChar(Char)].Glyph;
  with Canvas.fDoc do
    if (fPDFA <> pdfaNone) and (Glyph=0) and (fFontFallBackIndex<0) then
      raise Exception.Create('PDFA expects font fallback to be enabled, '+
        'and the required font is not available on this system') else
    if (Glyph=0) and fUseFontFallBack and (fFontFallBackIndex>=0) then begin
      if fAddGlyphFont=fMain then
        AddGlyphFlush(Canvas,TTF,NextLine);
      fAddGlyphFont := fFallBack;
      aTTF := Canvas.SetFont('',Canvas.FPage.FontSize,TTF.fStyle,-1,fFontFallBackIndex) as TPdfFontTrueType;
      assert(aTTF=aTTF.WinAnsiFont);
      Glyph := aTTF.fUsedWide[aTTF.FindOrAddUsedWideChar(Char)].Glyph;
    end else begin
      if fAddGlyphFont=fFallBack then begin
        AddGlyphFlush(Canvas,TTF,NextLine);
        aChanged := true;
      end;
      fAddGlyphFont := fMain;
      aTTF := TTF;
    end;
  if (Canvas.FPage.Font<>aTTF.UnicodeFont) and (aTTF.UnicodeFont=nil) then
    aTTF.CreateAssociatedUnicodeFont;
  Canvas.SetPDFFont(aTTF.UnicodeFont,Canvas.FPage.FontSize);
  if aChanged then
    Add('<');
  AddHex4(Glyph);
end;

procedure TPdfWrite.AddGlyphFlush(Canvas: TPdfCanvas; TTF: TPdfFontTrueType;
  NextLine: PBoolean);
var aNextLine: boolean;
begin
  if fAddGlyphFont=fNone then
    exit;
  if NextLine=nil then
    aNextLine := false else begin
    aNextLine := NextLine^;
    NextLine^ := false;  // MoveToNextLine only once
  end;
  fAddGlyphFont := fNone;
  Add('>').Add(SHOWTEXTCMD[aNextLine]);
end;

procedure TPdfWrite.AddUnicodeHexTextNoUniScribe(PW: PWideChar;
  TTF: TPdfFontTrueType; NextLine: boolean; Canvas: TPdfCanvas);
var Ansi: integer;
    isSymbolFont: Boolean;
begin
  if TTF<>nil then begin
    if TTF.UnicodeFont<>nil then
      isSymbolFont := TTF.UnicodeFont.fIsSymbolFont else
      isSymbolFont := TTF.fIsSymbolFont;
    TTF := TTF.WinAnsiFont; // we expect the WinAnsi font in the code below
  end else
    isSymbolFont := false;
  Ansi := WideCharToWinAnsi(cardinal(PW^));
  if (TTF=nil) and (Ansi<0) then
    Ansi := ord('?'); // WinAnsi only font shows ? glyph for unicode chars
  while Ansi<>0 do begin
    if (Ansi>0) and not isSymbolFont then begin
      // add WinAnsi-encoded chars as such
      if (TTF<>nil) and (Canvas.FPage.Font<>TTF) then
        Canvas.SetPDFFont(TTF,Canvas.FPage.FontSize);
      Add('(');
      repeat
        case Ansi of
          40,41,92: Add('\');   // see PDF 2nd ed. p. 290
          160: Ansi := 32; // fixed space is written as normal space
        end;
        TTF.AddUsedWinAnsiChar(AnsiChar(Ansi));
        Add(AnsiChar(Ansi));
        Inc(PW);
        Ansi := WideCharToWinAnsi(cardinal(PW^));
        if (TTF=nil) and (Ansi<0) then
          Ansi := ord('?'); // WinAnsi only font shows ? glyph for unicode chars
      until Ansi<=0;
      Add(')').Add(SHOWTEXTCMD[NextLine]);
      NextLine := false; // MoveToNextLine only once
    end;
    if Ansi=0 then
      break;
    // here we know that PW^ is not a Win-Ansi glyph, and that TTF exists
    repeat
      AddGlyphFromChar(PW^,Canvas,TTF,@NextLine);
      inc(PW);
      Ansi := WideCharToWinAnsi(cardinal(PW^));
      if Ansi=160 then
        Ansi := 32;
      if Ansi=32 then
        if WideCharToWinAnsi(cardinal(PW[1]))<0 then
          continue; // we allow one space inside Unicode text
    until Ansi>=0;
    AddGlyphFlush(Canvas,TTF,@NextLine);
  end;
end;

function TPdfWrite.AddUnicodeHexText(PW: PWideChar; NextLine: boolean;
  Canvas: TPdfCanvas): TPdfWrite;
var TTF: TPdfFontTrueType;
begin
  if PW<>nil then begin
    with Canvas.FPage do
      if FFont.FTrueTypeFontsIndex=0 then
        TTF := nil else // mark we don't have an Unicode font, i.e. a TTF
        TTF := TPdfFontTrueType(FFont);
    {$ifdef USE_UNISCRIBE}
    // use the Windows Uniscribe API if required
    if not Canvas.fDoc.UseUniScribe or (TTF=nil) or
       not AddUnicodeHexTextUniScribe(PW,TTF.WinAnsiFont,NextLine,Canvas) then
    {$endif}
      // fastest version, without Ordering and/or Shaping of the text
      AddUnicodeHexTextNoUniScribe(PW,TTF,NextLine,Canvas);
  end;
  result := self;
end;

function TPdfWrite.AddGlyphs(Glyphs: PWord; GlyphsCount: integer;
  Canvas: TPdfCanvas; AVisAttrsPtr: Pointer): TPdfWrite;
var TTF: TPdfFontTrueType;
    first: boolean;
    glyph: integer;
    {$ifdef USE_UNISCRIBE}
    AVisAttrs: PScriptVisAttr;
    {$endif}
begin
  if (Glyphs<>nil) and (GlyphsCount>0) then begin
    with Canvas.FPage do
      if FFont.FTrueTypeFontsIndex=0 then
        TTF := nil else // mark we don't have an Unicode font, i.e. a TTF
        TTF := TPdfFontTrueType(FFont);
    if TTF<>nil then begin // we need a TTF font
      if (Canvas.FPage.Font<>TTF.UnicodeFont) and (TTF.UnicodeFont=nil) then
        TTF.CreateAssociatedUnicodeFont;
      Canvas.SetPDFFont(TTF.UnicodeFont,Canvas.FPage.FontSize);
      first := true;
      {$ifdef USE_UNISCRIBE}
      AVisAttrs := AVisAttrsPtr;
      {$endif}
      while GlyphsCount>0 do begin
        {$ifdef USE_UNISCRIBE}
        if (AVisAttrs=nil) or
           not(AVisAttrs^.fFlags*[fDiacritic,fZeroWidth]=[fZeroWidth]) then
        {$endif} begin
          glyph := TTF.WinAnsiFont.GetAndMarkGlyphAsUsed(Glyphs^);
          // this font shall by definition contain all needed glyphs
          // -> no Font Fallback is to be implemented here
          if first then begin
            first := false;
            Add('<');
          end;
          AddHex4(glyph);
        end;
        inc(Glyphs);
        dec(GlyphsCount);
        {$ifdef USE_UNISCRIBE}
        if AVisAttrs<>nil then
          inc(AVisAttrs);
        {$endif}
      end;
      if not first then
        Add('> Tj'#10);
    end;
  end;
  result := self;
end;

function TPdfWrite.AddWithSpace(Value: Integer): TPdfWrite;
var t: array[0..25] of AnsiChar;
    P: PAnsiChar;
    L: integer;
begin
  if BEnd-B<=16 then
    Save;
  if Cardinal(Value)<1000 then
    if Cardinal(Value)<10 then begin
      PWord(B)^ := Value+(48+32 shl 8);
      inc(B,2);
    end else
    if Cardinal(Value)<100 then begin
      PCardinal(B)^ := TwoDigitLookupW[Value]+32 shl 16;
      inc(B,3);
    end else begin
      PCardinal(B)^ := PCardinal(SmallUInt32UTF8[Value])^+32 shl 24;
      inc(B,4);
    end
  else begin
    t[24] := ' ';
    P := StrInt32(@t[24],Value);
    L := @t[25]-P;
    MoveFast(P^,B^,L);
    inc(B,@t[25]-P);
  end;
  result := self;
end;

constructor TPdfWrite.Create(Destination: TPdfDocument; DestStream: TStream);
begin
  fDoc := Destination;
  fDestStream := DestStream;
  fDestStreamPosition := fDestStream.Seek(0,soCurrent);
  fCodePage := fDoc.CodePage;
  B := @Tmp;
  Bend := B+high(Tmp);
  Bend4 := Bend-4;
end;

function TPdfWrite.Position: Integer;
begin
  result := fDestStreamPosition+B-@Tmp;
end;

procedure TPdfWrite.Save;
var L: integer;
begin
  L := B-@Tmp;
  inc(fDestStreamPosition,L);
  fDestStream.WriteBuffer(Tmp,L);
  B := @Tmp;
end;

function TPdfWrite.ToPDFString: PDFString;
begin
  if fDestStreamPosition=0 then
    // we remained in the internal buffer -> not necessary to use stream
    SetString(Result,Tmp,B-@Tmp) else begin
    // we used the stream -> flush remaining, and get whole data at once
    Save;
    result := '';
    SetLength(result,fDestStreamPosition);
    fDestStream.Seek(0,soBeginning);
    fDestStream.Read(pointer(result)^,fDestStreamPosition);
  end;
end;


{ Utility functions }

const
  PDF_PAGE_LAYOUT_NAMES: array[TPdfPageLayout] of PDFString = (
    'SinglePage', 'OneColumn', 'TwoColumnLeft', 'TwoColumnRight');

  PDF_PAGE_MODE_NAMES: array[TPdfPageMode] of PDFString = (
    'UseNone', 'UseOutlines', 'UseThumbs', 'FullScreen');

  PDF_ANNOTATION_TYPE_NAMES: array[0..12] of PDFString = (
    'Text', 'Link', 'Sound', 'FreeText', 'Stamp', 'Square', 'Circle',
    'StrikeOut', 'Highlight', 'Underline', 'Ink', 'FileAttachment', 'Popup');

  PDF_DESTINATION_TYPE_NAMES: array[TPdfDestinationType] of PDFString = (
    'XYZ', 'Fit', 'FitH', 'FitV', 'FitR', 'FitB', 'FitBH', 'FitBV');

procedure _Pages_AddKids(AParent: TPdfDictionary; AKid: TPdfDictionary);
var FKids: TPdfArray;
begin
  // adding page object to the parent pages object.
  FKids := AParent.PdfArrayByName('Kids');
  FKids.AddItem(AKid);
  AParent.PdfNumberByName('Count').Value := FKids.ItemCount;
end;


{ TPdfTrailer }

constructor TPdfTrailer.Create(AObjectMgr: TPdfObjectMgr);
begin
  inherited Create;
  FAttributes := TPdfDictionary.Create(AObjectMgr);
  FAttributes.AddItem('Size', TPdfNumber.Create(0));
end;

procedure TPdfTrailer.WriteTo(var W: TPdfWrite);
type TXRefType = (xrefFree, xrefInUse, xrefInUseCompressed);
const TYPEWIDTH = 1;
var offsetWidth,genWidth, i: integer;
    WR: TPdfWrite;
begin
  if FCrossReference=nil then begin
    W.Add('trailer' + CRLF);
    FAttributes.WriteTo(W);
  end else begin
    if FXrefAddress<60000 then
      offsetWidth := 2 else
    if FXrefAddress<13421772 then
      offsetWidth := 3 else
      offsetWidth := 4;
    if (FObjectStream=nil) or (FObjectStream.ObjectCount<255) then
      genWidth := 1 else
      if FObjectStream.ObjectCount<65535 then
        genWidth := 2 else
        genWidth := 3;
    FAttributes.AddItem('W',TPdfArray.Create(nil,[TYPEWIDTH,offsetWidth,genWidth]));
    WR := FCrossReference.Writer;
    WR.AddIntegerBin(ord(xrefFree),TYPEWIDTH).
       AddIntegerBin(0,offsetWidth).
       AddIntegerBin(-1,genWidth);
    for i := 1 to FXRef.ItemCount-1 do
    with FXRef.Items[i] do begin
      if ObjectStreamIndex>=0 then begin
        assert(FObjectStream<>nil);
        WR.AddIntegerBin(ord(xrefInUseCompressed),TYPEWIDTH);
        WR.AddIntegerBin(FObjectStream.ObjectNumber,offsetWidth);
        WR.AddIntegerBin(ObjectStreamIndex,genWidth);
      end else begin
        WR.AddIntegerBin(ord(xrefInUse),TYPEWIDTH);
        WR.AddIntegerBin(ByteOffset,offsetWidth);
        WR.AddIntegerBin(GenerationNumber,genWidth);
      end;
    end;
    FCrossReference.WriteValueTo(W);
  end;
  W.Add(CRLF + 'startxref' + CRLF).Add(FXrefAddress).
    Add(CRLF + '%%EOF' + CRLF);
end;

destructor TPdfTrailer.Destroy;
begin
  FAttributes.Free;
  inherited;
end;

procedure TPdfTrailer.ToCrossReference(Doc: TPdfDocument);
var i: integer;
{$ifdef USE_PDFSECURITY}
    Enc: TPdfEncryption;
{$endif USE_PDFSECURITY}
begin
  FXRef := Doc.FXref;
  FCrossReference := TPdfStream.Create(Doc);
  FCrossReference.FSecondaryAttributes := FAttributes;
  FAttributes.AddItem('Type','XRef');
{$ifdef USE_PDFSECURITY}
  FCrossReference.FDoNotEncrypt := true;
  if Doc.fEncryption<>nil then
    exit; // still a bug with encryption + objectstream
{$endif USE_PDFSECURITY}
  FObjectStream := TPdfObjectStream.Create(Doc);
{$ifdef USE_PDFSECURITY}
  FObjectStream.FDoNotEncrypt := true;
  Enc := Doc.fEncryption;
  try
    Doc.fEncryption := nil; // force /ObjStm content not encrypted
{$endif USE_PDFSECURITY}
    for i := 1 to FXRef.ItemCount-1 do
    with FXRef.Items[i] do
      if (ByteOffset<=0) and Value.InheritsFrom(TPdfDictionary) then begin
        FByteOffset := maxInt; // mark already handlded
        FObjectStreamIndex := FObjectStream.AddObject(Value);
      end;
{$ifdef USE_PDFSECURITY}
  finally
    Doc.fEncryption := Enc;
  end;
{$endif USE_PDFSECURITY}
end;


{ TPdfXrefEntry }

constructor TPdfXrefEntry.Create(AValue: TPdfObject);
begin
  FByteOffset := -1;
  FObjectStreamIndex := -1;
  if AValue<>nil then begin
    FEntryType := PDF_IN_USE_ENTRY;
    FGenerationNumber := AValue.GenerationNumber;
    FValue := AValue;
  end else
    FEntryType := PDF_FREE_ENTRY;
end;

destructor TPdfXrefEntry.Destroy;
begin
  if FEntryType=PDF_IN_USE_ENTRY then
    FValue.Free;
  inherited;
end;

procedure TPdfXrefEntry.SaveToPdfWrite(var W: TPdfWrite);
begin
  W.Add(FByteOffset,10).Add(FGenerationNumber,5).Add(FEntryType).Add(' '#10);
end;


{ TPdfXref }

constructor TPdfXref.Create;
var RootEntry: TPdfXrefEntry;
begin
  FXrefEntries := TList.Create;
  // create first a void PDF_FREE_ENTRY as root
  RootEntry := TPdfXrefEntry.Create(nil);
  RootEntry.GenerationNumber := PDF_MAX_GENERATION_NUM;
  FXrefEntries.Add(RootEntry);
end;

destructor TPdfXref.Destroy;
var i: integer;
begin
  for i := 0 to FXrefEntries.Count-1 do
    GetItem(i).Free;
  FXrefEntries.Free;
  inherited;
end;

procedure TPdfXref.AddObject(AObject: TPdfObject);
var ObjectNumber: integer;
    XrefEntry: TPdfXrefEntry;
begin
  if (AObject=nil) or (AObject.ObjectType<>otDirectObject) then
    raise EPdfInvalidOperation.Create('AddObject');
  XrefEntry := TPdfXrefEntry.Create(AObject);
  ObjectNumber := FXrefEntries.Add(XrefEntry);
  AObject.SetObjectNumber(ObjectNumber);
end;

function TPdfXref.GetItem(ObjectID: integer): TPdfXrefEntry;
begin
  Result := TPdfXrefEntry(FXrefEntries[ObjectID]);
end;

function TPdfXref.GetItemCount: integer;
begin
  Result := FXrefEntries.Count;
end;

function TPdfXref.GetObject(ObjectID: integer): TPdfObject;
begin
  if cardinal(ObjectID)<cardinal(FXrefEntries.Count) then
    result := TPdfXrefEntry(FXrefEntries.List[ObjectID]).Value else
    result := nil;
end;

procedure TPdfXref.WriteTo(var W: TPdfWrite);
var i: integer;
begin
  W.Add('xref' + CRLF + '0 ').Add(FXrefEntries.Count).Add(#10);
  for i := 0 to FXrefEntries.Count- 1 do
    Items[i].SaveToPdfWrite(W);
end;


{ TPdfDocument }

function EnumFontsProcW(var LogFont: TLogFontW; var TextMetric: TTextMetric;
  FontType: Integer; var List: TRawUTF8DynArray): Integer; stdcall;
// we enumerate all available fonts, whatever the charset is, because
// we may won't enumerate Arial or Times New Roman if current FCharSet is
// chinese e.g.
var Temp: RawUTF8;
begin
  with LogFont do
    if ((FontType=DEVICE_FONTTYPE) or (FontType=TRUETYPE_FONTTYPE)) and (lfFaceName[0]<>'@') then begin
      Temp := RawUnicodeToUtf8(lfFaceName,StrLenW(lfFaceName));
      if (pointer(List)=nil) or (List[high(List)]<>Temp) then
        AddRawUTF8(List,Temp,true,true);
    end;
  Result := 1;
end;

function LCIDToCodePage(ALcid: LCID): Integer;
var Buffer: array [0..6] of Char;
begin
  GetLocaleInfo(ALcid, LOCALE_IDEFAULTANSICODEPAGE, Buffer, SizeOf(Buffer));
  Result:= StrToIntDef(Buffer, GetACP);
end;

constructor TPdfDocument.Create(AUseOutlines: Boolean; ACodePage: integer;
  {$ifdef USE_PDFALEVEL]}APDFA: TPdfALevel{$else}APDFA1: boolean{$endif}
  {$ifdef USE_PDFSECURITY}; AEncryption: TPdfEncryption{$endif});
var LFont: TLogFontW; // TLogFontW to add to FTrueTypeFonts array as UTF-8
    i: integer;
begin
  {$ifdef USE_PDFALEVEL]}
  fPDFA:=APDFA;
  {$else}
  if APDFA1 then
    fPDFA := pdfa1B else
    fPDFA := pdfaNone;
  {$endif USE_PDFALEVEL}
  {$ifdef USE_PDFSECURITY}
  fEncryption := AEncryption;
  {$endif USE_PDFSECURITY}
  fTPdfPageClass := TPdfPage;
  if ACodePage=0 then
    FCodePage := LCIDToCodePage(SysLocale.DefaultLCID) else // GetACP can be<>SysLocale
    FCodePage := ACodePage;
  FCharSet := CodePageToCharSet(FCodePage);
  DefaultPaperSize := psA4;
  fRawPages := TList.Create;
  // retrieve the current reference GDI parameters
  FDC := CreateCompatibleDC(0);
  FScreenLogPixels := GetDeviceCaps(FDC, LOGPIXELSY);
  FCanvas := TPdfCanvas.Create(Self); // need FScreenLogPixels
  // retrieve true type fonts available for all charsets
  FillCharFast(LFont, sizeof(LFont), 0);
  LFont.lfCharset := DEFAULT_CHARSET; // enumerate ALL fonts
  EnumFontFamiliesExW(FDC, LFont, @EnumFontsProcW, PtrInt(@FTrueTypeFonts), 0);
  QuickSortRawUTF8(FTrueTypeFonts,length(FTrueTypeFonts),nil,@StrIComp);
  FCompressionMethod := cmFlateDecode; // deflate by default
  fBookMarks := TRawUTF8List.Create([fCaseSensitive,fNoDuplicate]);
  fMissingBookmarks := TRawUTF8List.Create;
  FUseOutlines := AUseOutlines;
  fUseFontFallBack := true;
  fFontFallBackIndex := GetTrueTypeFontIndex('Arial Unicode MS');
  if fFontFallBackIndex<0 then // greek/hebrew/cyrillic fallback
    fFontFallBackIndex := GetTrueTypeFontIndex('Lucida Sans Unicode');
  if fFontFallBackIndex<0 then
    for i := 0 to high(FTrueTypeFonts) do
      if PosEx('Unicode',FTrueTypeFonts[i])>0 then begin
        fFontFallBackIndex := i;
        break;
      end;
  NewDoc;
end;

function TPdfDocument.GetInfo: TPdfInfo;
begin
  if FInfo=nil then
    CreateInfo;
  Result := FInfo;
end;

function TPdfDocument.GetOutlineRoot: TPdfOutlineRoot;
begin
  if not UseOutlines then
    RaiseInvalidOperation;
  Result := FOutlineRoot;
end;

destructor TPdfDocument.Destroy;
begin
  FreeDoc;
  FCanvas.Free;
  if fSelectedDCFontOld<>0 then
    SelectObject(FDC,fSelectedDCFontOld);
  DeleteDC(FDC);
  FEmbeddedTTFIgnore.Free;
  fRawPages.Free;
  fBookMarks.Free;
  fMissingBookmarks.Free;
  inherited;
  {$ifdef USE_PDFSECURITY}
  fEncryption.Free;
  {$endif USE_PDFSECURITY}
end;

function TPdfDocument.RegisterXObject(AObject: TPdfXObject; const AName: PDFString): integer;
begin
   // check object and register it
   if AObject=nil then
     raise EPdfInvalidValue.Create('RegisterXObject: no AObject');
   if AObject.Attributes.TypeOf<>'XObject' then
     raise EPdfInvalidValue.Create('RegisterXObject: no XObject');
   if AObject.ObjectType<>otIndirectObject then
     FXref.AddObject(AObject);
   if AObject.Attributes.ValueByName('Name')=nil then begin
     if GetXObject(AName)<>nil then
       raise EPdfInvalidValue.Createfmt('RegisterXObject: dup name %s', [AName]);
     result := FXObjectList.AddItem(AObject);
     AObject.Attributes.AddItem('Name', AName);
   end else
     result := -1;
end;

const
  PDF_PRODUCER = 'Synopse PDF engine '+SYNOPSE_FRAMEWORK_VERSION;

procedure TPdfDocument.CreateInfo;
var FInfoDictionary: TPdfDictionary;
begin
  FInfoDictionary := TPdfDictionary.Create(FXref);
  FXref.AddObject(FInfoDictionary);
  FInfoDictionary.AddItemText('Producer', PDF_PRODUCER);
  FTrailer.Attributes.AddItem('Info', FInfoDictionary);
  FInfo := TPdfInfo.Create;
  FInfo.SetData(FInfoDictionary);
  FObjectList.Add(FInfo);
end;

function TPdfDocument.CreatePages(Parent: TPdfDictionary): TPdfDictionary;
begin
  // create pages object and register to xref.
  result := TPdfDictionary.Create(FXref);
  result.FSaveAtTheEnd := True;
  FXref.AddObject(Result);
  with result do begin
    AddItem('Type', 'Pages');
    AddItem('Kids', TPdfArray.Create(FXref));
    AddItem('Count', 0);
  end;
  if (Parent<>nil) and (Parent.TypeOf='Pages') then
    _Pages_AddKids(Parent, result) else
    FRoot.Pages := Result;
end;

function TPdfDocument.GetXObjectIndex(const AName: PDFString): integer;
begin
  for result := 0 to FXObjectList.ItemCount-1 do
    with TPdfXObject(FXObjectList.FArray.List[result]) do
    if (FObjectType<>otVirtualObject) and (Attributes<>nil) and
       (TPdfName(Attributes.ValueByName('Name')).Value=AName) then
        exit;
  result := -1;
end;

function TPdfDocument.GetXObject(const AName: PDFString): TPdfXObject;
var i: integer;
begin
  for i := 0 to FXObjectList.ItemCount-1 do begin
    result := TPdfXObject(FXObjectList.FArray.List[i]);
    if result.FObjectType=otVirtualObject then begin
      result := TPdfXObject(FXRef.GetObject(result.FObjectNumber));
      if (result=nil) or not result.InheritsFrom(TPdfXObject) then
        continue;
    end;
    if result.Attributes<>nil then
      if TPdfName(result.Attributes.ValueByName('Name')).Value=AName then
        exit;
  end;
  Result := nil;
end;

{$ifdef USE_BITMAP}
function TPdfDocument.GetXObjectImageName(const Hash: THash128Rec;
  Width, Height: Integer): PDFString;
var Obj: TPdfXObject;
    Img: TPdfImage absolute Obj;
    i: integer;
begin
  for i := 0 to FXObjectList.ItemCount-1 do begin
    Obj := TPdfXObject(FXObjectList.FArray.List[i]);
    if Obj.FObjectType=otVirtualObject then
      Obj := TPdfXObject(FXRef.GetObject(Obj.FObjectNumber));
    if (Obj<>nil) and Obj.InheritsFrom(TPdfImage) and
       (Img.PixelWidth=Width) and (Img.PixelHeight=Height) and
       not IsZero(Img.fHash.b) and IsEqual(Img.fHash.b,Hash.b) and
       (Obj.Attributes<>nil) then begin
      result := TPdfName(Obj.Attributes.ValueByName('Name')).Value;
      if result<>'' then
        exit;
    end;
  end;
  result := '';
end;
{$endif USE_BITMAP}

function TPdfDocument.CreateAnnotation(AType: TPdfAnnotationSubType;
  const ARect: TPdfRect; BorderStyle: TPdfAnnotationBorder; BorderWidth: integer): TPdfDictionary;
var FAnnotation, FBorderStyle: TPdfDictionary;
    aArray: TPdfArray;
    aPage: TPdfPage;
const FLAGS_PRINT = 4;
      BS: array [TPdfAnnotationBorder] of PDFString = ('S','D','B','I','U');
begin
  // create new annotation and set the properties
  FAnnotation := TPdfDictionary.Create(FXref);
  FAnnotation.FSaveAtTheEnd := true;
  FXref.AddObject(FAnnotation);
  FAnnotation.AddItem('Type', 'Annot');
  FAnnotation.AddItem('Subtype', PDF_ANNOTATION_TYPE_NAMES[ord(AType)]);
  FAnnotation.AddItem('F',FLAGS_PRINT);
  if (BorderStyle<>abSolid) or (BorderWidth<>1) then begin
    FBorderStyle := TPdfDictionary.Create(FXRef);
    if BorderStyle<>abSolid then
      FBorderStyle.AddItem('S',BS[BorderStyle]);
    if BorderWidth<>1 then
      FBorderStyle.AddItem('W',BorderWidth);
    FAnnotation.AddItem('BS',FBorderStyle);
  end;
  with ARect do
    FAnnotation.AddItem('Rect',TPdfArray.CreateReals(FXRef,[Left,Top,Right,Bottom]));
  // adding annotation to the current page
  aPage := FCanvas.Page;
  aArray := aPage.PdfArrayByName('Annots');
  if aArray=nil then begin
    aArray := TPdfArray.Create(FXRef);
    aPage.AddItem('Annots', aArray);
  end;
  aArray.AddItem(FAnnotation);
  Result := FAnnotation;
end;

function TPdfDocument.CreateLink(const ARect: TPdfRect; const aBookmarkName: RawUTF8;
  BorderStyle: TPdfAnnotationBorder; BorderWidth: integer): TPdfDictionary;
var aDest: TPdfDestination;
begin
  result := CreateAnnotation(asLink,ARect,BorderStyle,BorderWidth);
  aDest := fBookmarks.GetObjectFrom(aBookmarkName);
  if aDest=nil then
    fMissingBookmarks.AddObject(aBookmarkName,result) else
    result.AddItem('Dest',aDest.GetValue);
end;

function TPdfDocument.CreateHyperLink(const ARect: TPdfRect; const url : RawUTF8;
  BorderStyle: TPdfAnnotationBorder; BorderWidth: integer): TPdfDictionary;
var aURIObj: TPdfDictionary;
begin
  result := CreateAnnotation(asLink,ARect,BorderStyle,BorderWidth);
  aURIObj := TPdfDictionary.Create(FXref);
  aURIObj.FSaveAtTheEnd := true;
  aURIObj.AddItem('S', 'URI');
  aURIObj.AddItemTextUTF8('URI', url);
  FXref.AddObject(aURIObj);
  Result.AddItem('A', aURIObj);
end;

function TPdfDocument.CreateDestination: TPdfDestination;
begin
  Result := TPdfDestination.Create(Self);
  FObjectList.Add(Result);
end;

procedure TPdfDocument.CreateBookMark(TopPosition: Single; const aBookmarkName: RawUTF8);
var aDest: TPdfDestination;
    i: integer;
begin
  if Canvas.FPage=nil then
    RaiseInvalidOperation; // we need a page to refer to
  if (aBookmarkName='') or (fBookMarks.IndexOf(aBookmarkName)>=0) then
    raise EPdfInvalidValue.CreateFmt('Duplicated or void bookmark name "%s"',[aBookmarkName]);
  aDest := CreateDestination;
  aDest.DestinationType := dtXYZ;
  aDest.Zoom := 0; // will leave Zoom factor unchanged
  aDest.Left := 0; // go to left side of the page
  aDest.Top := Round(TopPosition);
  fBookMarks.AddObject(aBookmarkName,aDest);
  with fMissingBookmarks do
    for i := Count-1 downto 0 do
      if Strings[i]=aBookmarkName then begin
        TPdfDictionary(Objects[i]).AddItem('Dest',aDest.GetValue);
        Delete(i);
      end;
end;

procedure TPdfDocument.NewDoc;
var CatalogDictionary: TPdfDictionary;
    Dico: TPdfDictionary;
    DicoD: TPdfDictionary;
    RGB: TPdfStream;
    ID: TPdfArray;
    IDs: PDFString;
    NeedFileID: boolean;
    FileID: array[0..3] of cardinal;
    {$ifndef USE_PDFSECURITY}
    P: PAnsiChar;
    {$endif USE_PDFSECURITY}
const
  ICC: array[0..139] of cardinal = (
    805437440,1161970753,4098,1920233069,541214546,542792024,134270983,318769920,989868800,
    1886610273,1280331841,0,1701736302,0,0,0,0,3606446080,256,768802816,1161970753,
    0,0,0,0,0,0,0,0,0,0,0,167772160,1953656931,4227858432,838860800,1668506980,805371904,
    1795162112,1953526903,2617311232,335544320,1953524578,2952855552,335544320,1129469042,
    3288399872,234881024,1129469031,3556835328,234881024,1129469026,3825270784,234881024,
    1515804786,4093706240,335544320,1515804775,134348800,335544320,1515804770,469893120,
    335544320,1954047348,0,2037411651,1751607666,808591476,1092628528,1700949860,1937330976,
    1936549236,1668172064,1869640303,1702125938,100,1668506980,0,285212672,1651467329,
    1196564581,824713282,691550521,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,542792024,0,
    1374879744,256,3423994112,542792024,0,0,0,0,1987212643,0,16777216,13058,1987212643,0,
    16777216,13058,1987212643,0,16777216,13058,542792024,0,412876800,2773417984,4228120576,
    542792024,0,2368995328,748683264,2500788224,542792024,0,824573952,789577728,2629697536);
begin
  fLastOutline := nil;
  FreeDoc;
  FXref := TPdfXref.Create;
  FTrailer := TPdfTrailer.Create(FXref);
  FFontList := TList.Create;
  FXObjectList := TPdfArray.Create(FXref);
  FXObjectList.FSaveAtTheEnd := true;
  FObjectList := TList.Create;
  FRoot := TPdfCatalog.Create;
  FRoot.FOwner := self;
  CatalogDictionary := TPdfDictionary.Create(FXref);
  FXref.AddObject(CatalogDictionary);
  CatalogDictionary.AddItem('Type', 'Catalog');
  FTrailer.Attributes.AddItem('Root', CatalogDictionary);
  FRoot.SetData(CatalogDictionary);
  FRoot.PageLayout := plSinglePage;
  FObjectList.Add(FRoot);
  if UseOutlines then begin
    FOutlineRoot := TPdfOutlineRoot.Create(Self);
    FRoot.Data.AddItem('Outlines', FOutlineRoot.Data);
  end;
  CreateInfo;
  FInfo.CreationDate := now;
  FCurrentPages := CreatePages(nil); // nil -> create root Pages XObject
  FRoot.SetPages(FCurrentPages);
  NeedFileID := false;
  if FUseOptionalContent then begin
    if fFileFormat<pdf15 then
      fFileFormat := pdf15;
    Dico := TPdfDictionary.Create(FXRef);
    DicoD := TPdfDictionary.Create(FXRef);
    DicoD.AddItem('BaseState','ON');  // must be ON in default configuration
    DicoD.AddItem('OFF',TPDFArray.Create(FXRef));
    DicoD.AddItem('Order',TPDFArray.Create(FXRef));
    DicoD.AddItem('ListMode','AllPages');  // default value but some viewers cause trouble when missing
    DicoD.AddItem('RBGroups',TPDFArray.Create(FXRef));
    Dico.AddItem('D',DicoD);
    Dico.AddItem('OCGs',TPdfArray.Create(FXRef));
    FRoot.Data.AddItem('OCProperties',Dico);
  end;
  {$ifdef USE_PDFSECURITY}
  if fEncryption<>nil then
    NeedFileID := true;
  {$endif USE_PDFSECURITY}
  if PDFA<>pdfaNone then begin
    if fFileFormat<pdf14 then
      fFileFormat := pdf14;
    {$ifdef USE_PDFSECURITY}
    if fEncryption<>nil then
      raise EPdfInvalidOperation.Create('PDF/A not allowed when encryption is enabled');
    {$endif USE_PDFSECURITY}
    fUseFontFallBack := true;
    FOutputIntents := TPdfArray.Create(FXref);
    Dico := TPdfDictionary.Create(FXRef);
    Dico.AddItem('Type','OutputIntent');
    Dico.AddItem('S','GTS_PDFA1');  // there is no definition GTS_PDFA2 or GTS_PDFA3
    Dico.AddItemText('OutputConditionIdentifier','sRGB');
    Dico.AddItemText('RegistryName','http://www.color.org');
    RGB := TPdfStream.Create(self);
    RGB.Attributes.AddItem('N',3);
    RGB.Writer.Add(@ICC,sizeof(ICC));
    Dico.AddItem('DestOutputProfile',RGB);
    FOutputIntents.AddItem(Dico);
    CatalogDictionary.AddItem('OutputIntents',FOutputIntents);
    FMetaData := TPdfStream.Create(Self);
    FMetaData.Attributes.AddItem('Subtype','XML');
    FMetaData.Attributes.AddItem('Type','Metadata');
    FMetaData.FFilter := '';
    CatalogDictionary.AddItem('MarkInfo',TPdfRawText.Create('<</Marked true>>'));
    CatalogDictionary.AddItem('Metadata',FMetadata);
    FStructTree := TPdfDictionary.Create(FXRef);
    FRoot.Data.AddItem('StructTreeRoot',FStructTree);
    NeedFileID := true;
  end;
  if NeedFileID then begin
    FillRandom(@FileID, 4, true);
    {$ifdef USE_PDFSECURITY}
    fFileID := MD5Buf(FileID[0],16);
    IDs := '<'+RawByteString(MD5DigestToString(fFileID))+'>';
    {$else}
    SetLength(IDs,34);
    P := pointer(IDs);
    P[0] := '<';
    SynCommons.BinToHex(PAnsiChar(@FileID[0]),P+1,16);
    P[33] := '>';
    {$endif USE_PDFSECURITY}
    ID := TPdfArray.Create(FXref);
    ID.AddItem(TPdfRawText.Create(IDs));
    ID.AddItem(TPdfRawText.Create(IDs));
    FTrailer.Attributes.AddItem('ID',ID);
  end;
  {$ifdef USE_PDFSECURITY}
  if fEncryption<>nil then
    fEncryption.AttachDocument(self);
  {$endif USE_PDFSECURITY}
end;

function TPdfDocument.AddXObject(const AName: PDFString; AXObject: TPdfXObject): integer;
begin
  if GetXObject(AName)<>nil then
    raise EPdfInvalidValue.CreateFmt('AddXObject: dup name %s', [AName]);
  // check whether AImage is valid PdfImage or not.
  if (AXObject=nil) or (AXObject.Attributes=nil) or
    (AXObject.Attributes.TypeOf<>'XObject') or
    (AXObject.Attributes.PdfNameByName('Subtype')=nil) then
    raise EPdfInvalidValue.CreateFmt('AddXObject: invalid TPdfImage %s', [AName]);
  FXref.AddObject(AXObject);
  result := RegisterXObject(AXObject, AName);
end;

function TPdfDocument.AddPage: TPdfPage;
var FResources: TPdfDictionary;
begin
  if FCurrentPages=nil then
    raise EPdfInvalidOperation.Create('AddPage');
  // create a new page object and add it to the current pages dictionary
  result := fTPdfPageClass.Create(self);
  FXref.AddObject(result);
  fRawPages.Add(result); // pages may be nested
  _Pages_AddKids(FCurrentPages, result);
  result.AddItem('Type', 'Page');
  result.AddItem('Parent', FCurrentPages);
  // create page resources
  FResources := TPdfDictionary.Create(FXref);
  result.AddItem('Resources',FResources);
  FResources.AddItem('Font',TPdfDictionary.Create(FXref));
  FResources.AddItem('XObject',TPdfDictionary.Create(FXref));
  // create page content
  FResources.AddItem('ProcSet',TPdfArray.CreateNames(FXref,['PDF','Text','ImageC']));
  result.AddItem('Contents',TPdfStream.Create(self));
  // assign this page to the current PDF canvas
  FCanvas.SetPage(result);
end;

function TPdfDocument.AddTrueTypeFont(const TTFName: RawUtf8): boolean;
begin
  result := GetTrueTypeFontIndex(TTFName) < 0;
  if not result then
    exit;
  AddRawUTF8(FTrueTypeFonts,TTFName);
  QuickSortRawUTF8(FTrueTypeFonts,length(FTrueTypeFonts),nil,@StrIComp);
end;

procedure TPdfDocument.FreeDoc;
var i: integer;
begin
  if FXObjectList<>nil then begin
    FreeAndNil(FXObjectList);
    for i := FFontList.Count-1 downto 0 do
      TObject(FFontList.List[i]).Free;
    FreeAndNil(FFontList);
    for i := FObjectList.Count-1 downto 0 do
      TObject(FObjectList.List[i]).Free;
    FreeAndNil(FObjectList);
    FreeAndNil(FXref);
    FreeAndNil(FTrailer);
  end;
end;

procedure TPdfDocument.SaveToStream(AStream: TStream; ForceModDate: TDateTime=0);
begin
  if FCanvas.Page=nil then
    RaiseInvalidOperation;
  SaveToStreamDirectBegin(AStream,ForceModDate);
  SaveToStreamDirectEnd;
end;

procedure TPdfDocument.RaiseInvalidOperation;
begin
  raise EPdfInvalidOperation.Create('TPdfDocument.Document is null');
end;

function TPdfDocument.SaveToFile(const aFileName: TFileName): boolean;
var FS: TFileStream;
begin
  try
    FS := TFileStream.Create(aFileName,fmCreate);
    try
      SaveToStream(FS);
      result := true;
    finally
      FS.Free;
    end;
  except
    on E: Exception do // error on file creation (opened in reader?)
      result := false;
  end;
end;

procedure TPdfDocument.SaveToStreamDirectBegin(AStream: TStream;
  ForceModDate: TDateTime);
const PDFHEADER: array[TPdfFileFormat] of PDFString = (
    '%PDF-1.3'#10, '%PDF-1.4'#10'%'#228#229#230#240#10,
    '%PDF-1.5'#10'%'#241#242#243#244#10, '%PDF-1.6'#10'%'#245#246#247#248#10);
const PDFAPART:        array[TPdfALevel] of PDFString = ('', '1', '1', '2', '2', '3', '3');
const PDFACONFORMANCE: array[TPdfALevel] of PDFString = ('', 'A', 'B', 'A', 'B', 'A', 'B');
begin
  if fSaveToStreamWriter<>nil then
    raise EPdfInvalidOperation.Create('SaveToStreamDirectBegin called twice');
  // write all objects to specified stream
  if ForceModDate=0 then
    FInfo.ModDate := Now else
    FInfo.ModDate := ForceModDate;
  FRoot.SaveOpenAction;
  // some PDF/A-1 requirements
  if PDFA<>pdfaNone then begin
    FMetaData.Writer.Add(RawByteString(
      '<?xpacket begin="'#$EF#$BB#$BF'" id="W5M0MpCehiHzreSzNTczkc9d"?>'+
      '<x:xmpmeta xmlns:x="adobe:ns:meta/" x:xmptk="SynPdf">'+
      '<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">'+
      '<rdf:Description rdf:about="" xmlns:xmp="http://ns.adobe.com/xap/1.0/">'+
      '<xmp:CreateDate>')).AddIso8601(Info.CreationDate).Add('Z</xmp:CreateDate>'+
      '<xmp:ModifyDate>').AddIso8601(Info.ModDate).Add('Z</xmp:ModifyDate>'+
      '<xmp:CreatorTool>').Add(StringToUTF8(Info.Creator)).
       Add('</xmp:CreatorTool></rdf:Description>'+
      '<rdf:Description rdf:about="" xmlns:dc="http://purl.org/dc/elements/1.1/">'+
      '<dc:title><rdf:Alt><rdf:li xml:lang="x-default">').
       Add(StringToUTF8(Info.Title)).Add('</rdf:li></rdf:Alt></dc:title>'+
      '<dc:creator><rdf:Seq><rdf:li xml:lang="x-default">').
       Add(StringToUTF8(Info.Author)).Add('</rdf:li></rdf:Seq></dc:creator>'+
      '<dc:description><rdf:Alt><rdf:li xml:lang="x-default">').
       Add(StringToUTF8(Info.Subject)).Add('</rdf:li></rdf:Alt></dc:description>'+
      '</rdf:Description>'+
      '<rdf:Description rdf:about="" xmlns:pdf="http://ns.adobe.com/pdf/1.3/">'+
      '<pdf:Keywords>').Add(StringToUTF8(Info.Keywords)).Add('</pdf:Keywords>'+
      '<pdf:Producer>'+PDF_PRODUCER+'</pdf:Producer></rdf:Description>'+
      '<rdf:Description rdf:about="" xmlns:pdfaid="http://www.aiim.org/pdfa/ns/id/">'+
      '<pdfaid:part>'+PDFAPART[PDFA]+'</pdfaid:part><pdfaid:conformance>'+PDFACONFORMANCE[PDFA]+'</pdfaid:conformance>'+
      '</rdf:Description></rdf:RDF></x:xmpmeta><?xpacket end="w"?>');
  end;
  // write beginning of the content
  fSaveToStreamWriter := TPdfWrite.Create(self,AStream);
  fSaveToStreamWriter.Add(PDFHEADER[fFileformat]);
end;

procedure TPdfDocument.SaveToStreamDirectPageFlush(FlushCurrentPageNow: boolean);
var i: integer;
begin
  if (self=nil) or (fSaveToStreamWriter=nil) or (FCanvas.FPage=nil) then
    raise EPdfInvalidOperation.Create('SaveToStreamDirectPageFlush');
  if FlushCurrentPageNow then
    FCanvas.FPage.FSaveAtTheEnd := false;
  for i := 1 to FXref.ItemCount-1 do  // ignore FXref[0] = root PDF_FREE_ENTRY
    with FXref.Items[i] do
    if (ByteOffset<=0) and not Value.FSaveAtTheEnd then begin
      fByteOffset := fSaveToStreamWriter.Position;
      Value.WriteValueTo(fSaveToStreamWriter);
    end;
end;

procedure TPdfDocument.SaveToStreamDirectEnd;
var i: integer;
begin
  if (self=nil) or (fSaveToStreamWriter=nil) then
    raise EPdfInvalidOperation.Create('SaveToStreamDirectEnd');
  try
    // saving outline tree
    if UseOutlines then
      FOutlineRoot.Save;
    // update font details after all the pages are drawn
    for i := 0 to FFontList.Count-1 do
    with TPdfFontTrueType(FFontList.List[i]) do
      if fTrueTypeFontsIndex<>0 then
        PrepareForSaving;
    // write pending objects
    if fFileFormat>=pdf15 then
      FTrailer.ToCrossReference(self);
    for i := 1 to FXref.ItemCount-1 do
      with FXref.Items[i] do
      if ByteOffset<=0 then begin
        fByteOffset := fSaveToStreamWriter.Position;
        if Value<>FTrailer.FCrossReference then
          Value.WriteValueTo(fSaveToStreamWriter);
      end;
    FTrailer.XrefAddress := fSaveToStreamWriter.Position;
    if fFileFormat<pdf15 then
      FXref.WriteTo(fSaveToStreamWriter);
    FTrailer.Attributes.PdfNumberByName('Size').Value := FXref.ItemCount;
    FTrailer.WriteTo(fSaveToStreamWriter);
    fSaveToStreamWriter.Save; // flush TPdfWrite buffer into AStream
  finally
    FreeAndNil(fSaveToStreamWriter);
  end;
end;

procedure TPdfDocument.RegisterFont(aFont: TPdfFont);
var st: shortstring;
begin
  // fonts are not registered as xref, but registered in FontList[]
  str(FFontList.Count,st);
  aFont.FShortCut := 'F'+PDFString(st);
  aFont.Data.AddItem('Name', aFont.FShortCut);
  FFontList.Add(aFont);
end;

function TPdfDocument.GetRegisteredNotTrueTypeFont(const APDFFontName: PDFString): TPdfFont;
var i: integer;
begin
  // if specified standard font exists in fontlist, returns it
  with FFontList do
    for i := 0 to Count-1 do begin
      result := TPdfFont(List[i]);
      if (result.FTrueTypeFontsIndex=0) and
         (result.Name=APDFFontName) then
        exit;
    end;
  result := nil;
end;

function TPdfDocument.GetRegisteredTrueTypeFont(AFontIndex: integer;
  AStyle: TPdfFontStyles; ACharSet: byte): TPdfFont;
var i: integer;
begin
  // if specified font exists in fontlist, returns the WinAnsi version
  if AFontIndex>=0 then
  with FFontList do
    for i := 0 to Count-1 do begin
      result := TPdfFont(List[i]);
      if (result.FTrueTypeFontsIndex=AFontIndex) and
         not TPdfFontTrueType(result).Unicode and
         (TPdfFontTrueType(result).Style=AStyle) and
         (TPdfFontTrueType(result).fLogFont.lfCharSet=ACharSet) then
        exit;
    end;
  result := nil;
end;

function CompareLogFontW(const L1,L2: TLogFontW): boolean;
  {$ifdef HASINLINE}inline;{$endif}
begin
  if (L1.lfWeight<>L2.lfWeight) or (L1.lfItalic<>L2.lfItalic) then
    // ignore lfHeight/lfUnderline/lfStrikeOut:
    // font size/underline/strike are internal to PDF graphics state
    result := false else
    result := (AnsiICompW(L1.lfFaceName,L2.lfFaceName)=0);
end;

function TPdfDocument.GetTrueTypeFontIndex(const AName: RawUTF8): integer;
begin
  if StrIComp(pointer(FTrueTypeFontLastName),pointer(AName))=0 then begin
    result := FTrueTypeFontLastIndex; // simple but efficient cache
    exit;
  end;
  result := FastFindPUTF8CharSorted(pointer(FTrueTypeFonts),high(FTrueTypeFonts),pointer(AName),@StrIComp);
  if result>=0 then begin
    FTrueTypeFontLastName := AName;
    FTrueTypeFontLastIndex := result;
  end;
end;

function TPdfDocument.GetRegisteredTrueTypeFont(const AFontLog: TLogFontW): TPdfFont;
var i: integer;
begin
  // if specified font exists in fontlist, returns the WinAnsi version
  with FFontList do
    for i := 0 to Count-1 do begin
      result := TPdfFont(List[i]);
      if (result.FTrueTypeFontsIndex<>0) and
         not TPdfFontTrueType(result).Unicode and
        CompareLogFontW(TPdfFontTrueType(result).fLogFont,AFontLog) then
        exit;
    end;
  result := nil;
end;

procedure TPdfDocument.SetStandardFontsReplace(const Value: boolean);
begin
  if FCharSet<>ANSI_CHARSET then
    FStandardFontsReplace := false else
    FStandardFontsReplace := Value;
end;

function TPdfDocument.GetEmbeddedTTFIgnore: TRawUTF8List;
begin
  if fEmbeddedTTFIgnore=nil then
    fEmbeddedTTFIgnore := TRawUTF8List.Create([fCaseSensitive,fNoDuplicate]);
  result := fEmbeddedTTFIgnore;
end;

procedure TPdfDocument.SetDefaultPaperSize(const Value: TPDFPaperSize);
const PAPERSIZE: array[TPDFPaperSize] of array[0..1] of integer =
  ( (595,842), (419,595), (842,1190), (1190,1683), (1683,2382), (2382,3369),
    (612,792), (612,1008), (0,0) );
begin // psA4, psA5, psA3, psA2, psA1, psA0, psLetter, psLegal, psUserDefined
  FDefaultPaperSize := Value;
  if Value<>psUserDefined then begin
    FDefaultPageWidth := PAPERSIZE[Value,0];
    FDefaultPageHeight := PAPERSIZE[Value,1];
  end;
end;

procedure TPdfDocument.SetDefaultPageHeight(const Value: cardinal);
begin
  FDefaultPageHeight := Value;
  FDefaultPaperSize := psUserDefined;
end;

procedure TPdfDocument.SetDefaultPageWidth(const Value: cardinal);
begin
  FDefaultPageWidth := Value;
  FDefaultPaperSize := psUserDefined;
end;

function TPdfDocument.GetDefaultPageLandscape: boolean;
begin
  result := FDefaultPageWidth>FDefaultPageHeight;
end;

procedure TPdfDocument.SetDefaultPageLandscape(const Value: boolean);
var tmp: integer;
begin
  if Value<>DefaultPageLandscape then begin
    tmp := FDefaultPageHeight;
    FDefaultPageHeight := FDefaultPageWidth;
    FDefaultPageWidth := tmp;
  end;
end;

function TPdfDocument.GetDCWithFont(TTF: TPdfFontTrueType): HDC;
begin
  if self=nil then
    result := 0 else begin
    if fSelectedDCFontOld<>0 then // prevent resource leak
      SelectObject(FDC,fSelectedDCFontOld);
    fSelectedDCFontOld := SelectObject(FDC,TTF.fHGDI);
    result := fDC;
  end;
end;

const
  TTFCFP_MAC_PLATFORMID = 1;
  TTFCFP_MS_PLATFORMID = 3;
  TTFCFP_SYMBOL_CHAR_SET = 0;
  TTFCFP_UNICODE_CHAR_SET = 1;
  TTFCFP_DONT_CARE = 65535;

  TTFCFP_FLAGS_SUBSET = 1;
  TTFMFP_SUBSET = 0;
  TTFCFP_FLAGS_TTC = 4;
  HEAD_TABLE = $64616568; // 'head'
  TTCF_TABLE = $66637474; // 'ttcf'

type
  /// a TTF name record used for the 'name' Format 4 table
  TNameRecord = packed record
    platformID: word;
    encodingID: word;
    languageID: word;
    nameID: word;
    length: word;
    offset: word;
  end;
  /// header for the 'name' Format 4 table
  TNameFmt4 = packed record
    /// Format selector (=0/1)
    format: word;
    /// Number of name records
    count: word;
    /// Offset to start of string storage (from start of table)
    stringOffset: word;
    /// The name records where count is the number of records
    FirstNameRecord: TNameRecord;
  end;

function TrueTypeFontName(const aFontName: RawUTF8; AStyle: TPdfFontStyles): PDFString;
var i: Integer;
begin // from PDF 1.3 #5.5.2
  SetString(result,PAnsiChar(pointer(aFontName)),length(aFontName));
  for i := length(result) downto 1 do
    if (Result[i]<=' ') or (Result[i]>=#127) then
      Delete(result,i,1); // spaces and not ASCII chars are removed
  if not IsAnsiCompatible(aFontName) then // unique non-void font name
    result := result+PDFString(CardinalToHexLower(
      crc32c(0,pointer(aFontName),length(aFontName))));
  if pfsItalic in AStyle then
    if pfsBold in AStyle then
      result := result+',BoldItalic' else
      result := result+',Italic' else
    if pfsBold in AStyle then
      result := result+',Bold';
end;

function TPdfDocument.TTFFontPostcriptName(aFontIndex: integer; AStyle: TPdfFontStyles;
  AFont: TPdfFontTrueType): PDFString;
// see http://www.microsoft.com/typography/OTSPEC/name.htm
const NAME_POSTCRIPT = 6;
var fName: TWordDynArray;
    name: ^TNameFmt4;
    aFontName: RawUTF8;
    i, L: integer;
    Rec: ^TNameRecord;
    PW: pointer;
begin
  aFontName := FTrueTypeFonts[aFontIndex];
  if IsAnsiCompatible(aFontName) or (AFont=nil) then begin
    result := TrueTypeFontName(aFontName,AStyle);
    exit; // no need to search for the PostScript name field in TTF content
  end;
  name := GetTTFData(GetDCWithFont(AFont),'name',fName);
  if (name=nil) or (name^.format<>0) then
    exit;
  Rec := @name^.FirstNameRecord;
  for i := 0 to name^.count-1 do
    if (Rec^.nameID=NAME_POSTCRIPT) and (Rec^.platformID=TTFCFP_MS_PLATFORMID) and
       (Rec^.encodingID=1) and (Rec^.languageID=$409) then begin
      PW := PAnsiChar(name)+name^.stringOffset+Rec^.offset;
      L := Rec^.length shr 1;
      if Rec^.offset and 1<>0 then begin // fix GetTTFData() wrong SwapBuffer()
        dec(PByte(PW));
        SwapBuffer(PW,L+1); // restore big-endian original unaligned buffer
        inc(PByte(PW));
        SwapBuffer(PW,L);   // convert from big-endian at correct odd offset
      end;
      RawUnicodeToUtf8(PW,L,aFontName);
      result := TrueTypeFontName(aFontName,AStyle); // adjust name and style
      exit;
    end else
    inc(Rec);
end;

function TPdfDocument.CreateOutline(const Title: string; Level: integer;
  TopPosition: Single): TPdfOutlineEntry;
begin
  result := nil;
  if self=nil then
    exit;
  if fLastOutline=nil then begin
    if not UseOutlines then
      exit; // will raise a GPF otherwise
    result := OutlineRoot;
  end else begin
    result := fLastOutline;
    while (Level<=result.Level) and (result.Parent<>nil) do
      result := result.Parent;
  end;
  result := result.AddChild(Trunc(TopPosition));
  result.Title := Title;
  result.Level := Level;
  fLastOutline := result;
end;

{$ifdef USE_BITMAP}
function TPdfDocument.CreateOrGetImage(B: TBitmap; DrawAt: PPdfBox; ClipRc: PPdfBox): PDFString;
var J: TJpegImage;
    Img: TPdfImage;
    Hash: THash128Rec;
    y,w,h,row: integer;
    nPals: cardinal;
    Pals: array of TPaletteEntry;
const PERROW: array[TPixelFormat] of byte = (0,1,4,8,15,16,24,32,0);
  procedure DoHash(bits: pointer; size: Integer);
  begin
    Hash.c0 := crc32c(Hash.c0,bits,size);
    Hash.c1 := crc32c(Hash.c1,bits,size);
    Hash.c2 := Hash.c2+Hash.c0; // naive, but sufficient, cascading
    Hash.c3 := Hash.c3+Hash.c1;
  end;
begin
  result := '';
  if (self=nil) or (B=nil) then exit;
  w := B.Width;
  h := B.Height;
  if ForceNoBitmapReuse then
    FillCharFast(Hash,sizeof(Hash),0) else begin
    row := PERROW[B.PixelFormat];
    if row=0 then begin
      B.PixelFormat := pf24bit;
      row := 24;
    end;
    Hash.c0 := 0;
    Hash.c1 := 1400305337; // 3 prime numbers
    Hash.c2 := 2468776129;
    Hash.c3 := 3121238909;
    if B.Palette<>0 then begin
      nPals := 0;
      if (GetObject(B.Palette,sizeof(nPals),@nPals)<>0) and (nPals>0) then begin
        SetLength(Pals,nPals);
        if GetPaletteEntries(B.Palette,0,nPals,Pals[0])=nPals then
          DoHash(pointer(Pals),nPals*sizeof(TPaletteEntry));
      end;
    end;
    row := BytesPerScanline(w,row,32);
    for y := 0 to h-1 do
      DoHash(B.ScanLine[y],row);
    result := GetXObjectImageName(Hash,w,h); // search for matching image
  end;
  if result='' then begin
     // create new if no existing TPdfImage match
    if ForceJPEGCompression=0 then
      Img := TPdfImage.Create(Canvas.fDoc,B,True) else begin
      J := TJpegImage.Create;
      try
        J.Assign(B);
        Img := TPdfImage.Create(Canvas.fDoc,J,False);
      finally
        J.Free;
      end;
    end;
    Img.fHash := Hash;
    result := 'SynImg'+UInt32ToPDFString(FXObjectList.ItemCount);
    if ForceJPEGCompression=0 then
      AddXObject(result,Img) else
      RegisterXObject(Img, result);
  end;
  // draw bitmap as XObject
  if DrawAt<>nil then begin
    if ClipRc<>nil then
      with DrawAt^ do
        Canvas.DrawXObjectEx(Left,Top,Width,Height,
          ClipRc^.Left,ClipRc^.Top,ClipRc^.Width,ClipRc^.Height, result) else
      with DrawAt^ do
        Canvas.DrawXObject(Left,Top,Width,Height, result);
  end;
end;
{$endif USE_BITMAP}

function TPdfDocument.CreateOptionalContentGroup(
  ParentContentGroup: TPdfOptionalContentGroup;
  const Title: string; Visible: Boolean): TPdfOptionalContentGroup;
var Dico, DicoD: TPdfDictionary;
    Arr: TPDFArray;

  function FindParentContentGroupArray(Current: TPDFArray): TPDFArray;
  var i: Integer;
  begin
    result := nil;
    if Current=nil then
      exit;
    for i := 0 to Current.ItemCount-1 do
      if Current.Items[i]=ParentContentGroup then begin
        if (i<Current.ItemCount-1) and Current.Items[i+1].InheritsFrom(TPDFArray) then
          result := TPDFArray(Current.Items[i+1]) else begin
          result := TPDFArray.Create(FXRef);
          Current.InsertItem(i+1, result);
        end;
        exit;
      end;
    for i := 0 to Current.ItemCount-1 do
      if Current.Items[i].InheritsFrom(TPDFArray) then begin
        result := FindParentContentGroupArray(TPDFArray(Current.Items[i]));
        if result<>nil then
          exit;
      end;
  end;

begin
  if FUseOptionalContent then begin
    result := TPdfOptionalContentGroup.Create(FXRef);
    FXref.AddObject(result);
    result.AddItem('Type','OCG');
    result.AddItemTextString('Name',Title);
    Dico := FRoot.Data.PdfDictionaryByName('OCProperties');
    if Dico<>nil then begin
      DicoD := Dico.PdfDictionaryByName('D');
      if DicoD<>nil then begin
        Arr := DicoD.PdfArrayByName('Order');
        if ParentContentGroup<>nil then
          Arr := FindParentContentGroupArray(Arr);
        if Arr<>nil then
          Arr.AddItem(result);
        if not Visible then begin
          Arr := DicoD.PdfArrayByName('OFF');
          if Arr<>nil then
            Arr.AddItem(result);
        end;
      end;
      Arr := Dico.PdfArrayByName('OCGs');
      if Arr<>nil then
        Arr.AddItem(result);
    end;
  end else
    result := nil;
end;

procedure TPdfDocument.CreateOptionalContentRadioGroup(
  const ContentGroups: array of TPdfOptionalContentGroup);
var i: Integer;
    Dico, DicoD: TPdfDictionary;
    Arr, RadioArr: TPDFArray;
begin
  if FUseOptionalContent and (Length(ContentGroups)>0) then begin
    Dico := FRoot.Data.PdfDictionaryByName('OCProperties');
    if Dico<>nil then begin
      DicoD := Dico.PdfDictionaryByName('D');
      if DicoD<>nil then begin
        Arr := DicoD.PdfArrayByName('RBGroups');
        if Arr<>nil then begin
          RadioArr := TPDFArray.Create(FXref);
          for i  :=  Low(ContentGroups) to High(ContentGroups) do
            if ContentGroups[i]<>nil then
              RadioArr.AddItem(ContentGroups[i]);
          if RadioArr.ItemCount>0 then
            Arr.AddItem(RadioArr) else
            FreeAndNil(RadioArr);
        end;
      end;
    end;
  end;
end;

procedure TPdfDocument.SetUseOptionalContent(const Value: boolean);
begin
  FUseOptionalContent := Value;
  NewDoc;
end;

procedure TPdfDocument.SetPDFA(const Value: TPdfALevel);
begin
  fPDFA := Value;
  NewDoc;
end;

{$ifndef USE_PDFALEVEL}
function  TPdfDocument.GetPDFA1: boolean;
begin
  result := (fPDFA = pdfa1B);
end;

procedure TPdfDocument.SetPDFA1(const Value: boolean);
begin
  if Value then
    SetPDFA(pdfa1B) else
    SetPDFA(pdfaNone);
end;
{$endif USE_PDFALEVEL}

procedure TPdfDocument.SetFontFallBackName(const Value: string);
begin
  fFontFallBackIndex := GetTrueTypeFontIndex(StringToUTF8(Value));
end;

function TPdfDocument.GetFontFallBackName: string;
begin
  if fFontFallBackIndex>=0 then
    result := UTF8ToString(FTrueTypeFonts[fFontFallBackIndex]) else
    result := '';
end;

function TPdfDocument.GetGeneratePDF15File: boolean;
begin
  result := (self<>nil) and (fFileFormat>=pdf15);
end;

procedure TPdfDocument.SetGeneratePDF15File(const Value: boolean);
begin
  if fFileFormat<>pdf16 then
    if Value then
      fFileFormat := pdf15 else
      fFileFormat := pdf14;
end;


{ TPdfCanvas }

constructor TPdfCanvas.Create(APdfDoc: TPdfDocument);
begin
  FDoc := APdfDoc;
  FFactor := 72/FDoc.FScreenLogPixels; // PDF expect 72 pixels per inch
  FFactorX := FFactor;
  FFactorY := FFactor;
  FDevScaleX := 1;
  FDevScaleY := 1;
  FMappingMode := MM_TEXT;
  fUseMetaFileTextPositioning := tpSetTextJustification;
  fKerningHScaleBottom := 99.0;
  fKerningHScaleTop := 101.0;
end;

function TPdfCanvas.GetPage: TPdfPage;
begin
  if (Self<>nil) and (FPage<>nil) then
    result := FPage else
    raise EPdfInvalidOperation.Create('GetPage');
end;

procedure TPdfCanvas.SetPage(APage: TPdfPage);
begin
  FPage := APage;
  FPageFontList := FPage.GetResources('Font');
  FContents := TPdfStream(FPage.ValueByName('Contents'));
  FFactor := 72/FDoc.FScreenLogPixels; // PDF expect 72 pixels per inch
end;

procedure TPdfCanvas.SetPDFFont(AFont: TPdfFont; ASize: Single);
begin
  // check if this font is already the current font
  if (AFont=nil) or ((FPage.Font=AFont) and (FPage.FontSize=ASize)) then
    Exit;
  // add this font to the resource array of the current page
  if FPageFontList.ValueByName(AFont.ShortCut)=nil then
    FPageFontList.AddItem(AFont.ShortCut, AFont.Data);
  // change the font
  if FContents<>nil then
    SetFontAndSize(AFont.ShortCut, ASize); // e.g. SetFontAndSize('F0',12)
  FPage.Font := AFont;
  FPage.FontSize := ASize;
end;

procedure InitializeLogFontW(const aFontName: RawUTF8; aStyle: TPdfFontStyles;
  var aFont: TLogFontW);
begin
  FillCharFast(AFont,sizeof(AFont),0);
  with aFont do begin
    lfHeight := -1000;
    if pfsBold in AStyle then
      lfWeight := FW_BOLD else
      lfWeight := FW_NORMAL;
    lfItalic := Byte(pfsItalic in AStyle);
    lfUnderline := Byte(pfsUnderline in AStyle);
    lfStrikeOut := Byte(pfsStrikeOut in AStyle);
    UTF8ToWideChar(lfFaceName,Pointer(aFontName));
  end;
end;

const // see PDF ref 9.6.2.2: Standard Type 1 Fonts
  // WidthArray[30]=Ascent, WidthArray[31]=Descent,
  // WidthArray[32..255]=Width(#32..#255)
  ARIAL_W_ARRAY: array[30..255] of SmallInt = (
    905,-212,278,278,355,556,556,889,667,191,333,333,389,584,278,333,
    278,278,556,556,556,556,556,556,556,556,556,556,278,278,584,584,
    584,556,1015,667,667,722,722,667,611,778,722,278,500,667,556,833,
    722,778,667,778,722,667,611,722,667,944,667,667,611,278,278,278,
    469,556,333,556,556,500,556,556,278,556,556,222,222,500,222,833,
    556,556,556,556,333,500,278,556,500,722,500,500,500,334,260,334,
    584,0,556,0,222,556,333,1000,556,556,333,1000,667,333,1000,0,
    611,0,0,222,222,333,333,350,556,1000,333,1000,500,333,944,0,
    500,667,0,333,556,556,556,556,260,556,333,737,370,556,584,0,
    737,333,400,584,333,333,333,556,537,278,333,333,365,556,834,834,
    834,611,667,667,667,667,667,667,1000,722,667,667,667,667,278,278,
    278,278,722,722,778,778,778,778,778,584,778,722,722,722,722,667,
    667,611,556,556,556,556,556,556,889,500,556,556,556,556,278,278,
    278,278,556,556,556,556,556,556,556,584,611,556,556,556,556,500,556,500);
  ARIAL_BOLD_W_ARRAY: array[30..255] of SmallInt = (
    905,-212,278,333,474,556,556,889,722,238,333,333,389,584,278,333,
    278,278,556,556,556,556,556,556,556,556,556,556,333,333,584,584,
    584,611,975,722,722,722,722,667,611,778,722,278,556,722,611,833,
    722,778,667,778,722,667,611,722,667,944,667,667,611,333,278,333,
    584,556,333,556,611,556,611,556,333,611,611,278,278,556,278,889,
    611,611,611,611,389,556,333,611,556,778,556,556,500,389,280,389,
    584,0,556,0,278,556,500,1000,556,556,333,1000,667,333,1000,0,
    611,0,0,278,278,500,500,350,556,1000,333,1000,556,333,944,0,
    500,667,0,333,556,556,556,556,280,556,333,737,370,556,584,0,
    737,333,400,584,333,333,333,611,556,278,333,333,365,556,834,834,
    834,611,722,722,722,722,722,722,1000,722,667,667,667,667,278,278,
    278,278,722,722,778,778,778,778,778,584,778,722,722,722,722,667,
    667,611,556,556,556,556,556,556,889,556,556,556,556,556,278,278,
    278,278,611,611,611,611,611,611,611,584,611,611,611,611,611,556,611,556);
  ARIAL_ITALIC_W_ARRAY: array[30..255] of SmallInt = (
    905,-212,278,278,355,556,556,889,667,191,333,333,389,584,278,333,
    278,278,556,556,556,556,556,556,556,556,556,556,278,278,584,584,
    584,556,1015,667,667,722,722,667,611,778,722,278,500,667,556,833,
    722,778,667,778,722,667,611,722,667,944,667,667,611,278,278,278,
    469,556,333,556,556,500,556,556,278,556,556,222,222,500,222,833,
    556,556,556,556,333,500,278,556,500,722,500,500,500,334,260,334,
    584,0,556,0,222,556,333,1000,556,556,333,1000,667,333,1000,0,
    611,0,0,222,222,333,333,350,556,1000,333,1000,500,333,944,0,
    500,667,0,333,556,556,556,556,260,556,333,737,370,556,584,0,
    737,333,400,584,333,333,333,556,537,278,333,333,365,556,834,834,
    834,611,667,667,667,667,667,667,1000,722,667,667,667,667,278,278,
    278,278,722,722,778,778,778,778,778,584,778,722,722,722,722,667,
    667,611,556,556,556,556,556,556,889,500,556,556,556,556,278,278,
    278,278,556,556,556,556,556,556,556,584,611,556,556,556,556,500,556,500);
  ARIAL_BOLDITALIC_W_ARRAY: array[30..255] of SmallInt = (
    905,-212,278,333,474,556,556,889,722,238,333,333,389,584,278,333,
    278,278,556,556,556,556,556,556,556,556,556,556,333,333,584,584,
    584,611,975,722,722,722,722,667,611,778,722,278,556,722,611,833,
    722,778,667,778,722,667,611,722,667,944,667,667,611,333,278,333,
    584,556,333,556,611,556,611,556,333,611,611,278,278,556,278,889,
    611,611,611,611,389,556,333,611,556,778,556,556,500,389,280,389,
    584,0,556,0,278,556,500,1000,556,556,333,1000,667,333,1000,0,
    611,0,0,278,278,500,500,350,556,1000,333,1000,556,333,944,0,
    500,667,0,333,556,556,556,556,280,556,333,737,370,556,584,0,
    737,333,400,584,333,333,333,611,556,278,333,333,365,556,834,834,
    834,611,722,722,722,722,722,722,1000,722,667,667,667,667,278,278,
    278,278,722,722,778,778,778,778,778,584,778,722,722,722,722,667,
    667,611,556,556,556,556,556,556,889,556,556,556,556,556,278,278,
    278,278,611,611,611,611,611,611,611,584,611,611,611,611,611,556,611,556);
  TIMES_ROMAN_W_ARRAY: array[30..255] of SmallInt = (
    891,-216,250,333,408,500,500,833,778,180,333,333,500,564,250,333,
    250,278,500,500,500,500,500,500,500,500,500,500,278,278,564,564,
    564,444,921,722,667,667,722,611,556,722,722,333,389,722,611,889,
    722,722,556,722,667,556,611,722,722,944,722,722,611,333,278,333,
    469,500,333,444,500,444,500,444,333,500,500,278,278,500,278,778,
    500,500,500,500,333,389,278,500,500,722,500,500,444,480,200,480,
    541,0,500,0,333,500,444,1000,500,500,333,1000,556,333,889,0,
    611,0,0,333,333,444,444,350,500,1000,333,980,389,333,722,0,
    444,722,0,333,500,500,500,500,200,500,333,760,276,500,564,0,
    760,333,400,564,300,300,333,500,453,250,333,300,310,500,750,750,
    750,444,722,722,722,722,722,722,889,667,611,611,611,611,333,333,
    333,333,722,722,722,722,722,722,722,564,722,722,722,722,722,722,
    556,500,444,444,444,444,444,444,667,444,444,444,444,444,278,278,
    278,278,500,500,500,500,500,500,500,564,500,500,500,500,500,500,500,500);
  TIMES_ITALIC_W_ARRAY: array[30..255] of SmallInt = (
    891,-216,250,333,420,500,500,833,778,214,333,333,500,675,250,333,
    250,278,500,500,500,500,500,500,500,500,500,500,333,333,675,675,
    675,500,920,611,611,667,722,611,611,722,722,333,444,667,556,833,
    667,722,611,722,611,500,556,722,611,833,611,556,556,389,278,389,
    422,500,333,500,500,444,500,444,278,500,500,278,278,444,278,722,
    500,500,500,500,389,389,278,500,444,667,444,444,389,400,275,400,
    541,0,500,0,333,500,556,889,500,500,333,1000,500,333,944,0,
    556,0,0,333,333,556,556,350,500,889,333,980,389,333,667,0,
    389,556,0,389,500,500,500,500,275,500,333,760,276,500,675,0,
    760,333,400,675,300,300,333,500,523,250,333,300,310,500,750,750,
    750,500,611,611,611,611,611,611,889,667,611,611,611,611,333,333,
    333,333,722,667,722,722,722,722,722,675,722,722,722,722,722,556,
    611,500,500,500,500,500,500,500,667,444,444,444,444,444,278,278,
    278,278,500,500,500,500,500,500,500,675,500,500,500,500,500,444,500,444);
  TIMES_BOLD_W_ARRAY: array[30..255] of SmallInt = (
    891,-216,250,333,555,500,500,1000,833,278,333,333,500,570,250,333,
    250,278,500,500,500,500,500,500,500,500,500,500,333,333,570,570,
    570,500,930,722,667,722,722,667,611,778,778,389,500,778,667,944,
    722,778,611,778,722,556,667,722,722,1000,722,722,667,333,278,333,
    581,500,333,500,556,444,556,444,333,500,556,278,333,556,278,833,
    556,500,556,556,444,389,333,556,500,722,500,500,444,394,220,394,
    520,0,500,0,333,500,500,1000,500,500,333,1000,556,333,1000,0,
    667,0,0,333,333,500,500,350,500,1000,333,1000,389,333,722,0,
    444,722,0,333,500,500,500,500,220,500,333,747,300,500,570,0,
    747,333,400,570,300,300,333,556,540,250,333,300,330,500,750,750,
    750,500,722,722,722,722,722,722,1000,722,667,667,667,667,389,389,
    389,389,722,722,778,778,778,778,778,570,778,722,722,722,722,722,
    611,556,500,500,500,500,500,500,722,444,444,444,444,444,278,278,
    278,278,500,556,500,500,500,500,500,570,500,556,556,556,556,500,556,500);
  TIMES_BOLDITALIC_W_ARRAY: array[30..255] of SmallInt = (
    891,-216,250,389,555,500,500,833,778,278,333,333,500,570,250,333,
    250,278,500,500,500,500,500,500,500,500,500,500,333,333,570,570,
    570,500,832,667,667,667,722,667,667,722,778,389,500,667,611,889,
    722,722,611,722,667,556,611,722,667,889,667,611,611,333,278,333,
    570,500,333,500,500,444,500,444,333,500,556,278,278,500,278,778,
    556,500,500,500,389,389,278,556,444,667,500,444,389,348,220,348,
    570,0,500,0,333,500,500,1000,500,500,333,1000,556,333,944,0,
    611,0,0,333,333,500,500,350,500,1000,333,1000,389,333,722,0,
    389,611,0,389,500,500,500,500,220,500,333,747,266,500,606,0,
    747,333,400,570,300,300,333,576,500,250,333,300,300,500,750,750,
    750,500,667,667,667,667,667,667,944,667,667,667,667,667,389,389,
    389,389,722,722,722,722,722,722,722,570,722,722,722,722,722,611,
    611,500,500,500,500,500,500,500,722,444,444,444,444,444,278,278,
    278,278,500,556,500,500,500,500,500,570,500,556,556,556,556,444,500,444);
  STANDARDFONTS: array[0..11] of record
    Name: PDFString;
    Widths: PSmallIntArray;
  end = (
    (Name: 'Times-Roman'; Widths: @TIMES_ROMAN_W_ARRAY),
    (Name: 'Times-Bold'; Widths: @TIMES_BOLD_W_ARRAY),
    (Name: 'Times-Italic'; Widths: @TIMES_ITALIC_W_ARRAY),
    (Name: 'Times-BoldItalic'; Widths: @TIMES_BOLDITALIC_W_ARRAY),
    (Name: 'Helvetica'; Widths: @ARIAL_W_ARRAY),
    (Name: 'Helvetica-Bold'; Widths: @ARIAL_BOLD_W_ARRAY),
    (Name: 'Helvetica-Oblique'; Widths: @ARIAL_ITALIC_W_ARRAY),
    (Name: 'Helvetica-BoldOblique'; Widths: @ARIAL_BOLDITALIC_W_ARRAY),
    (Name: 'Courier'; Widths: nil), // Widths:nil -> set all widths to 600
    (Name: 'Courier-Bold'; Widths: nil),
    (Name: 'Courier-Oblique'; Widths: nil),
    (Name: 'Courier-BoldOblique'; Widths: nil));

function TPdfCanvas.SetFont(const AName: RawUTF8; ASize: single; AStyle: TPdfFontStyles;
  ACharSet: integer=-1; AForceTTF: integer=-1; AIsFixedWidth: boolean=false): TPdfFont;
const
  STAND_FONTS_PDF: array[TPdfFontStandard] of RawUTF8 = ('Times','Helvetica','Courier');
  STAND_FONTS_WIN: array[TPdfFontStandard] of RawUTF8 = ('Times New Roman','Arial','Courier New');
  STAND_FONTS_UPPER: array[TPdfFontStandard] of PAnsiChar = ('TIMES','HELVETICA','COURIER');
  procedure SetEmbeddedFont(Standard: TPdfFontStandard);
  var BaseIndex: integer;
  begin
    BaseIndex := ord(Standard)*4+(byte(AStyle) and 3);
    result := fDoc.GetRegisteredNotTrueTypeFont(STANDARDFONTS[BaseIndex].Name);
    if result=nil then begin // font not already registered -> add now
      with STANDARDFONTS[BaseIndex] do
        result := TPdfFontType1.Create(fDoc.FXref,Name,Widths);
      fDoc.RegisterFont(result);
    end;
    SetPDFFont(result,ASize); 
  end;
var AFont: TLogFontW;
    FontIndex: integer;
    f: TPdfFontStandard;
begin
  result := nil;
  if (self=nil) or (FDoc=nil) then
    exit; // avoid GPF
  if AForceTTF>=0 then
    // an existing true type font has been specified
    FontIndex := AForceTTF else begin
    // handle use embedded fonts for standard fonts, if needed
    if (fDoc.FCharSet=ANSI_CHARSET) and fDoc.StandardFontsReplace then begin
      // standard/embedded fonts are WinAnsi only
      for f := low(f) to high(f) do
        if SameTextU(AName,STAND_FONTS_PDF[f]) or
           SameTextU(AName,STAND_FONTS_WIN[f]) then begin
          SetEmbeddedFont(f);
          if result<>nil then
            exit; // we got a standard/embedded font
        end;
    end;
    if (FPreviousRasterFontName<>'') and (FPreviousRasterFontName=AName) then
      FontIndex := FPreviousRasterFontIndex else begin
      // search the font in the global system-wide true type fonts list
      FontIndex := fDoc.GetTrueTypeFontIndex(AName);
      if FontIndex<0 then begin // unknown, device or raster font
        if AIsFixedWidth then // sounds to be fixed-width -> set 'Courier New'
          FontIndex := fDoc.GetTrueTypeFontIndex(STAND_FONTS_WIN[pfsCourier]);
        // do not exist as is: find equivalency of some "standard" font
        for f := low(f) to high(f) do
          if (FontIndex<0) and IdemPChar(pointer(AName),STAND_FONTS_UPPER[f]) then
            FontIndex := fDoc.GetTrueTypeFontIndex(STAND_FONTS_WIN[f]);
        if FontIndex<0 then begin // use variable width default font
          FontIndex := FDoc.fFontFallBackIndex;
          if FontIndex<0 then
            FontIndex := fDoc.GetTrueTypeFontIndex('Arial');
          if FontIndex<0 then
            exit;
        end;
        FPreviousRasterFontName := AName;
        FPreviousRasterFontIndex := FontIndex;
      end;
    end;
  end;
  if ACharSet<0 then
    ACharSet := fDoc.CharSet; // force the current PDF Document charset
  result := fDoc.GetRegisteredTrueTypeFont(FontIndex+1,AStyle,ACharSet);
  if result=nil then begin
    // a font of this kind is not already registered -> create it
    FillCharFast(AFont,sizeof(AFont),0);
    with AFont do begin
      lfHeight := -1000;
      if pfsBold in AStyle then
        lfWeight := FW_BOLD else
        lfWeight := FW_NORMAL;
      lfItalic := Byte(pfsItalic in AStyle);
      lfUnderline := Byte(pfsUnderline in AStyle);
      lfStrikeOut := Byte(pfsStrikeOut in AStyle);
      lfCharSet := ACharSet;
      UTF8ToWideChar(lfFaceName,Pointer(fDoc.FTrueTypeFonts[FontIndex]));
    end;
    // we register now the WinAnsi font to the associated fDoc
    result := TPdfFontTrueType.Create(fDoc,FontIndex,AStyle,AFont,nil);
  end;
  if AForceTTF<0 then
    SetPDFFont(result,ASize);
end;

function TPdfCanvas.SetFont(ADC: HDC; const ALogFont: TLogFontW; ASize: single): TPdfFont;
var AStyle: TPdfFontStyles;
    AName: RawUTF8;
begin
  // try if the font is already registered
  result := fDoc.GetRegisteredTrueTypeFont(ALogFont);
  if Result<>nil then begin
    SetPDFFont(result,ASize); // use the existing font, update size if necessary
    exit;
  end;
  // font is not existing -> create new
  AName := RawUnicodeToUtf8(ALogFont.lfFaceName,StrLenW(ALogFont.lfFaceName));
  if ALogFont.lfItalic<>0 then
    AStyle := [pfsItalic] else
    byte(AStyle) := 0;
  if ALogFont.lfUnderline<>0 then
    include(AStyle,pfsUnderline);
  if ALogFont.lfStrikeOut<>0 then
    include(AStyle,pfsStrikeOut);
  if ALogFont.lfWeight>=FW_SEMIBOLD then
    include(AStyle,pfsBold);
  result := SetFont(AName,ASize,AStyle,ALogFont.lfCharSet,-1,
    ALogFont.lfPitchAndFamily and TMPF_FIXED_PITCH=0);
end;

procedure TPdfCanvas.TextOut(X, Y: Single; const Text: PDFString);
begin
  if FContents<>nil then begin
    FContents.Writer.Add('BT'#10).AddWithSpace(X).AddWithSpace(Y).Add('Td'#10);
    ShowText(Text);
    FContents.Writer.Add('ET'#10);
  end;
end;

procedure TPdfCanvas.TextOutW(X, Y: Single; PW: PWideChar);
begin
  if FContents<>nil then begin
    FContents.Writer.Add('BT'#10).AddWithSpace(X).AddWithSpace(Y).Add('Td'#10);
    ShowText(PW);
    FContents.Writer.Add('ET'#10);
  end;
end;

procedure TPdfCanvas.TextRect(ARect: TPdfRect; const Text: PDFString;
                            Alignment: TPdfAlignment; Clipping: boolean);
var tmpWidth: Single;
    XPos: Single;
begin
  // calculate text width and corresponding X position according to alignment
  tmpWidth := TextWidth(Text);
  case Alignment of
    paCenter: XPos := Round((ARect.Right - ARect.Left - tmpWidth) / 2);
    paRightJustify: XPos := ARect.Right - ARect.Left - Round(tmpWidth);
  else
    XPos := 0;
  end;
  // clipping client rect if needed
  if Clipping then begin
    GSave;
    with ARect do begin
      MoveTo(Left, Top);
      LineTo(Left, Bottom);
      LineTo(Right, Bottom);
      LineTo(Right, Top);
    end;
    ClosePath;
    Clip;
    NewPath;
  end;
  // show the text in the specified rectangle and alignment
  BeginText;
  MoveTextPoint(ARect.Left + XPos, ARect.Top - FPage.FontSize * 0.85);
  ShowText(Text);
  EndText;
  if Clipping then
    GRestore;
end;

procedure TPdfCanvas.MultilineTextRect(ARect: TPdfRect; const Text: PDFString;
  WordWrap: boolean);
var i: integer;
    S1, S2: PDFString;
    XPos, YPos: Single;
    tmpXPos: Single;
    tmpWidth: Single;
    ln: integer;
    ForceNL: boolean;
    FText: PDFString;

  procedure InternalShowText(S: PDFString; AWidth: Single);
  var i: Integer;
  begin
    i := MeasureText(S, AWidth); // simple clipping
    S := Copy(S, 1, i);
    ShowText(S);
  end;

begin
  YPos := ARect.Top - FPage.FontSize*0.85;
  XPos := ARect.Left;
  FText := Text;
  BeginText;
  MoveTextPoint(XPos, YPos);
  i := 1;
  S2 := GetNextWord(FText, i);
  XPos := XPos +  TextWidth(S2);
  if (Length(S2) > 0) and (S2[Length(S2)]=' ') then
    XPos := XPos + FPage.WordSpace;

  while i <= Length(FText) do begin
    ln := Length(S2);
    if (ln >= 2) and (S2[ln]=#10) and (S2[ln-1]=#13) then begin
      S2 := Copy(S2, 1, ln - 2);
      ForceNL := true;
    end else
      ForceNL := false;
    S1 := GetNextWord(FText, i);
    tmpWidth := TextWidth(S1);
    TmpXPos := XPos + tmpWidth;
    if (WordWrap and (TmpXPos > ARect.Right)) or ForceNL then begin
      if S2<>'' then
        InternalShowText(S2, ARect.Right - ARect.Left);
      S2 := '';
      MoveToNextLine;
      ARect.Top := ARect.Top - FPage.Leading;
      if ARect.Top < ARect.Bottom + FPage.FontSize then
        Break;
      XPos := ARect.Left;
    end;
    XPos := XPos + tmpWidth;
    if (Length(S1) > 0) and (S1[Length(S1)]=' ') then
      XPos := XPos + FPage.WordSpace;
    S2 := S2 + S1;
  end;

  if S2<>'' then
    InternalShowText(S2, ARect.Right - ARect.Left);
  EndText;
end;

procedure TPdfCanvas.DrawXObjectPrepare(const AXObjectName: PDFString);
var XObject: TPdfXObject;
    FPageResources: TPdfDictionary;
    i: integer;
begin
  // drawing object must be registered. check object name
  XObject := fDoc.GetXObject(AXObjectName);
  if XObject=nil then
    raise EPdfInvalidValue.CreateFmt('DrawXObject: unknown %s', [AXObjectName]);
  FPageResources := FPage.GetResources('XObject');
  if FPageResources=nil then
    raise EPdfInvalidValue.Create('DrawXObject: no XObject');
  if FPageResources.ValueByName(AXObjectName)=nil then
    FPageResources.AddItem(AXObjectName, XObject);
  {$ifdef USE_METAFILE}
  if XObject.InheritsFrom(TPdfForm) then
    with TPdfForm(XObject).FFontList do
      for i := 0 to ItemCount-1 do
      with Items[i] do
        if FPageFontList.ValueByName(Key)=nil then
          FPageFontList.AddItem(Key, Value);
  {$endif USE_METAFILE}
end;

procedure TPdfCanvas.DrawXObject(X, Y, AWidth, AHeight: Single;
    const AXObjectName: PDFString);
begin
  DrawXObjectPrepare(AXObjectName);
  GSave;
  ConcatToCTM(AWidth, 0, 0, AHeight, X, Y);
  ExecuteXObject(AXObjectName);
  GRestore;
end;

procedure TPdfCanvas.DrawXObjectEx(X, Y, AWidth, AHeight: Single;
      ClipX, ClipY, ClipWidth, ClipHeight: Single; const AXObjectName: PDFString);
begin
  DrawXObjectPrepare(AXObjectName);
  GSave;
  Rectangle(ClipX, ClipY, ClipWidth, ClipHeight);
  Clip;
  NewPath;
  fNewPath := False;
  ConcatToCTM(AWidth, 0, 0, AHeight, X, Y);
  ExecuteXObject(AXObjectName);
  GRestore;
end;


  {* Special Graphics State *}

procedure TPdfCanvas.GSave;
begin
  if FContents<>nil then
    FContents.Writer.Add('q'#10);
end;

procedure TPdfCanvas.GRestore;
begin
  if FContents<>nil then
    FContents.Writer.Add('Q'#10);
end;

procedure TPdfCanvas.ConcatToCTM(a, b, c, d, e, f: Single; Decimals: Cardinal);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(a,Decimals).AddWithSpace(b,Decimals).AddWithSpace(c,Decimals).
      AddWithSpace(d,Decimals).AddWithSpace(e,Decimals).AddWithSpace(f,Decimals).Add('cm'#10);
end;


  {* General Graphics State *}

procedure TPdfCanvas.SetFlat(flatness: Byte);
begin
  if FContents<>nil then
    FContents.Writer.Add(flatness).Add(' i'#10);
end;

procedure TPdfCanvas.SetLineCap(linecap: TLineCapStyle);
begin
  if FContents<>nil then
    FContents.Writer.Add(ord(linecap)).Add(' J'#10);
end;

procedure TPdfCanvas.SetDash(const aarray: array of integer; phase: integer);
var i: integer;
begin
  if FContents=nil then
    exit;
  FContents.Writer.Add('[');
  if (High(aarray) >= 0) and (aarray[0]<>0) then
    for i := 0 to High(aarray) do
      FContents.Writer.AddWithSpace(aarray[i]);
  FContents.Writer.Add('] ').Add(phase).Add(' d'#10);
end;

procedure TPdfCanvas.SetLineJoin(linejoin: TLineJoinStyle);
begin
  if FContents<>nil then
    FContents.Writer.Add(ord(linejoin)).Add(' j'#10);
end;

procedure TPdfCanvas.SetLineWidth(linewidth: Single);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(linewidth).Add('w'#10);
end;

procedure TPdfCanvas.SetMiterLimit(miterlimit: Single);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(miterlimit).Add('M'#10);
end;


  {* Paths *}

procedure TPdfCanvas.MoveTo(x, y: Single);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(x).AddWithSpace(y).Add('m'#10);
end;

procedure TPdfCanvas.LineTo(x, y: Single);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(x).AddWithSpace(y).Add('l'#10);
end;

procedure TPdfCanvas.CurveToC(x1, y1, x2, y2, x3, y3: Single);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(x1).AddWithSpace(y1).AddWithSpace(x2).
      AddWithSpace(y2).AddWithSpace(x3).AddWithSpace(y3).Add('c'#10);
end;

procedure TPdfCanvas.CurveToV(x2, y2, x3, y3: Single);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(x2).AddWithSpace(y2).AddWithSpace(x3).
      AddWithSpace(y3).Add('v'#10);
end;

procedure TPdfCanvas.CurveToY(x1, y1, x3, y3: Single);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(x1).AddWithSpace(y1).AddWithSpace(x3).
      AddWithSpace(y3).Add('y'#10);
end;

procedure TPdfCanvas.Rectangle(x, y, width, height: Single);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(x).AddWithSpace(y).AddWithSpace(width).
      AddWithSpace(height).Add('re'#10);
end;

procedure TPdfCanvas.Closepath;
begin
  if FContents<>nil then
    FContents.Writer.Add('h'#10);
end;

procedure TPdfCanvas.NewPath;
begin
  fNewPath := true;
  if FContents<>nil then
    FContents.Writer.Add('n'#10);
end;

procedure TPdfCanvas.Stroke;
begin
  if FContents<>nil then
    FContents.Writer.Add('S'#10);
end;

procedure TPdfCanvas.ClosePathStroke;
begin
  if FContents<>nil then
    FContents.Writer.Add('s'#10);
end;

procedure TPdfCanvas.Fill;
begin
  if FContents<>nil then
    FContents.Writer.Add('f'#10);
end;

procedure TPdfCanvas.Eofill;
begin
  if FContents<>nil then
    FContents.Writer.Add('f*'#10);
end;

procedure TPdfCanvas.FillStroke;
begin
  if FContents<>nil then
    FContents.Writer.Add('B'#10);
end;

procedure TPdfCanvas.ClosepathFillStroke;
begin
  if FContents<>nil then
    FContents.Writer.Add('b'#10);
end;

procedure TPdfCanvas.EofillStroke;
begin
  if FContents<>nil then
    FContents.Writer.Add('B*'#10);
end;

procedure TPdfCanvas.ClosepathEofillStroke;
begin
  if FContents<>nil then
    FContents.Writer.Add('b*'#10);
end;

procedure TPdfCanvas.Clip;
begin
  if FContents<>nil then
    FContents.Writer.Add('W'#10);
end;

procedure TPdfCanvas.Eoclip;
begin
  if FContents<>nil then
    FContents.Writer.Add('W*'#10);
end;


  {* Text handling *}

procedure TPdfCanvas.SetCharSpace(charSpace: Single);
begin
  if FPage.CharSpace=charSpace then Exit;
  FPage.SetCharSpace(charSpace);
  if FContents<>nil then
    FContents.Writer.AddWithSpace(charSpace).Add('Tc'#10);
end;

procedure TPdfCanvas.SetWordSpace(wordSpace: Single);
begin
  if FPage.WordSpace=wordSpace then Exit;
  FPage.SetWordSpace(wordSpace);
  if FContents<>nil then
    FContents.Writer.AddWithSpace(wordSpace).Add('Tw'#10);
end;

procedure TPdfCanvas.SetHorizontalScaling(hScaling: Single);
begin
  if FPage.HorizontalScaling=hScaling then Exit;
  FPage.SetHorizontalScaling(hScaling);
  if FContents<>nil then
    FContents.Writer.Add(hScaling).Add(' Tz'#10);
end;

procedure TPdfCanvas.SetLeading(leading: Single);
begin
  if FPage.Leading=leading then Exit;
  FPage.SetLeading(leading);
  if FContents<>nil then
    FContents.Writer.AddWithSpace(leading).Add('TL'#10);
end;

procedure TPdfCanvas.SetFontAndSize(const fontshortcut: PDFString; size: Single);
begin
  if FContents<>nil then
    FContents.Writer.Add('/').Add(fontshortcut).Add(' ').AddWithSpace(size).Add('Tf'#10);
end;

procedure TPdfCanvas.SetTextRenderingMode(mode: TTextRenderingMode);
begin
  if FContents<>nil then
    FContents.Writer.Add(ord(mode)).Add(' Tr'#10);
end;

procedure TPdfCanvas.SetTextRise(rise: word);
begin
  if FContents<>nil then
    FContents.Writer.Add(rise).Add(' Ts'#10);
end;

procedure TPdfCanvas.BeginText;
begin
  if FContents<>nil then
    FContents.Writer.Add('BT'#10);
end;

procedure TPdfCanvas.EndText;
begin
  if FContents<>nil then
    FContents.Writer.Add('ET'#10);
end;

procedure TPdfCanvas.MoveTextPoint(tx, ty: Single);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(tx).AddWithSpace(ty).Add('Td'#10);
end;

procedure TPdfCanvas.SetTextMatrix(a, b, c, d, x, y: Single);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(a).AddWithSpace(b).AddWithSpace(c).
      AddWithSpace(d).AddWithSpace(x).AddWithSpace(y).Add('Tm'#10);
end;

procedure TPdfCanvas.MoveToNextLine;
begin
  if FContents<>nil then
    FContents.Writer.Add('T*'#10);
end;

{$ifdef HASVARUSTRING}

procedure TPdfCanvas.ShowText(const text: UnicodeString; NextLine: boolean);
begin // direct call of the unicode text drawing method below
  ShowText(pointer(text),NextLine);
end;

{$endif}

procedure TPdfCanvas.ShowText(const text: PDFString; NextLine: boolean);
begin
  if (FContents<>nil) and (text<>'') then
    if (fDoc.FCharSet=ANSI_CHARSET) or IsAnsiCompatible(text) then begin
      if FPage.Font.Unicode and (FPage.FFont.FTrueTypeFontsIndex<>0) then
        SetPDFFont(TPdfFontTrueType(FPage.Font).WinAnsiFont,FPage.FontSize);
      FContents.Writer.Add('(').AddEscapeText(pointer(text),FPage.Font).Add(')').
        Add(SHOWTEXTCMD[NextLine])
    end else begin
      if FPage.FFont.FTrueTypeFontsIndex<>0 then
        // write TrueType text after conversion to unicode
        FContents.Writer.AddToUnicodeHexText(text,NextLine,self) else
        // this standard font should expect MBCS encoding
        FContents.Writer.Add('<').AddHex(text).Add('>').Add(SHOWTEXTCMD[NextLine]);
    end;
end;

procedure TPdfCanvas.ShowText(PW: PWideChar; NextLine: boolean);
begin
  if FContents<>nil then
    FContents.Writer.AddUnicodeHexText(PW,NextLine,self);
end;

procedure TPdfCanvas.ShowGlyph(PW: PWord; Count: integer);
begin
  if FContents<>nil then
    FContents.Writer.AddGlyphs(PW,Count,self);
end;

procedure TPdfCanvas.ExecuteXObject(const xObject: PDFString);
begin
  if FContents<>nil then
    FContents.Writer.Add('/').Add(xObject).Add(' Do'#10);
end;

procedure TPdfCanvas.SetRGBFillColor(Value: TPdfColor);
begin
  if FContents<>nil then
    FContents.Writer.AddColorStr(Value).Add('rg'#10);
end;

procedure TPdfCanvas.SetRGBStrokeColor(Value: TPdfColor);
begin
  if FContents<>nil then
    FContents.Writer.AddColorStr(Value).Add('RG'#10);
end;

procedure TPdfCanvas.SetCMYKFillColor(C, M, Y, K: integer);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(C/100).AddWithSpace(M/100).
      AddWithSpace(Y/100).AddWithSpace(K/100).Add('k'#10);
end;

procedure TPdfCanvas.SetCMYKStrokeColor(C, M, Y, K: integer);
begin
  if FContents<>nil then
    FContents.Writer.AddWithSpace(C/100).AddWithSpace(M/100).
      AddWithSpace(Y/100).AddWithSpace(K/100).Add('K'#10);
end;

function TPdfCanvas.TextWidth(const Text: PDFString): Single;
begin
  result := FPage.TextWidth(Text);
end;

{$ifdef DELPHI5OROLDER}
function StrCharLength(const Str: PChar): Cardinal;
begin
 result := Cardinal(CharNext(Str))-Cardinal(Str);
end;

function NextCharIndex(const S: string; Index: cardinal): cardinal;
begin
  Result := Index + 1;
  assert(Index <= cardinal(Length(S)));
  if SysLocale.FarEast and (S[Index] in LeadBytes) then
    Result := Index + StrCharLength(PChar(S) + Index - 1);
end;
{$endif}

const
  DEFAULT_PDF_WIDTH = 600;

function TPdfCanvas.UnicodeTextWidth(PW: PWideChar): Single;
var Ansi: PDFString;
    i, W, glyphW: integer;
begin
  W := 0;
  if PW<>nil then
    if FPage.FFont.FTrueTypeFontsIndex=0 then begin
      Ansi := CurrentAnsiConvert.UnicodeBufferToAnsi(PW,StrLenW(PW));
      i := 1;
      while i<=length(Ansi) do begin // loop is MBCS ready
        inc(W,FPage.FFont.GetAnsiCharWidth(Ansi,i));
        if SysLocale.FarEast  then
          i := NextCharIndex(Ansi,i) else
          inc(i);
      end;
    end else
      with TPdfFontTrueType(FPage.FFont).WinAnsiFont do
      while PW^<>#0 do begin
        glyphW := GetWideCharWidth(PW^);
       if (glyphW=0) and (fDoc.fUseFontFallBack) and (fDoc.fFontFallBackIndex>=0) then
          glyphW := (SetFont('',FPage.FontSize,fStyle,-1,fDoc.fFontFallBackIndex)
            as TPdfFontTrueType).GetWideCharWidth(PW^);
        if glyphW=0 then
          glyphW := DEFAULT_PDF_WIDTH;
        inc(W,glyphW);
        inc(PW);
      end;
  Result := (W*fPage.fFontSize)/1000;
end;

function TPdfCanvas.MeasureText(const Text: PDFString; AWidth: Single): integer;
begin
  result := FPage.MeasureText(Text, AWidth);
end;

const
  // see http://paste.lisp.org/display/1105
  BEZIER: single = 0.55228477716; // = 4/3 * (sqrt(2) - 1);

procedure TPdfCanvas.Ellipse(x, y, width, height: single);
var w2,h2,xw2,yh2: single;
begin
  w2 := width/2;
  h2 := height/2;
  xw2 := x+w2;
  yh2 := y+h2;
  MoveTo(x, yh2);
  CurveToC(x, yh2-h2*BEZIER, xw2-w2*BEZIER, y, xw2, y);
  CurveToC(xw2+w2*BEZIER, y, x+width, yh2-h2*BEZIER, x+width, yh2);
  CurveToC(x+width, yh2+h2*BEZIER, xw2+w2*BEZIER, y+height, xw2, y+height);
  CurveToC(xw2-w2*BEZIER, y+height, x, yh2+h2*BEZIER, x, yh2);
end;

procedure TPdfCanvas.RoundRect(x1, y1, x2, y2, cx, cy: Single);
begin
  cx := cx/2;
  cy := cy/2;
  MoveTo(x1+cx, y1);
  LineTo(x2-cx, y1);
  CurveToC(x2-cx+BEZIER*cx, y1, x2, y1+cy-BEZIER*cy, x2, y1+cy);
  LineTo(x2, y2-cy);
  CurveToC(x2, y2-cy+BEZIER*cy, x2-cx+BEZIER*cx, y2, x2-cx, y2);
  LineTo(x1+cx, y2);
  CurveToC(x1+cx-BEZIER*cx, y2, x1, y2-cy+BEZIER*cy, x1, y2-cy);
  LineTo(x1, y1+cy);
  CurveToC(x1, y1+cy-BEZIER*cy, x1+cx-BEZIER*cx, y1, x1+cx, y1);
  ClosePath;
end;

function TPdfCanvas.GetNextWord(const S: PDFString; var Index: integer): PDFString;
var ln: integer;
    i: integer;
begin
  // getting a word from text
  result := '';
  ln := Length(S);
  if Index > ln then
    Exit;
  i := Index;
  while true do
    if (S[i]=#10) and (S[i-1]=#13) or (S[i]=' ') then begin
      result := Copy(S, Index, i - (Index -1));
      break;
    end else
    if i >= ln then begin
      result := Copy(S, Index, i - (Index - 1));
      break;
    end else
    if SysLocale.PriLangID=LANG_JAPANESE then
      if {$ifdef ISDELPHIXE4}System.AnsiStrings.{$endif}ByteType(S, i)=mbTrailByte then
        if (S[i+1]<>#129) or not(S[i+2] in [#65,#66]) then begin
          result := Copy(S, Index, i - (Index - 1));
          break;
        end else
          inc(i) else
      if ((i < ln) and
         ({$ifdef ISDELPHIXE4}System.AnsiStrings.{$endif}ByteType(S, i + 1)=mbLeadByte)) then begin
        result := Copy(S, Index, i - (Index - 1));
        break;
      end else
      inc(i) else
    inc(i);
   Index := i + 1;
end;

function TPdfCanvas.GetDoc: TPdfDocument;
begin
  if fDoc<>nil then
    result := fDoc else
    raise EPdfInvalidOperation.Create('GetDoc');
end;

function TPdfCanvas.ViewOffsetX(X: Single): Single;
begin
  Result := (((X - FWinOrg.X) * FViewSize.cx / FWinSize.cx) + FViewOrg.X)
end;

function TPdfCanvas.ViewOffsetY(Y: Single): Single;
begin
  Result := ((Y - FWinOrg.Y) * FViewSize.cy / FWinSize.cy) + FViewOrg.Y
end;

function TPdfCanvas.GetWorldFactorX: Single;
begin
  Result := FWorldFactorX
end;

function TPdfCanvas.GetWorldFactorY: Single;
begin
  Result := FWorldFactorY
end;

function TPdfCanvas.I2X(X: Integer): Single;
begin
  result := FOffsetXDef + (FWorldOffsetX + ViewOffsetX(X) * GetWorldFactorX) * FDevScaleX
end;

function TPdfCanvas.I2Y(Y: Integer): Single;
begin
  result := FPage.GetPageHeight - FOffsetYDef -
    (FWorldOffsetY + ViewOffsetY(Y) * GetWorldFactorY) * FDevScaleY
end;

function TPdfCanvas.I2X(X: Single): Single;
begin
  result := FOffsetXDef + (FWorldOffsetX + ViewOffsetX(X) * GetWorldFactorX) * FDevScaleX
end;

function TPdfCanvas.I2Y(Y: Single): Single;
begin
  result := FPage.GetPageHeight - FOffsetYDef -
    (FWorldOffsetY + ViewOffsetY(Y) * GetWorldFactorY) * FDevScaleY
end;

procedure TPdfCanvas.LineToI(x, y: integer);
begin
  LineTo(I2X(X),I2Y(Y));
end;

procedure TPdfCanvas.MoveToI(x, y: integer);
begin
  MoveTo(I2X(X),I2Y(Y));
end;

procedure TPdfCanvas.CurveToCI(x1, y1, x2, y2, x3, y3: integer);
begin
  CurveToC(I2X(x1),I2Y(y1),I2X(x2),I2Y(y2),I2X(x3),I2Y(y3));
end;

procedure TPdfCanvas.MoveToI(x, y: Single);
begin
  MoveTo(I2X(X),I2Y(Y));
end;

procedure TPdfCanvas.LineToI(x, y: Single);
begin
  LineTo(I2X(X),I2Y(Y));
end;

procedure TPdfCanvas.RoundRectI(x1, y1, x2, y2, cx, cy: integer);
begin
  RoundRect(I2X(x1),I2Y(y1),I2X(x2),I2Y(y2),
    cx * FDevScaleX * GetWorldFactorX,-cy * FDevScaleY * GetWorldFactorY);
end;

{$ifdef USE_ARC}
procedure TPdfCanvas.ARCI(centerx, centery, W, H, Sx, Sy, Ex, Ey: integer;
  clockwise: boolean; arctype: TPdfCanvasArcType; var position: TPoint);
var res: teaDrawArray;
    i: integer;
begin
  if CalcCurveArcData(centerx, centery, W, H, Sx, Sy, Ex, Ey, clockwise,  arctype, res) then
    for I := 0 to High(res) do
      with res[i] do
      case res of
        caMoveto:
          MoveTo(I2X(pts[0].x), i2y(pts[0].y));
        caLine:
          LineTo(I2X(pts[0].x), i2y(pts[0].y));
        caCurve:
          CurveToC(I2X(pts[0].x), i2y(pts[0].y),
            I2X(pts[1].x), i2y(pts[1].y),
            I2X(pts[2].x), i2y(pts[2].y));
        caPosition: begin
          position.x := Round(pts[0].x);
          position.y := Round(pts[0].y);
        end;
      end;
end;
{$endif USE_ARC}

procedure TPdfCanvas.PointI(x, y: Single);
begin
  Rectangle(I2X(X),I2Y(Y),1E-2,1E-2); //smalest difference 1E-2 because of rounding to two decimals
end;

function TPdfCanvas.BoxI(Box: TRect; Normalize: boolean): TPdfBox;
var r: TPdfRect;
begin
  // to PDF coordinates conversion
  r := RectI(Box,Normalize);
  result.Width := r.Right - r.Left;
  result.Height := r.Bottom - r.Top;
  result.Left := r.Left;
  result.Top := r.Top;
end;

procedure NormalizeRect(var Rect: TRect); overload;
var tmp: integer;
begin // PDF can't draw twisted rects -> normalize such values
  if Rect.Right<Rect.Left then begin
    tmp := Rect.Left;
    Rect.Left := Rect.Right;
    Rect.Right := tmp;
  end;
  if Rect.Bottom<Rect.Top then begin
    tmp := Rect.Top;
    Rect.Top := Rect.Bottom;
    Rect.Bottom := tmp;
  end;
end;

procedure NormalizeRect(var Rect: TPdfRect); overload;
var tmp: Single;
begin // PDF can't draw twisted rects -> normalize such values
  if Rect.Right<Rect.Left then begin
    tmp := Rect.Left;
    Rect.Left := Rect.Right;
    Rect.Right := tmp;
  end;
  if Rect.Bottom<Rect.Top then begin
    tmp := Rect.Top;
    Rect.Top := Rect.Bottom;
    Rect.Bottom := tmp;
  end;
end;

function TPdfCanvas.RectI(Rect: TRect; Normalize: boolean): TPdfRect;
begin
  result.Left := I2X(Rect.Left);
  result.Right := I2X(Rect.Right-1);
  result.Top := I2Y(Rect.Top);
  result.Bottom := I2Y(Rect.Bottom-1);
  if Normalize then
    NormalizeRect(result);
end;

procedure TPdfCanvas.BeginMarkedContent(Group : TPdfOptionalContentGroup);
var Resources, Properties: TPdfDictionary;
    ID: PDFString;
begin
  if (FContents=nil) or not FDoc.UseOptionalContent then
    exit;
  if Group<>nil  then begin
    ID := 'oc'+UInt32ToPDFString(Group.ObjectNumber);
    // register Group in page resources properties
    Resources := FPage.PdfDictionaryByName('Resources');
    if Resources<>nil then begin
      Properties := Resources.PdfDictionaryByName('Properties');
      if Properties = nil then begin
        Properties := TPdfDictionary.Create(FDoc.FXRef);
        Resources.AddItem('Properties', Properties);
      end;
      if Properties<>nil then
        Properties.AddItem(ID,Group);
    end;
    FContents.Writer.Add('/OC /').Add(ID).Add(' BDC'#10);
  end else
    FContents.Writer.Add('/OC BMC'#10);
end;

procedure TPdfCanvas.EndMarkedContent;
begin
  if (FContents<>nil) and FDoc.UseOptionalContent then
    FContents.Writer.Add('EMC'#10);
end;

{ TPdfDictionaryWrapper }

procedure TPdfDictionaryWrapper.SetData(AData: TPdfDictionary);
begin
  FData := AData;
  if FData<>nil then
    FData.FSaveAtTheEnd := true;
end;

function TPdfDictionaryWrapper.GetHasData: boolean;
begin
  result := (FData=nil);
end;


{ TPdfInfo }

procedure TPdfInfo.SetAuthor(const Value: String);
begin
  FData.AddItemTextString('Author', Value);
end;

procedure TPdfInfo.SetCreationDate(Value: TDateTime);
begin
  FData.AddItemText('CreationDate', _DateTimeToPdfDate(Value));
end;

procedure TPdfInfo.SetModDate(Value: TDateTime);
begin
  FData.AddItemText('ModDate', _DateTimeToPdfDate(Value));
end;

procedure TPdfInfo.SetCreator(const Value: String);
begin
  FData.AddItemTextString('Creator', Value);
end;

procedure TPdfInfo.SetTitle(const Value: String);
begin
  FData.AddItemTextString('Title', Value);
end;

procedure TPdfInfo.SetSubject(const Value: String);
begin
  FData.AddItemTextString('Subject', Value);
end;

procedure TPdfInfo.SetKeywords(const Value: String);
begin
  FData.AddItemTextString('Keywords', Value);
end;

function TPdfInfo.GetAuthor: String;
begin
  result := FData.PdfTextStringValueByName('Author');
end;

function TPdfInfo.GetCreationDate: TDateTime;
var P: TPdfText;
begin
  P := FData.PdfTextByName('CreationDate');
  if P<>nil then
    try
      result := _PdfDateToDateTime(P.Value);
    except
      result := 0;
    end else
    result := 0;
end;

function TPdfInfo.GetModDate: TDateTime;
var P: TPdfText;
begin
  P := FData.PdfTextByName('ModDate');
  if P<>nil then
    try
      result := _PdfDateToDateTime(P.Value);
    except
      result := 0;
    end else
    result := 0;
end;

function TPdfInfo.GetCreator: String;
begin
  result := FData.PdfTextStringValueByName('Creator');
end;

function TPdfInfo.GetTitle: String;
begin
  result := FData.PdfTextStringValueByName('Title');
end;

function TPdfInfo.GetSubject: String;
begin
  result := FData.PdfTextStringValueByName('Subject');
end;

function TPdfInfo.GetKeywords: String;
begin
  result := FData.PdfTextStringValueByName('Keywords');
end;


{ TPdfCatalog }

procedure TPdfCatalog.SaveOpenAction;
begin
  if (FOpenAction=nil) then
    FData.RemoveItem('OpenAction') else
    FData.AddItem('OpenAction', FOpenAction.GetValue);
end;

procedure TPdfCatalog.SetPageLayout(Value: TPdfPageLayout);
var FPageLayout: TPdfName;
begin
  FPageLayout := FData.PdfNameByName('PageLayout');
  if (FPageLayout=nil) or not FPageLayout.InheritsFrom(TPdfName) then
    FData.AddItem('PageLayout', PDF_PAGE_LAYOUT_NAMES[Value]) else
    FPageLayout.Value := PDF_PAGE_LAYOUT_NAMES[Value];
end;

function TPdfCatalog.GetPageLayout: TPdfPageLayout;
var FPageLayout: TPdfName;
    S: PDFString;
begin
  result := plSinglePage;
  FPageLayout := FData.PdfNameByName('PageLayout');
  if (FPageLayout=nil) or not FPageLayout.InheritsFrom(TPdfName) then
    Exit;
  S := FPageLayout.Value;
  for result := low(TPdfPageLayout) to high(TPdfPageLayout) do
    if PDF_PAGE_LAYOUT_NAMES[result]=S then
      exit;
  result := plSinglePage;
end;

function TPdfCatalog.GetNonFullScreenPageMode: TPdfPageMode;
var FDictionary: TPdfDictionary;
    FPageMode: TPdfName;
    S: PDFString;
begin
  result := pmUseNone;
  FDictionary := FData.PdfDictionaryByName('NonFullScreenPageMode');
  if FDictionary=nil then
    Exit;
  FPageMode := FDictionary.PdfNameByName('NonFullScreenPageMode');
  if (FPageMode=nil) or not (FPageMode is TPdfName) then
    Exit;
  S := FPageMode.Value;
  for result := Low(TPdfPageMode) to High(TPdfPageMode) do
    if PDF_PAGE_MODE_NAMES[result]=S then
      exit;
  result := pmUseNone;
end;

const
  PDF_PAGE_VIEWER_NAMES: array[TPdfViewerPreference] of PDFString = (
    'HideToolbar', 'HideMenubar', 'HideWindowUI', 'FitWindow', 'CenterWindow',
    'PrintScaling');

function TPdfCatalog.GetViewerPreference: TPdfViewerPreferences;
var FDictionary: TPdfDictionary;
    V: TPdfViewerPreference;
begin
  result := [];
  FDictionary := FData.PdfDictionaryByName('ViewerPreference');
  if FDictionary<>nil then
    for V := low(V) to high(V) do
      if FDictionary.PdfBooleanByName(PDF_PAGE_VIEWER_NAMES[V])<>nil then
        include(result,V);
end;

procedure TPdfCatalog.SetPageMode(Value: TPdfPageMode);
var FPageMode: TPdfName;
begin
  FPageMode := FData.PdfNameByName('PageMode');
  if (FPageMode=nil) or not (FPageMode is TPdfName) then
    FData.AddItem('PageMode', PDF_PAGE_MODE_NAMES[Value]) else
    FPageMode.Value := PDF_PAGE_MODE_NAMES[Value];
end;

procedure TPdfCatalog.SetNonFullScreenPageMode(Value: TPdfPageMode);
var FDictionary: TPdfDictionary;
    FPageMode: TPdfName;
begin
  FDictionary := FData.PdfDictionaryByName('ViewerPreferences');
  if FDictionary=nil then begin
    FDictionary := TPdfDictionary.Create(Data.ObjectMgr);
    Data.AddItem('ViewerPreferences', FDictionary);
  end;
  // if Value is pmFullScreen, remove 'PageMode' element (use default value)
  if (Value=pmFullScreen) or (Value=pmUseNone) then
    FDictionary.RemoveItem('NonFullScreenPageMode') else begin
    FPageMode := FDictionary.PdfNameByName('NonFullScreenPageMode');
    if (FPageMode=nil) or not (FPageMode is TPdfName) then
      FDictionary.AddItem('NonFullScreenPageMode', PDF_PAGE_MODE_NAMES[Value]) else
      FPageMode.Value := PDF_PAGE_MODE_NAMES[Value];
  end;
end;

procedure TPdfCatalog.SetViewerPreference(Value: TPdfViewerPreferences);
var V: TPdfViewerPreference;
    FDictionary: TPdfDictionary;
begin
  FDictionary := FData.PdfDictionaryByName('ViewerPreferences');
  if (FDictionary=nil) and (Value<>[]) then begin
    FDictionary := TPdfDictionary.Create(Data.ObjectMgr);
    FData.AddItem('ViewerPreferences', FDictionary);
  end;
  if FDictionary<>nil then begin
    for V := low(V) to high(V) do
      if V in Value then
        if V=vpEnforcePrintScaling then
          FDictionary.AddItem(PDF_PAGE_VIEWER_NAMES[V],TPdfName.Create('None')) else
          FDictionary.AddItem(PDF_PAGE_VIEWER_NAMES[V],TPdfBoolean.Create(true)) else
        FDictionary.RemoveItem(PDF_PAGE_VIEWER_NAMES[V]);
    if vpEnforcePrintScaling in Value then begin
      FDictionary.AddItem('Enforce', TPdfArray.CreateNames(Data.ObjectMgr,['PrintScaling']));
      if fOwner<>nil then
        fOwner.fFileFormat := pdf16;
    end else
      FDictionary.RemoveItem('Enforce');
  end;
end;

function TPdfCatalog.GetPageMode: TPdfPageMode;
var FPageMode: TPdfName;
    S: PDFString;
begin
  result := pmUseNone;
  FPageMode := FData.PdfNameByName('PageMode');
  if (FPageMode=nil) or not FPageMode.InheritsFrom(TPdfName) then
    Exit;
  S := FPageMode.Value;
  for result := Low(PDF_PAGE_MODE_NAMES) to High(PDF_PAGE_MODE_NAMES) do
    if PDF_PAGE_MODE_NAMES[result]=S then
      exit;
  result := pmUseNone;
end;

function TPdfCatalog.GetPages: TPdfDictionary;
begin
  result := FData.PdfDictionaryByName('Pages');
  if result=nil then
    raise EPdfInvalidOperation.Create('GetPages');
end;

procedure TPdfCatalog.SetPages(APages: TPdfDictionary);
begin
  if APages.TypeOf='Pages' then
    FData.AddItem('Pages', APages);
end;


{ TPdfFont }

function TPdfFont.GetAnsiCharWidth(const AText: PDFString; APos: integer): integer;
begin
  Result := 0;
end;

constructor TPdfFont.Create(AXref: TPdfXref; const AName: PDFString);
begin
  inherited Create;
  FName := AName;
  Data := TPdfDictionary.Create(AXref);
  AXref.AddObject(FData);
end;

procedure TPdfFont.AddUsedWinAnsiChar(aChar: AnsiChar);
begin
  if Self<>nil then
    include(fWinAnsiUsed,aChar);
end;


{ TPdfFontWinAnsi }

destructor TPdfFontWinAnsi.Destroy;
begin
  FreeMem(fWinAnsiWidth);
  inherited;
end;

function TPdfFontWinAnsi.GetAnsiCharWidth(const AText: PDFString; APos: integer): integer;
begin
  if (fWinAnsiWidth<>nil) and (AText[APos]>=#32) then
    result := fWinAnsiWidth[AText[APos]] else
    result := fDefaultWidth;
end;


{ TPdfFontType1 }

constructor TPdfFontType1.Create(AXref: TPdfXref; const AName: PDFString;
  WidthArray: PSmallIntArray);
var i: integer;
    c: AnsiChar;
    DefaultWidth: word;
    Widths: TPdfArray;
begin
  inherited Create(AXref, AName);
  // adding standard element to the font definition
  Data.AddItem('Type','Font');
  Data.AddItem('Subtype','Type1');
  Data.AddItem('Encoding','WinAnsiEncoding');
  Data.AddItem('FirstChar',32);
  Data.AddItem('LastChar',255);
  Data.AddItem('BaseFont', FName);
  // register font
  if WidthArray=nil then begin
     // [] -> Courier fixed-width font
    fDefaultWidth := DEFAULT_PDF_WIDTH;
    fAscent := 833;
    fDescent := -300;
  end else begin
    // WidthArray[0]=Ascent, WidthArray[1]=Descent, WidthArray[2..]=Width(#32..)
    fAscent := WidthArray^[0];
    fDescent := WidthArray^[1];
    // create "Width" table of the font  (256-32=224)
    Data.AddItem('Widths', TPdfArray.Create(AXref, @WidthArray^[2], 224), true);
  end;
  // initialize char widths array by default value (if missing width parameter
  // is defined, use it as default value.)
  if Data.PdfNumberByName('MissingWidth')<>nil then
    DefaultWidth := Data.PdfNumberByName('MissingWidth').Value else
    DefaultWidth := fDefaultWidth; // typicaly 600 for Times
  GetMem(fWinAnsiWidth,sizeof(fWinAnsiWidth^));
  for c := low(TPdfWinAnsiWidth) to high(TPdfWinAnsiWidth) do
    fWinAnsiWidth^[c] := DefaultWidth;
  FFirstChar := Data.PdfNumberByName('FirstChar').Value;
  FLastChar := Data.PdfNumberByName('LastChar').Value;
  // fill width array with "Widths" table values.
  Widths := Data.PdfArrayByName('Widths');
  if Widths<>nil then
  for i := 0 to Widths.ItemCount-1 do
    if FFirstChar+i >= 32 then
      fWinAnsiWidth^[AnsiChar(FFirstChar+i)] := TPdfNumber(Widths[i]).Value;
end;


{ TPdfFontTrueType }

const
  { collection of flags defining various characteristics of the font
    see PDF Reference 1.3 #5.7.1 }
  PDF_FONT_FIXED_WIDTH = 1;
  PDF_FONT_SERIF       = 2;
  PDF_FONT_SYMBOLIC    = 4;
  PDF_FONT_SCRIPT      = 8;
  PDF_FONT_STD_CHARSET = 32;
  PDF_FONT_ITALIC      = 64;
  PDF_FONT_ALL_CAP     = 65536;
  PDF_FONT_SMALL_CAP   = 131072;
  PDF_FONT_FORCE_BOLD  = 262144;

function TPdfFontTrueType.FindOrAddUsedWideChar(aWideChar: WideChar): integer;
var n, i: integer;
    aSymbolAnsiChar: AnsiChar;
begin
  if WinAnsiFont <> self then // WinAnsiFont.fUsedWide[] = glyphs for ShowText 
  begin
    result := WinAnsiFont.FindOrAddUsedWideChar(aWideChar);
    exit;
  end;
  result := fUsedWideChar.Add(ord(aWideChar));
  if result<0 then begin
    result := -(result+1); // this WideChar was already existing -> return index
    exit;
  end;
  // this WideChar was just added -> reserve space in fUsedWide[]
  if length(fUsedWide)=fUsedWideChar.Count-1 then
    SetLength(fUsedWide,fUsedWideChar.Count+100);
  n := fUsedWideChar.Count-1;
  if result<n then
    MoveFast(fUsedWide[result],fUsedWide[result+1],(n-result)*4);
  // create associated Unicode Font if necessary
  if UnicodeFont=nil then
    CreateAssociatedUnicodeFont;
  // update fUsedWide[result] for current glyph
  i := UnicodeFont.fUsedWideChar.IndexOf(ord(aWideChar));
  if (i<0) and UnicodeFont.fIsSymbolFont then begin
    TSynAnsiConvert.Engine(fDoc.CodePage).UnicodeBufferToAnsi(
      @aSymbolAnsiChar,@aWideChar,1);
    aWideChar := WideChar($f000+ord(aSymbolAnsiChar));
    i := UnicodeFont.fUsedWideChar.IndexOf(ord(aWideChar));
  end;
  if i<0 then // if this glyph doesn't exist in this font -> set to zero
    i := 0 else
    i := UnicodeFont.fUsedWide[i].int;
  fUsedWide[result].int := i; // update Width and Glyph
end;

function TPdfFontTrueType.GetAndMarkGlyphAsUsed(aGlyph: word): word;
var i: integer;
begin
  result := aGlyph;
  // 1. check if not already registered as used
  with WinAnsiFont do // WinAnsiFont.fUsedWide[] = glyphs used by ShowText
    for i := 0 to fUsedWideChar.Count-1 do
      if fUsedWide[i].Glyph=aGlyph then
        exit; // fast return already existing glyph index
  // 2. register this glyph, and return TTF glyph
  with UnicodeFont do // UnicodeFont.fUsedWide[] = available glyphs from TPdfTTF
    for i := 0 to fUsedWideChar.Count-1 do
      if fUsedWide[i].Glyph=aGlyph then begin
        result := WinAnsiFont.fUsedWide[
          FindOrAddUsedWideChar(WideChar(fUsedWideChar.Values[i]))].Glyph;
        exit; // result may be 0 if this glyph doesn't exist in the CMAP content
      end;
  result := 0; // returns 0 if not found
end;

constructor TPdfFontTrueType.Create(ADoc: TPdfDocument; AFontIndex: integer;
  AStyle: TPdfFontStyles; const ALogFont: TLogFontW; AWinAnsiFont: TPdfFontTrueType);
var W: packed array of TABC;
    c: AnsiChar;
    aFontName: PDFString;
    Flags: integer;
begin
  if AWinAnsiFont<>nil then begin
    fWinAnsiFont := AWinAnsiFont;
    fUnicode := true;
    fUnicodeFont := self;
    fHGDI := AWinAnsiFont.fHGDI; // only one GDI resource is used for both
  end else begin
    fWinAnsiFont := self;
    fHGDI := CreateFontIndirectW(ALogFont);
  end;
  if AWinAnsiFont<>nil then // we use the Postscript Name here
    aFontName := AWinAnsiFont.fName else
    aFontName := ADoc.TTFFontPostcriptName(AFontIndex,AStyle,self);
  inherited Create(ADoc.FXref,aFontName);
  fDoc := ADoc;
  fTrueTypeFontsIndex := AFontIndex+1;
  fStyle := AStyle;
  // adding element to the dictionary
  Data.AddItem('Type', 'Font');
  Data.AddItem('BaseFont', FName);
  // retrieve font details
  fLogFont := ALogFont; // we always need our local copy
  if Unicode then begin
    // 1. Unicode Font
    Data.AddItem('Subtype', 'Type0');
    Data.AddItem('Encoding', 'Identity-H');
    // Retrieve some font details from WinAnsi version
    fFixedWidth := AWinAnsiFont.fFixedWidth;
    fDefaultWidth := AWinAnsiFont.fDefaultWidth;
    fM := AWinAnsiFont.fM;
    fOTM := AWinAnsiFont.fOTM;
    // get TrueType glyphs info
    fDoc.GetDCWithFont(self);
    TPdfTTF.Create(self).Free; // all the magic in one line :)
  end else begin
    // 2. WinAnsi Font
    Data.AddItem('Subtype', 'TrueType');
    Data.AddItem('Encoding', 'WinAnsiEncoding');
    // retrieve default WinAnsi characters widths
    fDoc.GetDCWithFont(self);
    GetTextMetrics(fDoc.FDC,fM);
    fOTM.otmSize := SizeOf(fOTM);
    GetOutlineTextMetrics(fDoc.FDC,SizeOf(fOTM),@fOTM);
    GetMem(fWinAnsiWidth,sizeof(fWinAnsiWidth^));
    SetLength(W,224);
    GetCharABCWidthsA(fDoc.FDC,32,255,W[0]);
    with W[0] do
      fDefaultWidth := integer(abcA+integer(abcB)+abcC);
    if fM.tmPitchAndFamily and TMPF_FIXED_PITCH=0 then begin
      fFixedWidth := true;
      for c := #32 to #255 do
        fWinAnsiWidth[c] := fDefaultWidth;
    end else
      for c := #32 to #255 do
        with W[ord(c)-32] do
          fWinAnsiWidth[c] := integer(abcA+integer(abcB)+abcC);
    // create font descriptor (the WinAnsi one is used also for unicode)
    FFontDescriptor := TPdfDictionary.Create(ADoc.FXref);
    FFontDescriptor.FSaveAtTheEnd := true;
    ADoc.FXref.AddObject(FFontDescriptor);
    FFontDescriptor.AddItem('Type','FontDescriptor');
    FFontDescriptor.AddItem('FontName',FName);
    FFontDescriptor.AddItem('Ascent',fOTM.otmAscent);
    FFontDescriptor.AddItem('CapHeight',666);
    FFontDescriptor.AddItem('Descent',fOTM.otmDescent);
    FFontDescriptor.AddItem('ItalicAngle',fOTM.otmItalicAngle);
    FFontDescriptor.AddItem('StemV',87);
{    if fFixedWidth then
      Flags := PDF_FONT_FIXED_WIDTH else
      Flags := 0;
    if (fsItalic in AStyle) and (fOTM.otmItalicAngle<>0) then
      Flags := Flags or PDF_FONT_ITALIC;
    if Flags=0 then
      Flags := PDF_FONT_STD_CHARSET;}
    if ALogFont.lfCharSet=SYMBOL_CHARSET then
      Flags := PDF_FONT_SYMBOLIC else
      Flags := PDF_FONT_STD_CHARSET;
    FFontDescriptor.AddItem('Flags',Flags);
    with fOTM.otmrcFontBox do
      FFontDescriptor.AddItem('FontBBox',
        TPdfArray.Create(fDoc.FXref, [Left,Bottom,Right,Top]));
    Data.AddItem('FontDescriptor',fFontDescriptor);
  end;
  fAscent := fOTM.otmAscent;
  fDescent := fOTM.otmDescent;
  FDoc.RegisterFont(self);
end;

destructor TPdfFontTrueType.Destroy;
begin
  if not Unicode then
    DeleteObject(fHGDI);
  inherited;
end;

function TPdfFontTrueType.GetWideCharUsed: Boolean;
begin
  result := (fUsedWideChar.Count>0);
end;

function TPdfFontTrueType.GetWideCharWidth(aWideChar: WideChar): Integer;
var ref: TPdfFontTrueType;
begin
  ref := WinAnsiFont; // WinAnsiFont.fUsedWide[] = glyphs used by ShowText
  result := WideCharToWinAnsi(ord(aWideChar));
  if result>=0 then
    if (ref.fWinAnsiWidth<>nil) and (result>=32) then
      result := ref.fWinAnsiWidth[AnsiChar(result)] else
      result := ref.fDefaultWidth else
      result := ref.fUsedWide[ref.FindOrAddUsedWideChar(aWideChar)].Width;
end;

{ font subset embedding using Windows XP CreateFontPackage() FontSub.dll
  see http://msdn.microsoft.com/en-us/library/dd183502 }

function lpfnAllocate(Size: Integer): pointer; cdecl;
begin
  GetMem(result,Size);
end;

function lpfnReAllocate(Buffer: pointer; Size: Integer): pointer; cdecl;
begin
  ReallocMem(Buffer, Size);
  result := Buffer;
end;

procedure lpfnFree(Buffer: pointer); cdecl;
begin
  FreeMem(Buffer);
end;

type
  TTtfTableDirectory = packed record
    sfntVersion: cardinal; // 0x00010000 for version 1.0
    numTables: word;       // number of tables
    searchRange: word;     // HighBit(NumTables) x 16
    entrySelector: word;   // Log2(HighBit(NumTables))
    rangeShift: word;      // NumTables x 16 - SearchRange
  end;
  PTtfTableDirectory = ^TTtfTableDirectory;
  
  TTtfTableEntry = packed record
    tag: cardinal;      // table identifier
    checksum: cardinal; // checksum for this table
    offset: cardinal;   // offset from start of font file
    length: cardinal;   // length of this table
  end;
  PTtfTableEntry = ^TTtfTableEntry;

const
  // see http://www.4real.gr/technical-documents-ttf-subset.html and
  // https://developer.apple.com/fonts/TrueType-Reference-Manual/RM06/Chap6.html
  TTF_SUBSET: array[0..9] of array[0..3] of AnsiChar = (
    'head', 'cvt ', 'fpgm', 'prep', 'hhea', 'maxp', 'hmtx', 'cmap', 'loca', 'glyf');

procedure ReduceTTF(out ttf: PDFString; SubSetData: pointer; SubSetSize: integer);
var dir: PTtfTableDirectory;
    d, e: PTtfTableEntry;
    head: ^TCmapHEAD;
    n, i, len: PtrInt;
    checksum: cardinal;
begin
  SetLength(ttf, SubSetSize); // maximum size
  d := pointer(ttf);
  inc(PTtfTableDirectory(d));
  // identify the tables to be included
  e := SubSetData;
  inc(PTtfTableDirectory(e));
  n := 0;
  if SubSetSize > SizeOf(dir^) then 
    for i := 1 to swap(PTtfTableDirectory(SubSetData)^.numTables) do begin
      if IntegerScan(@TTF_SUBSET, length(TTF_SUBSET), e^.tag) <> nil then begin
        d^ := e^;
        inc(d);
        inc(n);
      end;
      inc(e);
    end;
  // update the main directory
  if n < 8 then begin // pdf expects 10, and 8..15 for our fixed dir^ values
    MoveFast(SubSetData^, pointer(ttf)^, SubSetSize); // paranoid
    exit;
  end;
  dir := pointer(ttf);
  dir^.sfntVersion := PTtfTableDirectory(SubSetData)^.sfntVersion;
  dir^.numTables := swap(word(n));
  //len := HighBit(n); // always 8 when n in 8..15
  //dir^.searchRange := swap(len * 16);
  //dir^.entrySelector := swap(Floor(log2(len))); // requires the Math unit
  //dir^.rangeShift := swap((integer(n) - len) * 16);
  dir^.searchRange := 32768; // pre-computed values for n in 8..15
  dir^.entrySelector := 768;
  dir^.rangeShift := 8192;
  // include the associated data
  checksum := 0;
  head := nil;
  e := pointer(ttf);
  inc(PTtfTableDirectory(e));
  for i := 1 to n do begin
    len := bswap32(e^.length);
    MoveFast(PByteArray(SubSetData)[bswap32(e^.offset)], d^, len);
    e^.offset := bswap32(PtrUInt(d) - PtrUInt(ttf));
    if e^.tag = HEAD_TABLE then // 'head' table
      head := pointer(d);
    while len and 3 <> 0 do begin // 32-bit padding
      PByteArray(d)[len] := 0;
      inc(len);
    end;
    inc(checksum, bswap32(e^.checksum)); // we didn't change the table itself
    inc(PByte(d), len);
    inc(e);
  end;
  // finalize the generated content
  for i := 0 to ((SizeOf(dir^) + (integer(n) * SizeOf(e^))) shr 2) - 1 do
    inc(checksum, PCardinalArray(ttf)[i]);
  if head <> nil then
    head^.checkSumAdjustment := bswap32($B1B0AFBA - checksum);
  PStrLen(PtrUInt(ttf) - _STRLEN)^ := PtrUInt(d) - PtrUInt(ttf); // no realloc
end;

var
  FontSub: THandle = INVALID_HANDLE_VALUE;
  CreateFontPackage: function(puchSrcBuffer: pointer; ulSrcBufferSize: cardinal;
    var puchFontPackageBuffer: PAnsiChar; var pulFontPackageBufferSize: cardinal;
    var pulBytesWritten: Cardinal; usFlags, usTTCIndex, usSubsetFormat,
    usSubsetLanguage, usSubsetPlatform, usSubsetEncoding: word;
    pusSubsetKeepList: PWordArray; usSubsetKeepListCount: word;
    lpfnAllocate, lpfnReAllocate, lpfnFree, reserved: pointer): cardinal; cdecl;

procedure TPdfFontTrueType.PrepareForSaving;
var c: AnsiChar;
    i, n, L, ndx, count: integer;
    Descendants: TPdfArray;
    Descendant, CIDSystemInfo: TPdfDictionary;
    ToUnicode: TPdfStream;
    DS: TStream;
    WR: TPdfWrite;
    ttfSize: cardinal;
    ttf: PDFString;
    SubSetData: PAnsiChar;
    SubSetMem: cardinal;
    SubSetSize: cardinal;
    Used: TSortedWordArray;
    usFlags: Word;  // For CreateFontPackage
    ttcIndex: Word; // For CreateFontPackage
    tableTag: Longword;
    {$ifndef DELPHI5OROLDER}
    ttcNumFonts: Longword;
    {$endif}
begin
  DS := THeapMemoryStream.Create;
  WR := TPdfWrite.Create(fDoc,DS);
  try
    if Unicode then begin
      // 1. Unicode Font (see PDF 1.3 reference #5.9)
      // create descendant font
      Descendant := TPdfDictionary.Create(fDoc.FXref);
      Descendant.AddItem('Type','Font');
      Descendant.AddItem('Subtype','CIDFontType2');
      Descendant.AddItem('BaseFont', // name may have been prefixed
        TPdfName(WinAnsiFont.Data.ValueByName('BaseFont')).Value);
      if fDoc.PDFA<>pdfaNone then
        Descendant.AddItem('CIDToGIDMap','Identity');
      CIDSystemInfo := TPdfDictionary.Create(FDoc.FXref);
      CIDSystemInfo.AddItem('Supplement',0);
      CIDSystemInfo.AddItemText('Ordering','Identity');
      CIDSystemInfo.AddItemText('Registry','Adobe');
      Descendant.AddItem('CIDSystemInfo',CIDSystemInfo);
      n := WinAnsiFont.fUsedWideChar.Count;
      if n>0 then begin
        fFirstChar := WinAnsiFont.fUsedWide[0].Glyph;
        fLastChar := WinAnsiFont.fUsedWide[n-1].Glyph;
      end;
      Descendant.AddItem('DW',WinAnsiFont.fDefaultWidth);
      if (fDoc.PDFA<>pdfaNone) or not WinAnsiFont.fFixedWidth then begin
        WR.Add('['); // fixed width will use /DW value
        // WinAnsiFont.fUsedWide[] contains glyphs used by ShowText
        for i := 0 to n-1 do
          with WinAnsiFont.fUsedWide[i] do
            if int<>0 then
              WR.Add(Glyph).Add('[').Add(Width).Add(']');
        Descendant.AddItem('W',TPdfRawText.Create(WR.Add(']').ToPDFString));
      end;
      Descendant.AddItem('FontDescriptor',WinAnsiFont.fFontDescriptor);
      fDoc.FXref.AddObject(Descendant);
      // create and associate descendant fonts array
      Descendants := TPdfArray.Create(fDoc.FXref);
      Descendants.AddItem(Descendant);
      Data.AddItem('DescendantFonts',Descendants);
      // create ToUnicode CMaping
      ToUnicode := TPdfStream.Create(fDoc);
      ToUnicode.Writer.Add('/CIDInit/ProcSet findresource begin'#10+
        '12 dict begin'#10'begincmap'#10'/CIDSystemInfo'#10'<<'#10'/Registry (').
        Add(ShortCut).Add('+0)'#10'/Ordering (UCS)'#10'/Supplement 0'#10'>> def'#10+
        '/CMapName/').Add(ShortCut).Add('+0 def'#10'/CMapType 2 def'#10+
        '1 begincodespacerange'#10'<').AddHex4(fFirstChar).Add('> <').
        AddHex4(fLastChar).Add('>'#10'endcodespacerange'#10);
      ndx := 0;
      while n>0 do begin
        if n>99 then
          L := 99 else
          L := n;
        count := L; // calculate real count of items in this beginbfchar
        for i := ndx to ndx+L-1 do
          if WinAnsiFont.fUsedWide[i].int=0 then
            dec(count);
        ToUnicode.Writer.Add(count).Add(' beginbfchar'#10);
        for i := ndx to ndx+L-1 do
          with WinAnsiFont.fUsedWide[i] do
            if int<>0 then
            ToUnicode.Writer.Add('<').AddHex4(Glyph).
              Add('> <').AddHex4(WinAnsiFont.fUsedWideChar.Values[i]).Add('>'#10);
        dec(n,L);
        inc(ndx,L);
        ToUnicode.Writer.Add('endbfchar'#10);
      end;
      ToUnicode.Writer.Add('endcmap'#10+
        'CMapName currentdict /CMap defineresource pop'#10'end'#10'end');
      Data.AddItem('ToUnicode', ToUnicode);
    end else begin
      // 2. WinAnsi Font
      for c := #32 to #255 do
        if c in fWinAnsiUsed then begin
          fFirstChar := ord(c);
          Break;
        end;
      for c := #255 downto #32 do
        if c in fWinAnsiUsed then begin
          fLastChar := ord(c);
          Break;
        end;
      if fFirstChar<>0 then begin
        Data.AddItem('FirstChar',fFirstChar);
        Data.AddItem('LastChar',fLastChar);
        WR.Add('[');
        for c := AnsiChar(fFirstChar) to AnsiChar(fLastChar) do
          if c in fWinAnsiUsed then
            WR.AddWithSpace(fWinAnsiWidth[c]) else
            WR.Add('0 ');
        FData.AddItem('Widths',TPdfRawText.Create(WR.Add(']').ToPDFString));
      end;
      // embedd True Type font into the PDF file (allow subset of used glyph)
      if (fDoc.PDFA<>pdfaNone) or (fDoc.EmbeddedTTF and
         ((fDoc.fEmbeddedTTFIgnore=nil) or (fDoc.fEmbeddedTTFIgnore.
           IndexOf(fDoc.FTrueTypeFonts[fTrueTypeFontsIndex-1])<0))) then begin
        fDoc.GetDCWithFont(self);
        {$ifndef DELPHI5OROLDER}
        // is the font in a .ttc collection?
        ttfSize := GetFontData(fDoc.FDC,TTCF_TABLE,0,nil,0);
        if ttfSize<>GDI_ERROR then begin
          // Yes, the font is in a .ttc collection
          // find out how many fonts are included in the collection
          if GetFontData(fDoc.FDC,TTCF_TABLE,8,@ttcNumFonts,4) <> GDI_ERROR then
            ttcNumFonts := bswap32(ttcNumFonts) else 
            ttcNumFonts := 1;
          // we need to find out the index of the font within the ttc collection
          // (this is not easy, so GetTTCIndex uses lookup on known ttc fonts)
          if (ttcNumFonts < 2) or not
             GetTTCIndex(fDoc.FTrueTypeFonts[fTrueTypeFontsIndex-1],ttcIndex,ttcNumFonts) then
            ttcIndex := 0;
          usFlags := TTFCFP_FLAGS_SUBSET or TTFCFP_FLAGS_TTC;
          tableTag := TTCF_TABLE;
        end else
        {$endif}
        begin
          ttfSize := GetFontData(fDoc.FDC,0,0,nil,0);
          usFlags := TTFCFP_FLAGS_SUBSET;
          ttcIndex := 0;
          tableTag := 0;
        end;
        if ttfSize<>GDI_ERROR then begin
          SetLength(ttf,ttfSize);
          if GetFontData(fDoc.FDC,tableTag,0,pointer(ttf),ttfSize)<>GDI_ERROR then begin
            fFontFile2 := TPdfStream.Create(fDoc);
            if not fDoc.fEmbeddedWholeTTF then begin
              if FontSub=INVALID_HANDLE_VALUE then begin
                FontSub := SafeLoadLibrary('FontSub.dll');
                if FontSub<>0 then
                  CreateFontPackage := GetProcAddress(FontSub,'CreateFontPackage');
              end;
              if (FontSub<>0) and (@CreateFontPackage<>nil) then begin
                // subset magic is done by Windows (API available since XP) :)
                Used.Count := 0;
                for i := fFirstChar to fLastChar do
                  if AnsiChar(i) in fWinAnsiUsed then
                    Used.Add(WinAnsiConvert.AnsiToWide[i]);
                with fUsedWideChar do
                  for i := 0 to Count-1 do
                    Used.Add(Values[i]);
                if CreateFontPackage(pointer(ttf),ttfSize,
                    SubSetData,SubSetMem,SubSetSize,
                    usFlags,ttcIndex,TTFMFP_SUBSET,0,
                    TTFCFP_MS_PLATFORMID,TTFCFP_DONT_CARE,
                    pointer(Used.Values),Used.Count,
                    @lpfnAllocate,@lpfnReAllocate,@lpfnFree,nil)=0 then begin
                  // subset was created successfully -> save to PDF file
                  ReduceTTF(ttf,SubSetData,SubSetSize);
                  FreeMem(SubSetData);
                  // see 5.5.3 Font Subsets: begins with a tag followed by a +
                  TPdfName(Data.ValueByName('BaseFont')).Value :=
                    TPdfName(fFontDescriptor.ValueByName('FontName')).AppendPrefix;
                end;
              end;
            end;
            fFontFile2.Writer.Add(ttf);
            fFontFile2.FAttributes.AddItem('Length1',length(ttf));
            // /FontDescriptor is common to WinAnsi and Unicode fonts
            fFontDescriptor.AddItem('FontFile2',fFontFile2);
          end;
        end;
      end;
    end;
  finally
    WR.Free;
    DS.Free;
  end;
end;

procedure TPdfFontTrueType.CreateAssociatedUnicodeFont;
begin
  fUnicodeFont := TPdfFontTrueType.Create(
    fDoc,fTrueTypeFontsIndex-1,fStyle,fLogFont,self);
end;


{ TPdfDestination }

constructor TPdfDestination.Create(APdfDoc: TPdfDocument);
begin
  inherited Create;
  FDoc := APdfDoc;
  if FDoc=nil then
    raise EPdfInvalidOperation.Create('TPdfDestination');
  FPage := FDoc.Canvas.Page;
  FZoom := 1;
end;

destructor TPdfDestination.Destroy;
begin
  if FReference<>nil then
    FReference.Free;
  inherited;
end;

function TPdfDestination.GetElement(Index: integer): Integer;
begin
  result := FValues[Index];
end;

procedure TPdfDestination.SetElement(Index: integer; Value: Integer);
begin
  if FValues[Index]<>Value then
    if Value < 0 then
      FValues[Index] := -1 else
      FValues[Index] := Value;
end;

procedure TPdfDestination.SetZoom(Value: Single);
begin
  if Value<>FZoom then
    if Value < 0 then
      raise EPdfInvalidValue.Create('Zoom<0') else
    if Value > PDF_MAX_ZOOMSIZE then
      raise EPdfInvalidValue.CreateFmt('Zoom>%d', [PDF_MAX_ZOOMSIZE]) else
      FZoom := Value;
end;

function TPdfDestination.GetPageWidth: Integer;
begin
  if FPage.FMediaBox<> nil then
    result := TPdfNumber(FPage.FMediaBox.Items[2]).Value else
    result := FDoc.DefaultPageWidth;
end;

function TPdfDestination.GetPageHeight: Integer;
begin
  if FPage.FMediaBox<>nil then
    result := TPdfNumber(FPage.FMediaBox.Items[3]).Value else
    result := FDoc.DefaultPageHeight;
end;

function TPdfDestination.GetValue: TPdfArray;
const
  DEST_MAX_VALUE = 100;
begin
  // create TPdfArray object from the specified values.
  // the values which are not used are ignored.
  result := TPdfArray.Create(FDoc.FXref);
  with result do begin
    AddItem(FPage);
    AddItem(TPdfName.Create(PDF_DESTINATION_TYPE_NAMES[FType]));
    case FType of
      // if the type is dtXYZ, only Left, Top and Zoom values are used,
      // other properties are ignored.
      dtXYZ:
        begin
          if FValues[0] >= -DEST_MAX_VALUE then
            AddItem(TPdfNumber.Create(Left)) else
            AddItem(TPdfNull.Create);
          if FValues[1] >= -DEST_MAX_VALUE then
            AddItem(TPdfNumber.Create(Top)) else
            AddItem(TPdfNull.Create);
          if FZoom < 0 then
            FZoom := 0;
          AddItem(TPdfReal.Create(FZoom));
        end;
      // if the type is dtFitR, all values except Zoom are used.
      dtFitR:
        begin
          if FValues[0] >= -DEST_MAX_VALUE then
            AddItem(TPdfNumber.Create(Left)) else
            AddItem(TPdfNull.Create);
          if FValues[1] >= -DEST_MAX_VALUE then
            AddItem(TPdfNumber.Create(Bottom)) else
            AddItem(TPdfNull.Create);
          if FValues[2] >= 0 then
            AddItem(TPdfNumber.Create(Right)) else
            AddItem(TPdfNull.Create);
          if FValues[3] >= 0 then
            AddItem(TPdfNumber.Create(Top)) else
            AddItem(TPdfNull.Create);
        end;
      // if the type is dtFitH or dtFitBH, only Top property is used.
      dtFitH, dtFitBH:
          if FValues[1] >= -DEST_MAX_VALUE then
            AddItem(TPdfNumber.Create(Top)) else
            AddItem(TPdfNull.Create);
      // if the type is dtFitV or dtFitBV, only Top property is used.
      dtFitV, dtFitBV:
          if FValues[0] >= -DEST_MAX_VALUE then
            AddItem(TPdfNumber.Create(Left)) else
            AddItem(TPdfNull.Create);
    end;
  end;
end;


{ TPdfOutlineEntry }

constructor TPdfOutlineEntry.Create(AParent: TPdfOutlineEntry;
  TopPosition: integer=-1);
begin
  inherited Create;
  if AParent=nil then
    raise EPdfInvalidValue.Create('CreateEntry');
  FParent := AParent;
  FDoc := AParent.Doc;
  Data := TPdfDictionary.Create(FDoc.FXref);
  FDoc.FXref.AddObject(Data);
  FDoc.FObjectList.Add(Self);
  if TopPosition>=0 then begin
    if FDoc.Canvas.FPage=nil then
      FDoc.RaiseInvalidOperation;
    FDest := FDoc.CreateDestination;
    FDest.DestinationType := dtXYZ;
    FDest.Zoom := 0; // will leave Zoom factor unchanged
    FDest.Left := 0; // go to left side of the page
    FDest.Top := TopPosition;
  end;
end;

destructor TPdfOutlineEntry.Destroy;
begin
  if FReference<>nil then
    FReference.Free;
  inherited;
end;

function TPdfOutlineEntry.AddChild(TopPosition: Integer=-1): TPdfOutlineEntry;
var TmpEntry: TPdfOutlineEntry;
begin
  // increment total Count variable
  inc(FCount);
  TmpEntry := Parent;
  while TmpEntry<>nil do begin
    TmpEntry.FCount := TmpEntry.FCount + 1;
    TmpEntry := TmpEntry.Parent;
  end;
  result := TPdfOutlineEntry.Create(Self,TopPosition);
  if FFirst=nil then
    FFirst := Result;
  if FLast<>nil then
    FLast.FNext := Result;
  Result.FPrev := FLast;
  FLast := Result;
end;

procedure TPdfOutlineEntry.Save;
begin
  Data.AddItem('Parent',FParent.Data);
  if Opened then
    Data.AddItem('Count', FCount) else
    Data.AddItem('Count', -FCount);
  Data.AddItemTextString('Title', FTitle);
  if FDest<>nil then
    Data.AddItem('Dest', FDest.GetValue);
  if FFirst<>nil then
  begin
    Data.AddItem('First', FFirst.Data);
    FFirst.Save;
  end;
  if FLast<>nil then
    Data.AddItem('Last', FLast.Data);
  if FPrev<>nil then
    Data.AddItem('Prev', FPrev.Data);
  if FNext<>nil then
  begin
    Data.AddItem('Next', FNext.Data);
    FNext.Save;
  end;
end;


{ TPdfOutlineRoot }

constructor TPdfOutlineRoot.Create(ADoc: TPdfDocument);
begin
  // no inherited Create() for this "fake" entry
  FDoc := ADoc;
  FOpened := true;
  Data := TPdfDictionary.Create(ADoc.FXref);
  FDoc.FXref.AddObject(Data);
  Data.AddItem('Type', 'Outlines');
  FDoc.FObjectList.Add(Self);
end;

procedure TPdfOutlineRoot.Save;
begin
  Data.AddItem('Count', FCount);
  if FFirst<>nil then begin
    Data.AddItem('First', FFirst.Data);
    FFirst.Save;
  end;
  if FLast<>nil then
    Data.AddItem('Last', FLast.Data);
end;


{ TPdfTTF }

constructor TPdfTTF.Create(aUnicodeTTF: TPdfFontTrueType);
var P: pointer;
    SubTable: ^TCmapSubTableArray absolute P;
    Header: ^TCmapHeader;
    i, n, code, ndx: PtrInt;
    off: cardinal;
    glyphIndex: integer;
    idDeltai, glyphi: PtrInt;
    W, numOfLongHorMetrics: word;
    fUnitsPerEmShr: cardinal;
begin
  // retrieve the 'cmap' (character code mapping) table
  // see http://developer.apple.com/fonts/TTRefMan/RM06/Chap6cmap.html
  // and http://www.microsoft.com/typography/OTSPEC/cmap.htm
  P := GetTTFData(aUnicodeTTF.fDoc.FDC,'cmap',fcmap);
  if P=nil then
    exit;
  Header := P;
  inc(PtrInt(P),SizeOf(TCmapHeader));
  off := 0;
  for i := 0 to Header^.numberSubtables-1 do
    with SubTable^[i] do
      if platformID=TTFCFP_MS_PLATFORMID then
        if platformSpecificID=TTFCFP_SYMBOL_CHAR_SET then begin
          aUnicodeTTF.fIsSymbolFont := true;
          off := offset;
        end else
        if platformSpecificID=TTFCFP_UNICODE_CHAR_SET then begin
          aUnicodeTTF.fIsSymbolFont := false;
          off := offset;
          break; // prefered specific ID
        end;
  if (off=0) or (off and 1<>0) then
    exit; // we handle only Microsoft platform
  i := LongRec(off).Lo; // offset swap to bswap conversion :)
  LongRec(off).Lo := LongRec(off).Hi;
  LongRec(off).Hi := i;
  if off>cardinal(Length(fcmap)*2) then
    exit; // avoid GPF
  fmt4 := Pointer(PtrUInt(fcmap)+off);
  with fmt4^ do begin
    if format<>4 then
      Exit; // we handle only cmap table format 4
    endCode := pointer(PtrUInt(@format)+sizeof(TCmapFmt4));
    startCode := pointer(PtrUInt(endCode)+segCountX2+2); // +2 = reservedPad
    idDelta := pointer(PtrUInt(startCode)+segCountX2);
    idRangeOffset := pointer(PtrUInt(idDelta)+segCountX2);
    glyphIndexArray := pointer(PtrUInt(idRangeOffset)+segCountX2);
  end;
  // 'head', 'hmtx' (horizontal metrics) and 'hhea' (Horizontal Header) tables
  // see http://developer.apple.com/fonts/TTRefMan/RM06/Chap6hmtx.html
  head := GetTTFData(aUnicodeTTF.fDoc.FDC,'head',fhead);
  if head=nil then
    exit;
  P := GetTTFData(aUnicodeTTF.fDoc.FDC,'hmtx',fhmtx);
  if P=nil then
    exit;
  hhea := GetTTFData(aUnicodeTTF.fDoc.FDC,'hhea',fhhea);
  if hhea=nil then
    exit;
  // fill aUnicodeTTF.fUsedWide[] and aUnicodeTTF.fUsedWideChar data
  n := fmt4^.segCountX2 shr 1;
  with aUnicodeTTF.fUsedWideChar do begin
    for i := 0 to n-1 do
      inc(Count,endCode[i]-startCode[i]+1);
    SetLength(Values,Count);
    SetLength(aUnicodeTTF.fUsedWide,Count);
  end;
  ndx := 0;
  for i := 0 to n-1 do begin
    idDeltai := idDelta[i];
    glyphi := idRangeOffset[i];
    if glyphi<>0 then
      glyphi := glyphi shr 1+i-n-startCode[i];
    for code := startCode[i] to endCode[i] do begin
      aUnicodeTTF.fUsedWideChar.Values[ndx] := code;
      if glyphi=0 then
        glyphIndex := code+idDeltai else begin
        glyphIndex := glyphIndexArray[glyphi+code];
        if glyphIndex<>0 then
          inc(glyphIndex,idDeltai);
      end;
      aUnicodeTTF.fUsedWide[ndx].Glyph := glyphIndex;
      inc(ndx);
    end;
  end;
  // UnitsPerEm range is from 16 to 16384. This value should be a power of 2.
  // (from http://www.microsoft.com/typography/OTSPEC/head.htm)
  fUnitsPerEmShr := 0; // fastest integer div for width calculating
  for i := 14 downto 4 do
    if GetBitPtr(@head^.UnitsPerEm,i) then begin
      fUnitsPerEmShr := i;
      break;
    end;
  if fUnitsPerEmShr<>0 then begin
    W := (cardinal(fhmtx[0])*1000) shr fUnitsPerEmShr;
    if aUnicodeTTF.FixedWidth then
      for i := 0 to aUnicodeTTF.fUsedWideChar.Count-1 do
        aUnicodeTTF.fUsedWide[i].Width := W
    else begin
      numOfLongHorMetrics := fhhea[17];
      for i := 0 to aUnicodeTTF.fUsedWideChar.Count-1 do
      with aUnicodeTTF.fUsedWide[i] do
        if Glyph<>0 then
          if Glyph<=numOfLongHorMetrics then
            Width := (cardinal(fhmtx[Glyph*2])*1000) shr fUnitsPerEmShr else
            Width := W;
    end;
  end;
end;


{ TPdfPage }

constructor TPdfPage.Create(ADoc: TPdfDocument);
begin
  if ADoc=nil then // e.g. for TPdfForm.Create
    inherited Create(nil) else begin
    inherited Create(ADoc.FXRef);
    fDoc := ADoc;
    // set page size
    FMediaBox := TPdfArray.Create(ADoc.FXref,
      [0,0,ADoc.DefaultPageWidth,ADoc.DefaultPageHeight]);
    AddItem('MediaBox',FMediaBox);
  end;
  FSaveAtTheEnd := true;
end;

function TPdfPage.GetPageHeight: Integer;
begin
  result := TPdfNumber(FMediaBox.Items[3]).Value;
end;

function TPdfPage.GetPageLandscape: Boolean;
begin
  result := PageWidth>PageHeight;
end;

function TPdfPage.GetPageWidth: Integer;
begin
  result := TPdfNumber(FMediaBox.Items[2]).Value;
end;

function TPdfPage.GetResources(const AName: PDFString): TPdfDictionary;
begin
  Result := PdfDictionaryByName('Resources').PdfDictionaryByName(AName);
end;

function TPdfPage.MeasureText(const Text: PDFString; Width: Single): integer;
var ch: AnsiChar;
    tmpWidth: Single;
    tmpTotalWidth: Single;
    i: Integer;
begin
  Result := 0;
  tmpTotalWidth := 0;
  i := 1;
  while i<=Length(Text) do begin
    ch := Text[i];
    tmpWidth := FFont.GetAnsiCharWidth(Text, i) * FFontSize / 1000;
    if (FHorizontalScaling<>0) and (FHorizontalScaling<>100) then
      tmpWidth := tmpWidth * FHorizontalScaling / 100;
    if tmpWidth > 0 then
      tmpWidth := tmpWidth + FCharSpace else
      tmpWidth := 0;
    if (ch=' ') and (FWordSpace > 0) and (i<>Length(Text)) then
      tmpWidth := tmpWidth + FWordSpace;
    tmpTotalWidth := tmpTotalWidth + tmpWidth;
    if tmpTotalWidth > Width then
      Break;
    if SysLocale.FarEast  then
      i := NextCharIndex(Text,i) else
      inc(i);
    Result := i;
  end;
end;

procedure TPdfPage.SetCharSpace(Value: Single);
begin
  if (Value < PDF_MIN_CHARSPACE) or (VALUE > PDF_MAX_CHARSPACE) then
    raise EPdfInvalidValue.Create('SetCharSpace');
  FCharSpace := Value;
end;

procedure TPdfPage.SetFontSize(Value: Single);
begin
  if (Value < 0) or (Value > PDF_MAX_FONTSIZE) then
    raise EPdfInvalidValue.Create('SetFontSize');
  FFontSize := Value;
end;

procedure TPdfPage.SetHorizontalScaling(Value: Single);
begin
  if Value < PDF_MIN_HORIZONTALSCALING then
    Value := PDF_MIN_HORIZONTALSCALING else
  if Value > PDF_MAX_HORIZONTALSCALING then
    Value := PDF_MAX_HORIZONTALSCALING;
  FHorizontalScaling := Value;
end;

procedure TPdfPage.SetLeading(Value: Single);
begin
  if (Value < 0) or (Value > PDF_MAX_LEADING) then
    raise EPdfInvalidValue.Create('SetLeading');
  FLeading := Value;
end;

procedure TPdfPage.SetPageHeight(AValue: integer);
begin
  TPdfNumber(FMediaBox.Items[3]).Value := AValue
end;

procedure TPdfPage.SetPageLandscape(const Value: Boolean);
var tmp: integer;
begin
  if Value<>PageLandscape then begin
    tmp := PageHeight;
    PageHeight := PageWidth;
    PageWidth := tmp;
  end;
end;

procedure TPdfPage.SetPageWidth(AValue: integer);
begin
  TPdfNumber(FMediaBox.Items[2]).Value := AValue
end;

procedure TPdfPage.SetWordSpace(Value: Single);
begin
  if Value < 0 then
    raise EPdfInvalidValue.Create('SetWordSpace');
  FWordSpace := Value;
end;

function TPdfPage.TextWidth(const Text: PDFString): Single;
var i: integer;
    ch: AnsiChar;
    tmpWidth: Single;
begin
  Result := 0;
  i := 1;
  while i<=Length(Text) do begin
    ch := Text[i];
    tmpWidth := FFont.GetAnsiCharWidth(Text, i) * FFontSize / 1000;
    if (FHorizontalScaling<>0) and (FHorizontalScaling<>100) then
      tmpWidth := tmpWidth * FHorizontalScaling / 100;
    if tmpWidth > 0 then
      tmpWidth := tmpWidth + FCharSpace else
      tmpWidth := 0;
    if (ch=' ') and (FWordSpace > 0) and (i<>Length(Text)) then
      tmpWidth := tmpWidth + FWordSpace;
    Result := Result + tmpWidth;
    if SysLocale.FarEast  then
      i := NextCharIndex(Text,i) else
      inc(i);
  end;
  Result := Result - FCharSpace;
end;


{$ifdef USE_METAFILE}

{ TPdfDocumentGDI }

function TPdfDocumentGDI.AddPage: TPdfPage;
begin
  if (FCanvas<>nil) and (FCanvas.FPage<>nil) then
    TPdfPageGdi(FCanvas.FPage).FlushVCLCanvas;
  result := inherited AddPage;
  FCanvas.FContents.FSaveAtTheEnd := true; // as expected in SaveToStream() below
end;

constructor TPdfDocumentGDI.Create(AUseOutlines: Boolean; ACodePage: integer;
  {$ifdef USE_PDFALEVEL]}APDFA: TPdfALevel{$else}APDFA1: boolean{$endif}
  {$ifdef USE_PDFSECURITY}; AEncryption: TPdfEncryption{$endif});
begin
  inherited;
  fTPdfPageClass := TPdfPageGdi;
  fUseMetaFileTextPositioning := tpSetTextJustification;
  fKerningHScaleBottom := 99.0;
  fKerningHScaleTop := 101.0;
end;

function TPdfDocumentGDI.GetVCLCanvas: TCanvas;
begin
  with TPdfPageGdi(FCanvas.FPage) do begin
    if fVCLCurrentCanvas=nil then
      CreateVCLCanvas;
    result := fVCLCurrentCanvas;
  end;
end;

function TPdfDocumentGDI.GetVCLCanvasSize: TSize;
begin
  if (FCanvas<>nil) and (FCanvas.FPage<>nil) then
  with TPdfPageGdi(FCanvas.FPage) do begin
    if fVCLCurrentCanvas=nil then
      CreateVCLCanvas;
    result := fVCLCanvasSize;
  end else
    Int64(result) := 0;
end;

procedure TPdfDocumentGDI.SaveToStream(AStream: TStream; ForceModDate: TDateTime);
var i: integer;
    P: TPdfPageGDI;
begin
  // write the file header
  SaveToStreamDirectBegin(AStream,ForceModDate);
  // then draw the pages VCL Canvas content on the fly (miminal memory use)
  for i := 0 to fRawPages.Count-1 do begin
    P := fRawPages.List[i];
    P.FlushVCLCanvas;
    if P.fVCLMetaFileCompressed<>'' then begin
      P.SetVCLCurrentMetaFile;
      try
        FCanvas.SetPage(P);
        FCanvas.RenderMetaFile(P.fVCLCurrentMetaFile,1,1,0,0,
          fUseMetaFileTextPositioning,KerningHScaleBottom,KerningHScaleTop,
          fUseMetaFileTextClipping);
      finally
        FreeAndNil(P.fVCLCurrentMetaFile);
      end;
      inherited SaveToStreamDirectPageFlush;
    end;
  end;
  // finish to write PDF content to destination stream
  SaveToStreamDirectEnd;
end;

procedure TPdfDocumentGDI.SaveToStreamDirectPageFlush(FlushCurrentPageNow: boolean);
var P: TPdfPageGDI;
begin
  if fRawPages.Count>0 then begin
    P := fRawPages.List[fRawPages.Count-1];
    if (P=FCanvas.FPage) and (P.fVCLMetaFileCompressed='') and
       (P.fVCLCurrentMetaFile<>nil) and (P.fVCLCurrentCanvas<>nil) then begin
      FreeAndNil(P.fVCLCurrentCanvas); // manual P.SetVCLCurrentMetaFile
      try
        FCanvas.FContents.FSaveAtTheEnd := false; // force flush NOW
        FCanvas.RenderMetaFile(P.fVCLCurrentMetaFile,1,1,0,0,
          fUseMetaFileTextPositioning,KerningHScaleBottom,KerningHScaleTop,
          fUseMetaFileTextClipping);
      finally
        FreeAndNil(P.fVCLCurrentMetaFile);
      end;
    end;
  end;
  inherited SaveToStreamDirectPageFlush;
end;


{ TPdfPageGDI }

procedure TPdfPageGDI.SetVCLCurrentMetaFile;
var tmp: RawByteString;
    Stream: TStream;
begin
  assert(fVCLCurrentMetaFile=nil);
  fVCLCurrentMetaFile := TMetaFile.Create;
  fVCLCanvasSize.cx := MulDiv(PageWidth,FDoc.FScreenLogPixels,72);
  fVCLCanvasSize.cy := MulDiv(PageHeight,FDoc.FScreenLogPixels,72);
  fVCLCurrentMetaFile.Width  := fVCLCanvasSize.cx;
  fVCLCurrentMetaFile.Height := fVCLCanvasSize.cy;
  if fVCLMetaFileCompressed<>'' then begin
    SetLength(tmp,SynLZdecompressdestlen(pointer(fVCLMetaFileCompressed)));
    SynLZdecompress1(Pointer(fVCLMetaFileCompressed),length(fVCLMetaFileCompressed),pointer(tmp));
    Stream := TRawByteStringStream.Create(tmp);
    try
      fVCLCurrentMetaFile.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
  end;
end;

procedure TPdfPageGDI.CreateVCLCanvas;
begin
  SetVCLCurrentMetaFile;
  fVCLCurrentCanvas := TMetaFileCanvas.Create(fVCLCurrentMetaFile,FDoc.FDC);
end;

procedure TPdfPageGDI.FlushVCLCanvas;
var Stream: TRawByteStringStream;
    len: integer;
begin
  if (self=nil) or (fVCLCurrentCanvas=nil) then
    exit;
  FreeAndNil(fVCLCurrentCanvas);
  assert(fVCLCurrentMetaFile<>nil);
  Stream := TRawByteStringStream.Create;
  try
    fVCLCurrentMetaFile.SaveToStream(Stream);
    len := Length(Stream.DataString);
    SetLength(fVCLMetaFileCompressed,SynLZcompressdestlen(len));
    SetLength(fVCLMetaFileCompressed,
      SynLZcompress1(pointer(Stream.DataString),len,pointer(fVCLMetaFileCompressed)));
  finally
    Stream.Free;
  end;
  FreeAndNil(fVCLCurrentMetaFile);
end;


destructor TPdfPageGDI.Destroy;
begin
  FreeAndNil(fVCLCurrentCanvas);
  FreeAndNil(fVCLCurrentMetaFile);
  inherited;
end;

type
  TFontSpec = packed record
    angle: SmallInt; // -360..+360
    ascent, descent, cell: SmallInt;
  end;

  TPdfEnumStatePen = record
    null: boolean;
    color, style: integer;
    width: Single;
  end;

  /// a state of the EMF enumeration engine, for the PDF canvas
  // - used also for the SaveDC/RestoreDC stack
  TPdfEnumState = record
    Position: TPoint;
    Moved: boolean;
    WinSize, ViewSize: TSize;
    WinOrg, ViewOrg: TPoint;
    //transformation and clipping
    WorldTransform: XFORM; //current
    MetaRgn: TPdfBox;      //clipping
    ClipRgn: TPdfBox;      //clipping
    ClipRgnNull: Boolean;  //clipping
    MappingMode: Integer;
    PolyFillMode: Integer;
    StretchBltMode: Integer;
    ArcDirection: Integer;
    // current selected pen
    pen: TPdfEnumStatePen;
    // current selected brush
    brush: record
      null: boolean;
      color: integer;
      style: integer;
    end;
    // current selected font
    font: record
      color: integer;
      align: integer;
      BkMode, BkColor: integer;
      spec: TFontSpec;
      LogFont: TLogFontW; // better be the last entry in TPdfEnumState record
    end;
  end;

  /// internal data used during drawing
  // - contain the EMF enumeration engine state parameters
  TPdfEnum = class
  private
    fStrokeColor: integer;
    fFillColor: integer;
    fPenStyle: integer;
    fPenWidth: Single;
    fInLined: boolean;
    fInitTransformMatrix: XFORM;
    fInitMetaRgn: TPdfBox;
    procedure SetFillColor(const Value: integer);
    procedure SetStrokeColor(const Value: integer);
  protected
    Canvas: TPdfCanvas;
    // the pen/font/brush objects table, indexed like the THandleTable
    obj: array of record
      case kind: integer of
      OBJ_PEN:   (PenColor, PenStyle: integer; PenWidth: Single);
      OBJ_FONT:  (FontSpec: TFontSpec; LogFont: TLogFontW);
      OBJ_BRUSH: (BrushColor: integer; BrushNull: boolean; BrushStyle: integer);
    end;
    // SaveDC/RestoreDC stack
    nDC: integer;
    DC: array[0..31] of TPdfEnumState;
  public
    constructor Create(ACanvas: TPdfCanvas);
    procedure SaveDC;
    procedure RestoreDC;
    procedure NeedPen;
    procedure NeedBrushAndPen;
    procedure FlushPenBrush;
    procedure SelectObjectFromIndex(iObject: integer);
    procedure TextOut(var R: TEMRExtTextOut);
    procedure ScaleMatrix(Custom: PXForm; iMode: Integer);
    procedure HandleComment(Kind: TPdfGDIComment; P: PAnsiChar; Len: integer);
    procedure CreateFont(aLogFont: PEMRExtCreateFontIndirect);
    // if Canvas.Doc.JPEGCompression<>0, draw not as a bitmap but jpeg encoded
    procedure DrawBitmap(xs,ys,ws,hs, xd,yd,wd,hd,usage: integer;
      Bmi: PBitmapInfo; bits: pointer; clipRect: PRect; xSrcTransform: PXForm; dwRop: DWord;
      transparent: TPdfColorRGB = $FFFFFFFF);
    procedure FillRectangle(const Rect: TRect; ResetNewPath: boolean);
    // the current value set to SetRGBFillColor (rg)
    property FillColor: integer read fFillColor write SetFillColor;
    // the current value set to SetRGBStrokeColor (RG)
    property StrokeColor: integer read fStrokeColor write SetStrokeColor;
    // WorldTransform
    property InitTransformMatrix: XFORM read fInitTransformMatrix write fInitTransformMatrix;
    // MetaRgn - clipping
    procedure InitMetaRgn(ClientRect: TRect);
    procedure SetMetaRgn;
    // intersect - clipping
    function IntersectClipRect(const ClpRect: TPdfBox; const CurrRect: TPdfBox): TPdfBox;
    procedure ExtSelectClipRgn(data: PRgnDataHeader; iMode: DWord);
    // get current clipping area
    function GetClipRect: TPdfBox;
    procedure GradientFill(data: PEMGradientFill);
    procedure PolyPoly(data: PEMRPolyPolygon; iType: Integer);
  end;

const
  STOCKBRUSHCOLOR: array[WHITE_BRUSH..BLACK_BRUSH] of integer = (
    clWhite, $AAAAAA, $808080, $666666, clBlack);
  STOCKPENCOLOR: array[WHITE_PEN..BLACK_PEN] of integer = (
    clWhite, clBlack);

function CenterPoint(const Rect: TRect): TPoint; {$ifdef HASINLINE}inline;{$endif}
begin
  result.X := (Rect.Right+Rect.Left) div 2;
  result.Y := (Rect.Bottom+Rect.Top) div 2;
end;

/// EMF enumeration callback function, called from GDI
// - draw most content on PDF canvas (do not render 100% GDI content yet)
function EnumEMFFunc(DC: HDC; var Table: THandleTable; R: PEnhMetaRecord;
   NumObjects: DWord; E: TPdfEnum): LongBool; stdcall;
var i: integer;
    InitTransX: XForm;
    polytypes: PByteArray;
begin
  result := true;
  with E.DC[E.nDC] do
  case R^.iType of
  EMR_HEADER: begin
    SetLength(E.obj,PEnhMetaHeader(R)^.nHandles);
    WinOrg.X := 0;
    WinOrg.Y := 0;
    ViewOrg.X := 0;
    ViewOrg.Y := 0;
    MappingMode := GetMapMode(DC);
    PolyFillMode := GetPolyFillMode(DC);
    StretchBltMode := GetStretchBltMode(DC);
    ArcDirection := AD_COUNTERCLOCKWISE;
    InitTransX := DefaultIdentityMatrix;
    E.InitTransformMatrix := InitTransX;
    E.ScaleMatrix(@InitTransX, MWT_SET); // keep init
    E.InitMetaRgn(PEnhMetaHeader(R)^.rclBounds);
  end;
  EMR_SETWINDOWEXTEX:
    WinSize := PEMRSetWindowExtEx(R)^.szlExtent;
  EMR_SETWINDOWORGEX:
    WinOrg := PEMRSetWindowOrgEx(R)^.ptlOrigin;
  EMR_SETVIEWPORTEXTEX:
    ViewSize := PEMRSetViewPortExtEx(R)^.szlExtent;
  EMR_SETVIEWPORTORGEX:
    ViewOrg := PEMRSetViewPortOrgEx(R)^.ptlOrigin;
  EMR_SETBKMODE:
    font.BkMode := PEMRSetBkMode(R)^.iMode;
  EMR_SETBKCOLOR:
    if PEMRSetBkColor(R)^.crColor=cardinal(clNone) then
      font.BkColor := 0 else
      font.BkColor := PEMRSetBkColor(R)^.crColor;
  EMR_SETTEXTCOLOR:
    if PEMRSetTextColor(R)^.crColor=cardinal(clNone) then
      font.Color := 0 else
      font.Color := PEMRSetTextColor(R)^.crColor;
  EMR_SETTEXTALIGN:
    font.Align := PEMRSetTextAlign(R)^.iMode;
  EMR_EXTTEXTOUTA, EMR_EXTTEXTOUTW:
      E.TextOut(PEMRExtTextOut(R)^);
  EMR_SAVEDC:
    E.SaveDC;
  EMR_RESTOREDC:
    E.RestoreDC;
  EMR_SETWORLDTRANSFORM:
    E.ScaleMatrix(@PEMRSetWorldTransform(R)^.xform, MWT_SET);
  EMR_CREATEPEN:
    with PEMRCreatePen(R)^ do
    if ihPen-1<cardinal(length(E.Obj)) then
      with E.obj[ihPen-1] do begin
        kind := OBJ_PEN;
        PenColor := lopn.lopnColor;
        PenWidth := lopn.lopnWidth.X;
        PenStyle := lopn.lopnStyle;
      end;
  EMR_CREATEBRUSHINDIRECT:
    with PEMRCreateBrushIndirect(R)^ do
    if ihBrush-1<cardinal(length(E.Obj)) then
      with E.obj[ihBrush-1] do begin
        kind := OBJ_BRUSH;
        BrushColor := lb.lbColor;
        BrushNull := (lb.lbStyle=BS_NULL);
        BrushStyle := lb.lbStyle;
      end;
  EMR_EXTCREATEFONTINDIRECTW:
    E.CreateFont(PEMRExtCreateFontIndirect(R));
  EMR_DELETEOBJECT:
    with PEMRDeleteObject(R)^ do
      if ihObject-1<cardinal(length(E.Obj)) then // avoid GPF
        E.obj[ihObject-1].kind := 0;
  EMR_SELECTOBJECT:
    E.SelectObjectFromIndex(PEMRSelectObject(R)^.ihObject);
  EMR_MOVETOEX: begin
    Position := PEMRMoveToEx(R)^.ptl; // temp var to ignore unused moves
    if E.Canvas.FNewPath then begin
      E.Canvas.MoveToI(Position.X,Position.Y);
      Moved := true;
    end else
      Moved := false;
  end;
  EMR_LINETO: begin
    E.NeedPen;
    if not E.Canvas.FNewPath and not Moved then
      E.Canvas.MoveToI(Position.X,Position.Y);
    E.Canvas.LineToI(PEMRLineTo(R)^.ptl.X,PEMRLineTo(R)^.ptl.Y);
    Position := PEMRLineTo(R)^.ptl;
    Moved := false;
    E.fInLined := true;
    if not E.Canvas.FNewPath then
      if not pen.null then
        E.Canvas.Stroke
  end;
  EMR_RECTANGLE, EMR_ELLIPSE: begin
    E.NeedBrushAndPen;
    with E.Canvas.BoxI(PEMRRectangle(R)^.rclBox,true) do
    case R^.iType of
      EMR_RECTANGLE: E.Canvas.Rectangle(Left,Top,Width,Height);
      EMR_ELLIPSE:   E.Canvas.Ellipse(Left,Top,Width,Height);
    end;
    E.FlushPenBrush;
  end;
  EMR_ROUNDRECT: begin
    NormalizeRect(PEMRRoundRect(R)^.rclBox);
    E.NeedBrushAndPen;
    with PEMRRoundRect(R)^ do
      E.Canvas.RoundRectI(rclBox.left,rclBox.top,rclBox.right,rclBox.bottom,
        szlCorner.cx,szlCorner.cy);
    E.FlushPenBrush;
  end;
  {$ifdef USE_ARC}
  EMR_ARC: begin
    NormalizeRect(PEMRARC(R)^.rclBox);
    E.NeedPen;
    with PEMRARC(R)^, CenterPoint(rclBox) do
    E.Canvas.ARCI(x, y, rclBox.Right-rclBox.Left, rclBox.Bottom-rclBox.Top,
      ptlStart.x, ptlStart.y, ptlEnd.x, ptlEnd.y,
      e.dc[e.nDC].ArcDirection = AD_CLOCKWISE,
      acArc, Position);
      E.Canvas.Stroke;
   end;
  EMR_ARCTO: begin
    NormalizeRect(PEMRARCTO(R)^.rclBox);
    E.NeedPen;
     if not E.Canvas.FNewPath and not Moved then
      E.Canvas.MoveToI(Position.X,Position.Y);
    with PEMRARC(R)^, CenterPoint(rclBox) do  begin
    // E.Canvas.LineTo(ptlStart.x, ptlStart.y);
    E.Canvas.ARCI(x, y, rclBox.Right-rclBox.Left, rclBox.Bottom-rclBox.Top,
      ptlStart.x, ptlStart.y, ptlEnd.x, ptlEnd.y,
      e.dc[e.nDC].ArcDirection = AD_CLOCKWISE,
      acArcTo,
      Position);
    Moved := false;
    E.fInLined := true;
    if not E.Canvas.FNewPath then
      if not pen.null then
        E.Canvas.Stroke ;
     end;
   end;
  EMR_PIE: begin
    NormalizeRect(PEMRPie(R)^.rclBox);
    E.NeedBrushAndPen;
    with PEMRPie(R)^, CenterPoint(rclBox) do
      E.Canvas.ARCI(x, y, rclBox.Right-rclBox.Left, rclBox.Bottom-rclBox.Top,
        ptlStart.x, ptlStart.y, ptlEnd.x, ptlEnd.y,
        e.dc[e.nDC].ArcDirection = AD_CLOCKWISE,
        acPie, Position);
      if pen.null then
        E.Canvas.Fill else
        E.Canvas.FillStroke;
    end;
  EMR_CHORD: begin
    NormalizeRect(PEMRChord(R)^.rclBox);
    E.NeedBrushAndPen;
    with PEMRChord(R)^, CenterPoint(rclBox) do
      E.Canvas.ARCI(x, y, rclBox.Right-rclBox.Left, rclBox.Bottom-rclBox.Top,
        ptlStart.x, ptlStart.y, ptlEnd.x, ptlEnd.y,
        e.dc[e.nDC].ArcDirection = AD_CLOCKWISE,
        acChoord,Position);
      if pen.null then
        E.Canvas.Fill else
        E.Canvas.FillStroke;
  end;
  {$endif USE_ARC}
  EMR_FILLRGN: begin
    E.SelectObjectFromIndex(PEMRFillRgn(R)^.ihBrush);
    E.NeedBrushAndPen;
    E.FillRectangle(PRgnDataHeader(@PEMRFillRgn(R)^.RgnData[0])^.rcBound,false);
  end;
  EMR_POLYGON, EMR_POLYLINE, EMR_POLYGON16, EMR_POLYLINE16:
  if not brush.null or not pen.null then begin
    if R^.iType in [EMR_POLYGON,EMR_POLYGON16] then
      E.NeedBrushAndPen else
      E.NeedPen;
    if R^.iType in [EMR_POLYGON, EMR_POLYLINE] then begin
      E.Canvas.MoveToI(PEMRPolyLine(R)^.aptl[0].X,PEMRPolyLine(R)^.aptl[0].Y);
      for i := 1 to PEMRPolyLine(R)^.cptl-1 do
        E.Canvas.LineToI(PEMRPolyLine(R)^.aptl[i].X,PEMRPolyLine(R)^.aptl[i].Y);
      if PEMRPolyLine(R)^.cptl>0 then
        Position := PEMRPolyLine(R)^.aptl[PEMRPolyLine(R)^.cptl-1] else
        Position := PEMRPolyLine(R)^.aptl[0];
    end else begin
      E.Canvas.MoveToI(PEMRPolyLine16(R)^.apts[0].X,PEMRPolyLine16(R)^.apts[0].Y);
      if PEMRPolyLine16(R)^.cpts>0 then begin
        for i := 1 to PEMRPolyLine16(R)^.cpts-1 do
          E.Canvas.LineToI(PEMRPolyLine16(R)^.apts[i].X,PEMRPolyLine16(R)^.apts[i].Y);
        with PEMRPolyLine16(R)^.apts[PEMRPolyLine16(R)^.cpts-1] do begin
          Position.X := X;
          Position.Y := Y;
        end;
      end else begin
        Position.X := PEMRPolyLine16(R)^.apts[0].X;
        Position.Y := PEMRPolyLine16(R)^.apts[0].Y;
      end;
    end;
    Moved := false;
    if R^.iType in [EMR_POLYGON,EMR_POLYGON16] then begin
      E.Canvas.Closepath;
      E.FlushPenBrush;
    end else
    if not pen.null then
      E.Canvas.Stroke else // for lines
      E.Canvas.NewPath;
  end;
  EMR_POLYPOLYGON, EMR_POLYPOLYGON16, EMR_POLYPOLYLINE, EMR_POLYPOLYLINE16:
    E.PolyPoly(PEMRPolyPolygon(R), R^.iType);
  EMR_POLYBEZIER: begin
    if not pen.null then
      E.NeedPen;
    E.Canvas.MoveToI(PEMRPolyBezier(R)^.aptl[0].X,PEMRPolyBezier(R)^.aptl[0].Y);
    for i := 0 to (PEMRPolyBezier(R)^.cptl div 3)-1 do
      E.Canvas.CurveToCI(PEMRPolyBezier(R)^.aptl[i*3+1].X,PEMRPolyBezier(R)^.aptl[i*3+1].Y,
        PEMRPolyBezier(R)^.aptl[i*3+2].X,PEMRPolyBezier(R)^.aptl[i*3+2].Y,
        PEMRPolyBezier(R)^.aptl[i*3+3].X,PEMRPolyBezier(R)^.aptl[i*3+3].Y);
    if PEMRPolyBezier(R)^.cptl>0 then
      Position := PEMRPolyBezier(R)^.aptl[PEMRPolyBezier(R)^.cptl-1] else
      Position := PEMRPolyBezier(R)^.aptl[0];
    Moved := false;
    if not E.Canvas.FNewPath then
      if not pen.null then
        E.Canvas.Stroke else
        E.Canvas.NewPath;
  end;
  EMR_POLYBEZIER16: begin
    if not pen.null then
      E.NeedPen;
    E.Canvas.MoveToI(PEMRPolyBezier16(R)^.apts[0].X,PEMRPolyBezier16(R)^.apts[0].Y);
    if PEMRPolyBezier16(R)^.cpts>0 then begin
      for i := 0 to (PEMRPolyBezier16(R)^.cpts div 3)-1 do
        E.Canvas.CurveToCI(PEMRPolyBezier16(R)^.apts[i*3+1].X,PEMRPolyBezier16(R)^.apts[i*3+1].Y,
          PEMRPolyBezier16(R)^.apts[i*3+2].X,PEMRPolyBezier16(R)^.apts[i*3+2].Y,
          PEMRPolyBezier16(R)^.apts[i*3+3].X,PEMRPolyBezier16(R)^.apts[i*3+3].Y);
      with PEMRPolyBezier16(R)^.apts[PEMRPolyBezier16(R)^.cpts-1] do begin
        Position.X := X;
        Position.Y := Y;
      end;
    end else begin
      Position.X := PEMRPolyBezier16(R)^.apts[0].X;
      Position.Y := PEMRPolyBezier16(R)^.apts[0].Y;
    end;
    Moved := false;
    if not E.Canvas.FNewPath then
      if not pen.null then
        E.Canvas.Stroke else
        E.Canvas.NewPath;
  end;
  EMR_POLYBEZIERTO: begin
    if not pen.null then
      E.NeedPen;
    if not E.Canvas.FNewPath then
      if not Moved then
        E.Canvas.MoveToI(Position.X,Position.Y);
    if PEMRPolyBezierTo(R)^.cptl>0 then begin
      for i := 0 to (PEMRPolyBezierTo(R)^.cptl div 3)-1 do
        E.Canvas.CurveToCI(PEMRPolyBezierTo(R)^.aptl[i*3].X,PEMRPolyBezierTo(R)^.aptl[i*3].Y,
          PEMRPolyBezierTo(R)^.aptl[i*3+1].X,PEMRPolyBezierTo(R)^.aptl[i*3+1].Y,
          PEMRPolyBezierTo(R)^.aptl[i*3+2].X,PEMRPolyBezierTo(R)^.aptl[i*3+2].Y);
      Position := PEMRPolyBezierTo(R)^.aptl[PEMRPolyBezierTo(R)^.cptl-1];
    end;
    Moved := false;
    if not E.Canvas.FNewPath then
      if not pen.null then
        E.Canvas.Stroke else
        E.Canvas.NewPath;
  end;
  EMR_POLYBEZIERTO16: begin
    if not pen.null then
      E.NeedPen;
    if not E.Canvas.FNewPath then
      if not Moved then
        E.Canvas.MoveToI(Position.X,Position.Y);
    if PEMRPolyBezierTo16(R)^.cpts>0 then begin
      for i := 0 to (PEMRPolyBezierTo16(R)^.cpts div 3)-1 do
        E.Canvas.CurveToCI(PEMRPolyBezierTo16(R)^.apts[i*3].X,PEMRPolyBezierTo16(R)^.apts[i*3].Y,
          PEMRPolyBezierTo16(R)^.apts[i*3+1].X,PEMRPolyBezierTo16(R)^.apts[i*3+1].Y,
          PEMRPolyBezierTo16(R)^.apts[i*3+2].X,PEMRPolyBezierTo16(R)^.apts[i*3+2].Y);
      with PEMRPolyBezierTo16(R)^.apts[PEMRPolyBezierTo16(R)^.cpts-1] do begin
        Position.X := X;
        Position.Y := Y;
      end;
    end;
    Moved := false;
    if not E.Canvas.FNewPath then
      if not pen.null then
        E.Canvas.Stroke else
        E.Canvas.NewPath;
  end;
  EMR_POLYLINETO, EMR_POLYLINETO16: begin
    if not pen.null then
      E.NeedPen;
    if not E.Canvas.FNewPath then begin
      E.Canvas.NewPath;
      if not Moved then
        E.Canvas.MoveToI(Position.X,Position.Y);
    end;
    if R^.iType=EMR_POLYLINETO then begin
      if PEMRPolyLineTo(R)^.cptl>0 then begin
        for i := 0 to PEMRPolyLineTo(R)^.cptl-1 do
          E.Canvas.LineToI(PEMRPolyLineTo(R)^.aptl[i].X,PEMRPolyLineTo(R)^.aptl[i].Y);
        Position := PEMRPolyLineTo(R)^.aptl[PEMRPolyLineTo(R)^.cptl-1];
      end;
    end else // EMR_POLYLINETO16
    if PEMRPolyLineTo16(R)^.cpts>0 then begin
      for i := 0 to PEMRPolyLineTo16(R)^.cpts-1 do
        E.Canvas.LineToI(PEMRPolyLineTo16(R)^.apts[i].X,PEMRPolyLineTo16(R)^.apts[i].Y);
      with PEMRPolyLineTo16(R)^.apts[PEMRPolyLineTo16(R)^.cpts-1] do begin
        Position.X := X;
        Position.Y := Y;
      end;
    end;
    Moved := false;
    if not E.Canvas.FNewPath then
      if not pen.null then
        E.Canvas.Stroke else
        E.Canvas.NewPath;
  end;
  EMR_POLYDRAW:
  if PEMRPolyDraw(R)^.cptl>0 then begin
    if not pen.null then
      E.NeedPen;
    polytypes := @PEMRPolyDraw(R)^.aptl[PEMRPolyDraw(R)^.cptl];
    i := 0;
    while i<integer(PEMRPolyDraw(R)^.cptl) do begin
      case polytypes^[i] and not PT_CLOSEFIGURE of
        PT_LINETO: begin
          E.Canvas.LineToI(PEMRPolyDraw(R)^.aptl[i].X,PEMRPolyDraw(R)^.aptl[i].Y);
          if polytypes^[i] and PT_CLOSEFIGURE<>0 then begin
            E.Canvas.LineToI(Position.X, Position.Y);
            Position := PEMRPolyDraw(R)^.aptl[i];
          end;
        end;
        PT_BEZIERTO: begin
          E.Canvas.CurveToCI(PEMRPolyDraw(R)^.aptl[i+1].X,PEMRPolyDraw(R)^.aptl[i+1].Y,
            PEMRPolyDraw(R)^.aptl[i+2].X,PEMRPolyDraw(R)^.aptl[i+2].Y,
            PEMRPolyDraw(R)^.aptl[i+3].X,PEMRPolyDraw(R)^.aptl[i+3].Y);
          inc(i,3);
          if polytypes^[i] and PT_CLOSEFIGURE<>0 then begin
            E.Canvas.LineToI(Position.X, Position.Y);
            Position := PEMRPolyDraw(R)^.aptl[i];
          end;
        end;
        PT_MOVETO: begin
          E.Canvas.MoveToI(PEMRPolyDraw(R)^.aptl[i].X,PEMRPolyDraw(R)^.aptl[i].Y);
          Position := PEMRPolyDraw(R)^.aptl[i];
        end;
      else break; // invalid type
      end;
      inc(i);
    end;
    Position := PEMRPolyDraw(R)^.aptl[PEMRPolyDraw(R)^.cptl-1];
    Moved := False;
    if not E.Canvas.FNewPath then
      if not pen.null then
        E.Canvas.Stroke else
        E.Canvas.NewPath;
  end;
  EMR_POLYDRAW16:
  if PEMRPolyDraw16(R)^.cpts>0 then begin
    if not pen.null then
      E.NeedPen;
    polytypes := @PEMRPolyDraw16(R)^.apts[PEMRPolyDraw16(R)^.cpts];
    i := 0;
    while i<integer(PEMRPolyDraw16(R)^.cpts) do begin
      case polytypes^[i] and not PT_CLOSEFIGURE of
        PT_LINETO: begin
          E.Canvas.LineToI(PEMRPolyDraw16(R)^.apts[i].X,PEMRPolyDraw16(R)^.apts[i].Y);
          if polytypes^[i] and PT_CLOSEFIGURE<>0 then begin
            E.Canvas.LineToI(Position.X, Position.Y);
            with PEMRPolyDraw16(R)^.apts[i] do begin
              Position.X := x;
              Position.Y := y;
            end;
          end;
        end;
        PT_BEZIERTO: begin
          E.Canvas.CurveToCI(PEMRPolyDraw16(R)^.apts[i+1].X,PEMRPolyDraw16(R)^.apts[i+1].Y,
            PEMRPolyDraw16(R)^.apts[i+2].X,PEMRPolyDraw16(R)^.apts[i+2].Y,
            PEMRPolyDraw16(R)^.apts[i+3].X,PEMRPolyDraw16(R)^.apts[i+3].Y);
          inc(i,3);
          if polytypes^[i] and PT_CLOSEFIGURE<>0 then begin
            E.Canvas.LineToI(Position.X, Position.Y);
            with PEMRPolyDraw16(R)^.apts[i] do begin
              Position.X := x;
              Position.Y := y;
            end;
          end;
        end;
        PT_MOVETO: begin
          E.Canvas.MoveToI(PEMRPolyDraw16(R)^.apts[i].X,PEMRPolyDraw16(R)^.apts[i].Y);
          with PEMRPolyDraw16(R)^.apts[i] do begin
            Position.X := x;
            Position.Y := y;
          end;
        end;
      else break; // invalid type
      end;
      inc(i);
    end;
    with PEMRPolyDraw16(R)^.apts[PEMRPolyDraw16(R)^.cpts-1] do begin
      Position.X := x;
      Position.Y := y;
    end;
    Moved := false;
    if not E.Canvas.FNewPath then
      if not pen.null then
        E.Canvas.Stroke else
        E.Canvas.NewPath;
  end;
  EMR_BITBLT: begin
    with PEMRBitBlt(R)^ do // only handle RGB bitmaps (no palette)
      if (offBmiSrc<>0) and (offBitsSrc<>0) then begin
        E.DrawBitmap(xSrc,ySrc,cxDest,cyDest,xDest,yDest,cxDest,cyDest,iUsageSrc,
          pointer(PtrUInt(R)+offBmiSrc),pointer(PtrUInt(R)+offBitsSrc),
          @PEMRBitBlt(R)^.rclBounds, @PEMRBitBlt(R)^.xformSrc, PEMRBitBlt(R)^.dwRop);
      end else
    case PEMRBitBlt(R)^.dwRop of // we only handle PATCOPY = fillrect
      PATCOPY:
        with PEMRBitBlt(R)^ do
          E.FillRectangle(Rect(xDest,yDest,xDest+cxDest,yDest+cyDest),true);
    end;
  end;
  EMR_STRETCHBLT: begin
    with PEMRStretchBlt(R)^ do // only handle RGB bitmaps (no palette)
      if (offBmiSrc<>0) and (offBitsSrc<>0) then begin
        E.DrawBitmap(xSrc,ySrc,cxSrc,cySrc,xDest,yDest,cxDest,cyDest,iUsageSrc,
          pointer(PtrUInt(R)+offBmiSrc),pointer(PtrUInt(R)+offBitsSrc),
          @PEMRStretchBlt(R)^.rclBounds, @PEMRStretchBlt(R)^.xformSrc, PEMRStretchBlt(R)^.dwRop);
      end else
    case PEMRStretchBlt(R)^.dwRop of // we only handle PATCOPY = fillrect
      PATCOPY:
        with PEMRStretchBlt(R)^ do
          E.FillRectangle(Rect(xDest,yDest,xDest+cxDest,yDest+cyDest),true);
    end;
  end;
  EMR_STRETCHDIBITS:
    with PEMRStretchDIBits(R)^ do // only handle RGB bitmaps (no palette)
      if (offBmiSrc<>0) and (offBitsSrc<>0) then begin
        if WorldTransform.eM22 < 0 then
          with PBitmapInfo(PtrUInt(R)+offBmiSrc)^ do
            bmiHeader.biHeight := -bmiHeader.biHeight;
        E.DrawBitmap(xSrc,ySrc,cxSrc,cySrc,xDest,yDest,cxDest,cyDest,iUsageSrc,
          pointer(PtrUInt(R)+offBmiSrc),pointer(PtrUInt(R)+offBitsSrc),
          @PEMRStretchDIBits(R)^.rclBounds, nil, PEMRStretchDIBits(R)^.dwRop);
      end;
  EMR_TRANSPARENTBLT:
    with PEMRTransparentBLT(R)^ do // only handle RGB bitmaps (no palette)
      if (offBmiSrc<>0) and (offBitsSrc<>0) then
        E.DrawBitmap(xSrc,ySrc,cxSrc,cySrc,xDest,yDest,cxDest,cyDest,iUsageSrc,
          pointer(PtrUInt(R)+offBmiSrc),pointer(PtrUInt(R)+offBitsSrc),
          @PEMRTransparentBLT(R)^.rclBounds, @PEMRTransparentBLT(R)^.xformSrc,
          SRCCOPY, PEMRTransparentBLT(R)^.dwRop); // dwRop stores the transparent color
  EMR_GDICOMMENT:
    with PEMRGDICOMMENT(R)^ do
      if cbData>1 then
        E.HandleComment(TPdfGDIComment(Data[0]),PAnsiChar(@Data)+1,cbData-1);
  EMR_MODIFYWORLDTRANSFORM:
    with PEMRModifyWorldTransform(R)^ do
      E.ScaleMatrix(@PEMRModifyWorldTransform(R)^.xform, iMode);
  EMR_EXTCREATEPEN: // approx. - fast solution
    with PEMRExtCreatePen(R)^ do
    if ihPen-1<cardinal(length(E.Obj)) then
      with E.obj[ihPen-1] do begin
        kind := OBJ_PEN;
        PenColor := elp.elpColor;
        PenWidth := elp.elpWidth;
        PenStyle := elp.elpPenStyle and (PS_STYLE_MASK or PS_ENDCAP_MASK);
      end;
  EMR_SETMITERLIMIT:
    if PEMRSetMiterLimit(R)^.eMiterLimit>0.1 then
      E.Canvas.SetMiterLimit(PEMRSetMiterLimit(R)^.eMiterLimit);
  EMR_SETMETARGN:
    E.SetMetaRgn;
  EMR_EXTSELECTCLIPRGN:
    E.ExtSelectClipRgn(@PEMRExtSelectClipRgn(R)^.RgnData[0],PEMRExtSelectClipRgn(R)^.iMode);
  EMR_INTERSECTCLIPRECT:
    ClipRgn := E.IntersectClipRect(E.Canvas.BoxI(PEMRIntersectClipRect(r)^.rclClip,true),ClipRgn);
  EMR_SETMAPMODE:
    MappingMode := PEMRSetMapMode(R)^.iMode;
  EMR_BEGINPATH: begin
    E.Canvas.NewPath;
    if not Moved then begin
      E.Canvas.MoveToI(Position.X,Position.Y);
      Moved := true;
    end;
  end;
  EMR_ENDPATH:
    E.Canvas.fNewPath := false;
  EMR_ABORTPATH: begin
    E.Canvas.NewPath;
    E.Canvas.fNewPath := false;
    end;
  EMR_CLOSEFIGURE:
    E.Canvas.ClosePath;
  EMR_FILLPATH: begin
    if not brush.Null then begin
      E.FillColor := brush.color;
      E.Canvas.Fill;
    end;
    E.Canvas.NewPath;
    E.Canvas.fNewPath := false;
  end;
  EMR_STROKEPATH: begin
    if not pen.null then begin
      E.NeedPen;
      E.Canvas.Stroke;
    end;
    E.Canvas.NewPath;
    E.Canvas.fNewPath := false;
  end;
  EMR_STROKEANDFILLPATH: begin
    if not brush.Null then begin
      E.NeedPen;
      E.FillColor := brush.color;
      if not pen.null then
        if PolyFillMode=ALTERNATE then
          E.Canvas.EofillStroke else
          E.Canvas.FillStroke
      else if PolyFillMode=ALTERNATE then
        E.Canvas.EoFill else
        E.Canvas.Fill
    end else
    if not pen.null then begin
      E.NeedPen;
      E.Canvas.Stroke;
    end;
    E.Canvas.NewPath;
    E.Canvas.fNewPath := False;
  end;
  EMR_SETPOLYFILLMODE:
    PolyFillMode := PEMRSetPolyFillMode(R)^.iMode;
  EMR_GRADIENTFILL:
    E.GradientFill(PEMGradientFill(R));
  EMR_SETSTRETCHBLTMODE:
    StretchBltMode := PEMRSetStretchBltMode(R)^.iMode;
  EMR_SETARCDIRECTION:
    ArcDirection := PEMRSetArcDirection(R)^.iArcDirection;
  EMR_SETPIXELV: begin
    // prepare pixel size and color
    if pen.width<>1 then begin
      E.fPenWidth := E.Canvas.GetWorldFactorX * E.Canvas.FDevScaleX;
      E.Canvas.SetLineWidth(E.fPenWidth * E.Canvas.FFactorX);
    end;
    if PEMRSetPixelV(R)^.crColor<>Cardinal(pen.color) then
      E.Canvas.SetRGBStrokeColor(PEMRSetPixelV(R)^.crColor);
    // draw point
    Position := Point(PEMRSetPixelV(R)^.ptlPixel.X, PEMRSetPixelV(R)^.ptlPixel.Y);
    E.Canvas.PointI(Position.X,Position.Y);
    E.Canvas.Stroke;
    Moved := false;
    // roll back pixel size and color
    if pen.width<>1 then begin
      E.fPenWidth := pen.width * E.Canvas.GetWorldFactorX * E.Canvas.FDevScaleX;
      E.Canvas.SetLineWidth(E.fPenWidth * E.Canvas.FFactorX);
    end;
    if PEMRSetPixelV(R)^.crColor<>Cardinal(pen.color) then
      E.Canvas.SetRGBStrokeColor(pen.color);
  end;
  // TBD
  EMR_SMALLTEXTOUT,
  EMR_SETROP2,
  EMR_ALPHADIBBLEND,
  EMR_SETBRUSHORGEX,
  EMR_SETICMMODE,
  EMR_SELECTPALETTE,
  EMR_CREATEPALETTE,
  EMR_SETPALETTEENTRIES,
  EMR_RESIZEPALETTE,
  EMR_REALIZEPALETTE,
  EMR_EOF: ; //do nothing
  else
    R^.iType := R^.iType; // for debug purpose (breakpoint)
  end;
  case R^.iType of
    EMR_RESTOREDC,
    EMR_SETWINDOWEXTEX,
    EMR_SETWINDOWORGEX,
    EMR_SETVIEWPORTEXTEX,
    EMR_SETVIEWPORTORGEX,
    EMR_SETMAPMODE:
      E.ScaleMatrix(nil, MWT_SET); //recalc new transformation
  end;
end;

procedure TPdfCanvas.RenderMetaFile(MF: TMetaFile; ScaleX, ScaleY, XOff, YOff: single;
  TextPositioning: TPdfCanvasRenderMetaFileTextPositioning;
  KerningHScaleBottom, KerningHScaleTop: single;
  TextClipping: TPdfCanvasRenderMetaFileTextClipping);
var E: TPdfEnum;
    R: TRect;
begin
  R.Left := 0;
  R.Top := 0;
  R.Right := MF.Width;
  R.Bottom := MF.Height;
  if ScaleY=0 then
    ScaleY := ScaleX; // if ScaleY is ommited -> assume symetric coordinates
  E := TPdfEnum.Create(self);
  try
    FOffsetXDef := XOff;
    FOffsetYDef := YOff;
    FDevScaleX := ScaleX * FFactor;
    FDevScaleY := ScaleY * FFactor;
    FEmfBounds := R; // keep device rect
    fUseMetaFileTextPositioning := TextPositioning;
    fUseMetaFileTextClipping := TextClipping;
    fKerningHScaleBottom := KerningHScaleBottom;
    fKerningHScaleTop := KerningHScaleTop;
    if FDoc.FPrinterPxPerInch.X=0 then
      FDoc.FPrinterPxPerInch := CurrentPrinterRes; // caching for major speedup
    FPrinterPxPerInch := FDoc.FPrinterPxPerInch;
    with E.DC[0] do begin
      Int64(WinSize) := PInt64(@R.Right)^;
      ViewSize := WinSize;
    end;
    GSave;
    try
      EnumEnhMetaFile(fDoc.FDC,MF.Handle,@EnumEMFFunc,E,R);
    finally
      GRestore;
    end;
  finally
    E.Free;
  end;
end;



{ TPdfEnum }

constructor TPdfEnum.Create(ACanvas: TPdfCanvas);
begin
  Canvas := ACanvas;
  // set invalid colors or style -> force paint
  fFillColor := -1;
  fStrokeColor := -1;
  fPenStyle := -1;
  fPenWidth := -1;
  DC[0].brush.null := true;
  fInitTransformMatrix := DefaultIdentityMatrix;
  DC[0].WorldTransform := fInitTransformMatrix;
  fInitMetaRgn := PdfBox(0, 0, 0, 0);
  DC[0].ClipRgnNull := True;
  DC[0].MappingMode := MM_TEXT;
  DC[0].PolyFillMode := ALTERNATE;
  DC[0].StretchBltMode := STRETCH_DELETESCANS;
end;

procedure TPdfEnum.CreateFont(aLogFont: PEMRExtCreateFontIndirect);
var HF: HFONT;
    TM: TTextMetric;
    Old: HGDIOBJ;
    destDC: HDC;
begin
  destDC := Canvas.fDoc.FDC;
  HF := CreateFontIndirectW(aLogFont.elfw.elfLogFont);
  Old := SelectObject(destDC,HF);
  GetTextMetrics(destDC,TM);
  SelectObject(destDC,Old);
  DeleteObject(HF);
  if aLogFont^.ihFont-1<cardinal(length(obj)) then
    with obj[aLogFont^.ihFont-1] do begin
      kind := OBJ_FONT;
      MoveFast(aLogFont^.elfw.elfLogFont,LogFont,sizeof(LogFont));
      LogFont.lfPitchAndFamily := TM.tmPitchAndFamily;
      if LogFont.lfOrientation<>0 then
        FontSpec.angle := LogFont.lfOrientation div 10 else // -360..+360
        FontSpec.angle := LogFont.lfEscapement div 10;
      FontSpec.ascent := TM.tmAscent;
      FontSpec.descent := TM.tmDescent;
      FontSpec.cell := TM.tmHeight-TM.tmInternalLeading;
    end;
end;

procedure TPdfEnum.DrawBitmap(xs, ys, ws, hs, xd, yd, wd, hd, usage: integer;
  Bmi: PBitmapInfo; bits: pointer; clipRect: PRect; xSrcTransform: PXForm; dwRop: DWord;
  transparent: TPdfColorRGB = $FFFFFFFF);
var B: TBitmap;
    R: TRect;
    Box, ClipRc: TPdfBox;
    fIntFactorX, fIntFactorY, fIntOffsetX, fIntOffsetY: Single;
begin
  B := TBitmap.Create;
  try
    InitTransformation(xSrcTransform, fIntFactorX, fIntFactorY, fIntOffsetX, fIntOffsetY);
    // create a TBitmap with (0,0,ws,hs) bounds from DIB bits and info
    if Bmi^.bmiHeader.biBitCount=1 then
      B.Monochrome := true else
      B.PixelFormat := pf24bit;
    B.Width := ws;
    B.Height := hs;
    StretchDIBits(B.Canvas.Handle,0, 0, ws, hs, Trunc(xs+fIntOffsetX), Trunc(ys+fIntOffsetY),
      Trunc(ws*fIntFactorX), Trunc(hs*fIntFactorY), bits, Bmi^, usage, dwRop);
    if transparent <> $FFFFFFFF then begin
      if integer(transparent)<0 then
        transparent := GetSysColor(transparent and $ff);
      B.TransparentColor := transparent;
    end;
    // draw the bitmap on the PDF canvas
    with Canvas do begin
      R := Rect(xd, yd, wd+xd, hd+yd);
      NormalizeRect(R);
      Box := BoxI(R,true);
      ClipRc := GetClipRect;
      if (ClipRc.Width>0) and (ClipRc.Height>0) then
        Doc.CreateOrGetImage(B, @Box, @ClipRc) else // use cliping
        Doc.CreateOrGetImage(B, @Box, nil);
      // Doc.CreateOrGetImage() will reuse any matching TPdfImage
      // don't send bmi and bits parameters here, because of StretchDIBits above
    end;
  finally
    B.Free;
  end;
end;

// simulate gradient (not finished)
procedure TPdfEnum.GradientFill(data: PEMGradientFill);
type
  PTriVertex = ^TTriVertex;
  TTriVertex = packed record // circumvent some bug in older Delphi
    X: Longint;
    Y: Longint;
    Red: word; // COLOR16 wrongly defined in Delphi 6/7 e.g.
    Green: word;
    Blue: word;
    Alpha: word;
  end;
  PTriVertexArray = ^TTriVertexArray;
  TTriVertexArray = array[word] of TTriVertex;
  PGradientTriArray = ^TGradientTriArray;
  TGradientTriArray = array[word] of TGradientTriangle;
  PGradientRectArray = ^TGradientRectArray;
  TGradientRectArray = array[word] of TGradientRect;
var i: Integer;
    pGradientTriVertex: PTriVertexArray;
    pGradientTri: PGradientTriArray;
    pGradientRect: PGradientRectArray;
    pt1, pt2: PTriVertex;
//    Direction: TGradientDirection;
begin
  if data^.nVer>0 then begin
    pGradientTriVertex := @data.Ver;
    case data^.ulMode of
    GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V: begin
      Canvas.NewPath;
      pGradientRect := @pGradientTriVertex[data^.nVer];
{      Direction := gdHorizontal;
      if data^.ulMode = GRADIENT_FILL_RECT_V then
        Direction := gdVertical; }
      for i := 1 to data^.nTri do
      with pGradientRect[i-1] do begin
        pt1 := @pGradientTriVertex[UpperLeft];
        pt2 := @pGradientTriVertex[LowerRight];
        Canvas.MoveToI(pt1.X, pt1.Y);
        Canvas.LineToI(pt1.X, pt2.Y);
        Canvas.LineToI(pt2.X, pt2.Y);
        Canvas.LineToI(pt2.X, pt1.Y);
        Canvas.Closepath;
        Canvas.Fill;
      end;
    end;
    GRADIENT_FILL_TRIANGLE: begin
      Canvas.NewPath;
      pGradientTri := @pGradientTriVertex[data^.nVer];
      for i := 1 to data^.nTri do
      with pGradientTri[i-1] do begin
        with pGradientTriVertex[Vertex1] do begin
          FillColor := RGBA(Red,Green,Blue,0); // ignore Alpha
          Canvas.MoveToI(X,Y);
        end;
        with pGradientTriVertex[Vertex2] do Canvas.LineToI(X,Y);
        with pGradientTriVertex[Vertex3] do Canvas.LineToI(X,Y);
        with pGradientTriVertex[Vertex1] do Canvas.LineToI(X,Y);
        //DC[nDC].Moved := Point(pt1.X, pt1.Y);
        Canvas.Closepath;
        Canvas.Fill;
      end;
    end;
    end;
  end;
end;

procedure TPdfEnum.PolyPoly(data: PEMRPolyPolygon; iType: Integer);
var i, j, PolyOffs, PolyFirst: DWord;
    pPolyPointsArray: PPointArray;
    pPolyPointsArray16: PSmallPointArray;
    data16: PEMRPolyPolygon16 absolute data;
begin
  NeedBrushAndPen;
  if not Canvas.FNewPath then
    Canvas.NewPath;
  case iType of
    EMR_POLYPOLYGON, EMR_POLYPOLYLINE: begin
      PolyOffs := 0;
      pPolyPointsArray := pointer(PtrUInt(data) + SizeOf(TEMRPolyPolyline)
        - SizeOf(TPoint) + (data^.nPolys - 1)*SizeOf(DWORD));
      for i := 1 to data^.nPolys do begin
        PolyFirst := PolyOffs;
        Canvas.MoveToI(pPolyPointsArray[PolyOffs].X, pPolyPointsArray[PolyOffs].Y);
        Inc(PolyOffs);
        for j := 2 to data^.aPolyCounts[i-1] do begin
          Canvas.LineToI(pPolyPointsArray[PolyOffs].X, pPolyPointsArray[PolyOffs].Y);
          DC[nDC].Position := Point(pPolyPointsArray[PolyOffs].X, pPolyPointsArray[PolyOffs].Y);
          Inc(PolyOffs);
        end;
        Canvas.LineToI(pPolyPointsArray[PolyFirst].X, pPolyPointsArray[PolyFirst].Y);
        DC[nDC].Moved := false;
      end;
    end;
    EMR_POLYPOLYGON16, EMR_POLYPOLYLINE16: begin
      PolyOffs := 0;
      pPolyPointsArray16 := pointer(PtrUInt(data16) + SizeOf(TEMRPolyPolyline16)
        - SizeOf(TSmallPoint) + (data16^.nPolys - 1)*SizeOf(DWORD));
      for i := 1 to data16^.nPolys do begin
        PolyFirst := PolyOffs;
        Canvas.MoveToI(pPolyPointsArray16[PolyOffs].X, pPolyPointsArray16[PolyOffs].Y);
        Inc(PolyOffs);
        for j := 2 to data16^.aPolyCounts[i-1] do begin
          Canvas.LineToI(pPolyPointsArray16[PolyOffs].X, pPolyPointsArray16[PolyOffs].Y);
          DC[nDC].Position := Point(pPolyPointsArray16[PolyOffs].X, pPolyPointsArray16[PolyOffs].Y);
          Inc(PolyOffs);
        end;
        Canvas.LineToI(pPolyPointsArray16[PolyFirst].X, pPolyPointsArray16[PolyFirst].Y);
        DC[nDC].Moved := false;
      end;
    end;
  end;
  if iType in [EMR_POLYPOLYLINE, EMR_POLYPOLYLINE16] then begin // stroke
    if not DC[nDC].pen.null then
      Canvas.Stroke else
      Canvas.NewPath;
  end else begin // fill
    if not DC[nDC].brush.null then begin
      if not DC[nDC].pen.null then
        if DC[nDC].PolyFillMode=ALTERNATE then
          Canvas.EofillStroke else
          Canvas.FillStroke
      else if DC[nDC].PolyFillMode=ALTERNATE then
        Canvas.EoFill else
        Canvas.Fill
    end else
      if not DC[nDC].pen.null then
        Canvas.Stroke else
        Canvas.NewPath;
  end;
end;

procedure TPdfEnum.FillRectangle(const Rect: TRect; ResetNewPath: boolean);
begin
  if DC[nDC].brush.null then
    exit;
  Canvas.NewPath;
  FillColor := DC[nDC].brush.color;
  with Canvas.BoxI(Rect,true) do
    Canvas.Rectangle(Left,Top,Width,Height);
  Canvas.Fill;
  if ResetNewPath then
    Canvas.FNewPath := false;
end;

procedure TPdfEnum.FlushPenBrush;
begin
  with DC[nDC] do begin
    if brush.null then begin
      if not pen.null then
        Canvas.Stroke else
        Canvas.NewPath;
    end else
    if pen.null then
      Canvas.Fill else
      Canvas.FillStroke;
  end;
end;

procedure TPdfEnum.SelectObjectFromIndex(iObject: integer);
begin
  with DC[nDC] do begin
    if iObject<0 then begin // stock object?
      iObject := iObject and $7fffffff;
      case iObject of
        NULL_BRUSH:
          brush.null := true;
        WHITE_BRUSH..BLACK_BRUSH: begin
          brush.color := STOCKBRUSHCOLOR[iObject];
          brush.null := false;
        end;
        NULL_PEN: begin
          if fInLined and ((pen.style<>PS_NULL) or not pen.null) then begin
            fInLined := False;
            if not pen.null then
              Canvas.Stroke;
          end;
          pen.style := PS_NULL;
          pen.null := true;
        end;
        WHITE_PEN, BLACK_PEN: begin
          if fInLined and ((pen.color<>STOCKPENCOLOR[iObject]) or not pen.null) then begin
            fInLined := False;
            if not pen.null then
              Canvas.Stroke;
          end;
          pen.color := STOCKPENCOLOR[iObject];
          pen.null := false;
        end;
      end;
    end else
    if cardinal(iObject-1)<cardinal(length(Obj)) then // avoid GPF
      with Obj[iObject-1] do
      case Kind of // ignore any invalid reference
        OBJ_PEN: begin
          if fInLined and
            ((pen.color<>PenColor) or (pen.width<>PenWidth) or
             (pen.style<>PenStyle)) then begin
            fInLined := False;
            if not pen.null then
              Canvas.Stroke;
          end;
          pen.null := (PenWidth<0) or (PenStyle=PS_NULL); // !! 0 means as thick as possible
          pen.color := PenColor;
          pen.width := PenWidth;
          pen.style := PenStyle;
        end;
        OBJ_BRUSH: begin
          brush.null := BrushNull;
          brush.color := BrushColor;
          brush.style := BrushStyle;
        end;
        OBJ_FONT: begin
          font.spec := FontSpec;
          MoveFast(LogFont,font.LogFont,sizeof(LogFont));
        end;
      end;
  end;
end;

procedure TPdfEnum.HandleComment(Kind: TPdfGDIComment; P: PAnsiChar; Len: integer);
var Text: RawUTF8;
    W: integer;
    Img: TPdfImage;
    ImgName: PDFString;
    ImgRect: TPdfRect;
begin
  try
    case Kind of
      pgcOutline:
      if Len>1 then begin
        SetString(Text,P+1,Len-1);
        Canvas.Doc.CreateOutline(UTF8ToString(Trim(Text)),PByte(P)^,
          Canvas.I2Y(DC[nDC].Position.Y));
      end;
      pgcBookmark: begin
        SetString(Text,P,Len);
        Canvas.Doc.CreateBookMark(Canvas.I2Y(DC[nDC].Position.Y),Text);
      end;
      pgcLink,pgcLinkNoBorder:
      if Len>Sizeof(TRect) then begin
        SetString(Text,P+SizeOf(TRect),Len-SizeOf(TRect));
        if Kind=pgcLink then
          W := 1 else
          W := 0;
        Canvas.Doc.CreateLink(Canvas.RectI(PRect(P)^,true),Text,abSolid,W);
      end;
      pgcJpegDirect:
      if Len>Sizeof(TRect) then begin
        SetString(Text,P+SizeOf(TRect),Len-SizeOf(TRect));
        ImgName := 'SynImgJpg'+PDFString(crc32cUTF8ToHex(Text));
        if Canvas.Doc.GetXObject(ImgName) = nil then
        begin
          Img := TPdfImage.CreateJpegDirect(Canvas.Doc,UTF8ToString(Text));
          Canvas.Doc.RegisterXObject(Img,ImgName);
        end;
        ImgRect := Canvas.RectI(PRect(P)^,true);
        Canvas.DrawXObject(ImgRect.Left,ImgRect.Top,ImgRect.Right-ImgRect.Left,ImgRect.Bottom-ImgRect.Top,ImgName);
      end;
    end;
  except
    on E: Exception do ; // ignore any error (continue EMF enumeration)
  end;
end;

procedure TPdfEnum.NeedBrushAndPen;
begin
  if fInlined then begin
    fInlined := false;
    Canvas.Stroke;
  end;
  NeedPen;
  with DC[nDC] do
  if not brush.null then
    FillColor := brush.color;
end;

procedure TPdfEnum.NeedPen;
begin
  with DC[nDC] do
  if not pen.null then begin
    StrokeColor := pen.color;
    if pen.style<>fPenStyle then begin
      case pen.style and PS_STYLE_MASK of
        PS_DASH:       Canvas.SetDash([4,4]);
        PS_DOT:        Canvas.SetDash([1,1]);
        PS_DASHDOT:    Canvas.SetDash([4,1,1,1]);
        PS_DASHDOTDOT: Canvas.SetDash([4,1,1,1,1,1]);
        else           Canvas.SetDash([]);
      end;
      case Pen.style and PS_ENDCAP_MASK of
        PS_ENDCAP_ROUND:  Canvas.SetLineCap(lcRound_End);
        PS_ENDCAP_SQUARE: Canvas.SetLineCap(lcProjectingSquareEnd);
        PS_ENDCAP_FLAT:   Canvas.SetLineCap(lcButt_End);
      end;
      fPenStyle := pen.style;
    end;
    if pen.width * Canvas.GetWorldFactorX * Canvas.FDevScaleX<>fPenWidth then begin
      if pen.width=0 then
        fPenWidth := Canvas.GetWorldFactorX * Canvas.FDevScaleX else
        fPenWidth := pen.width * Canvas.GetWorldFactorX * Canvas.FDevScaleX;
      Canvas.SetLineWidth(fPenWidth * Canvas.FFactorX);
    end;
  end else begin
    // pen.null need reset values
    fStrokeColor := -1;
    fPenWidth := -1;
    fPenStyle := -1;
  end;
end;

procedure TPdfEnum.RestoreDC;
begin
  Assert(nDC>0);
  dec(nDC);
end;

procedure TPdfEnum.SaveDC;
begin
  Assert(nDC<high(DC));
  DC[nDC+1] := DC[nDC];
  inc(nDC);
end;

procedure TPdfEnum.ScaleMatrix(Custom: PXForm; iMode: Integer);
var ScaleXForm: XForm;
    xdim, ydim: Single;
    mx, my: Integer;
begin
  if fInlined then begin
    fInlined := false;
    if not DC[nDC].pen.null then
      Canvas.Stroke;
  end;
  with DC[nDC], Canvas do begin
    FViewSize := ViewSize;
    FViewOrg := ViewOrg;
    FWinSize := WinSize;
    FWinOrg := WinOrg;
    case MappingMode of
      MM_TEXT: begin
        FViewSize.cx := 1;
        FViewSize.cy := 1;
        FWinSize.cx := 1;
        FWinSize.cy := 1;
      end;
      MM_LOMETRIC: begin
        FViewSize.cx := FPrinterPxPerInch.X;
        FViewSize.cy := -FPrinterPxPerInch.Y;
        FWinSize.cx := WinSize.cx*10;
        FWinSize.cy := WinSize.cy*10;
      end;
      MM_HIMETRIC: begin
        FViewSize.cx := FPrinterPxPerInch.X;
        FViewSize.cy := -FPrinterPxPerInch.Y;
        FWinSize.cx := WinSize.cx*100;
        FWinSize.cy := WinSize.cy*100;
      end;
      MM_LOENGLISH: begin
        FViewSize.cx := FPrinterPxPerInch.X;
        FViewSize.cy := -FPrinterPxPerInch.Y;
        FWinSize.cx := MulDiv(1000, WinSize.cx, 254);
        FWinSize.cy := MulDiv(1000, WinSize.cy, 254);
      end;
      MM_HIENGLISH: begin
        FViewSize.cx := FPrinterPxPerInch.X;
        FViewSize.cy := -FPrinterPxPerInch.Y;
        FWinSize.cx := MulDiv(10000, WinSize.cx, 254);
        FWinSize.cy := MulDiv(10000, WinSize.cy, 254);
      end;
      MM_TWIPS: begin
        FViewSize.cx := FPrinterPxPerInch.X;
        FViewSize.cy := -FPrinterPxPerInch.Y;
        FWinSize.cx := MulDiv(14400, WinSize.cx, 254);
        FWinSize.cy := MulDiv(14400, WinSize.cy, 254);
      end;
      MM_ISOTROPIC: begin
        FViewSize.cx := FPrinterPxPerInch.X;
        FViewSize.cy := -FPrinterPxPerInch.Y;
        FWinSize.cx := WinSize.cx*10;
        FWinSize.cy := WinSize.cy*10;
        xdim := Abs(FViewSize.cx * WinSize.cx / (FPrinterPxPerInch.X * FWinSize.cx));
        ydim := Abs(FViewSize.cy * WinSize.cy / (FPrinterPxPerInch.Y * FWinSize.cy));
        if (xdim > ydim) then begin
          if FViewSize.cx>=0 then
            mx := 1 else
            mx := -1;
          FViewSize.cx := Trunc(FViewSize.cx * ydim / xdim + 0.5);
          if FViewSize.cx=0 then
            FViewSize.cx := mx;
        end else begin
          if FViewSize.cy>=0 then
            my := 1 else
            my := -1;
          FViewSize.cy := Trunc(FViewSize.cy * xdim / ydim + 0.5);
          if FViewSize.cy=0 then
            FViewSize.cy := my;
        end;
      end;
      MM_ANISOTROPIC:
        ;  // TBD
    end;
    if FWinSize.cx=0 then // avoid EZeroDivide
      FFactorX := 1.0 else
      FFactorX := Abs(FViewSize.cx / FWinSize.cx);
    if FWinSize.cy=0 then // avoid EZeroDivide
      FFactorY := 1.0 else
      FFactorY := Abs(FViewSize.cy / FWinSize.cy);
    if Custom<>nil then begin
      // S.eM11=FFactorX S.eM12=0 S.eM21=0 S.eM22=FFactorY multiplied by Custom^
      case iMode of
        MWT_IDENTITY: // reset identity matrix
          WorldTransform := DefaultIdentityMatrix;
        MWT_LEFTMULTIPLY:
          WorldTransform := CombineTransform(Custom^, WorldTransform);
        MWT_RIGHTMULTIPLY:
          WorldTransform := CombineTransform(WorldTransform, Custom^);
        MWT_SET:
          WorldTransform := Custom^;
      end;
    end;
    // use transformation
    ScaleXForm := WorldTransform;
    if (ScaleXForm.eM11 > 0) and
       (ScaleXForm.eM22 > 0) and
       (ScaleXForm.eM12 = 0) and
       (ScaleXForm.eM21 = 0) then
    begin // Scale
      FWorldFactorX := ScaleXForm.eM11;
      FWorldFactorY := ScaleXForm.eM22;
      FWorldOffsetX := WorldTransform.eDx;
      FWorldOffsetY := WorldTransform.eDy;
    end
    else
    if (ScaleXForm.eM22 = ScaleXForm.eM11) and
       (ScaleXForm.eM21 = -ScaleXForm.eM12) then
    begin // Rotate
      FAngle := ArcSin(ScaleXForm.eM12) * c180divPI;
      FWorldCos := ScaleXForm.eM11;
      FWorldSin := ScaleXForm.eM12;
    end
    else
    if (ScaleXForm.eM11 = 0) and
       (ScaleXForm.eM22 = 0) and
       ((ScaleXForm.eM12 <> 0) or
       (ScaleXForm.eM21 <> 0)) then
    begin //Shear

    end
    else
    if ((ScaleXForm.eM11 < 0) or
        (ScaleXForm.eM22 < 0)) and
       (ScaleXForm.eM12 = 0) and
       (ScaleXForm.eM21 = 0) then
    begin //Reflection

    end;
  end;
end;

procedure TPdfEnum.InitMetaRgn(ClientRect: TRect);
begin
  fInitMetaRgn := Canvas.BoxI(ClientRect,true);
  DC[nDC].ClipRgnNull := True;
  DC[nDC].MetaRgn := fInitMetaRgn;
end;

procedure TPdfEnum.SetMetaRgn;
begin
  try
    with DC[nDC] do
    if not ClipRgnNull then begin
      MetaRgn := IntersectClipRect(ClipRgn, MetaRgn);
      FillCharFast(ClipRgn,sizeof(ClipRgn),0);
      ClipRgnNull := True;
    end;
  except
    on E: Exception do ; // ignore any error (continue EMF enumeration)
  end;
end;

function TPdfEnum.IntersectClipRect(const ClpRect: TPdfBox; const CurrRect: TPdfBox): TPdfBox;
begin
  Result := CurrRect;
  if (ClpRect.Width<>0) or (ClpRect.Height<>0) then begin // ignore null clipping area
    if ClpRect.Left > Result.Left then
      Result.Left := ClpRect.Left;
    if ClpRect.Top > Result.Top then
      Result.Top := ClpRect.Top;
    if (ClpRect.Left+ClpRect.Width) < (Result.Left+Result.Width) then
      Result.Width := (ClpRect.Left+ClpRect.Width) - Result.Left;
    if (ClpRect.Top + ClpRect.Height) < (Result.Top + Result.Height) then
      Result.Height := (ClpRect.Top + ClpRect.Height) - Result.Top;
    // fix rect
    if Result.Width<0 then
      Result.Width := 0;
    if Result.Height<0 then
      Result.Height := 0;
  end;
end;

procedure TPdfEnum.ExtSelectClipRgn(data: PRgnDataHeader; iMode: DWord);
var ExtClip: TRect;
begin
  try
    ExtClip := data^.rcBound;
    with DC[nDC] do
    case iMode of
      RGN_COPY: begin
        ClipRgn := MetaRgn;
        ClipRgnNull := False;
      end;
    end;
  except
    on E: Exception do ; // ignore any error (continue EMF enumeration)
  end;
end;

function TPdfEnum.GetClipRect: TPdfBox;
begin // get current clip area
  with DC[nDC] do
  if ClipRgnNull then
    Result := MetaRgn else
    Result := ClipRgn;
end;

procedure TPdfEnum.SetFillColor(const Value: integer);
begin
  if fFillColor=Value then
    exit;
  Canvas.SetRGBFillColor(Value);
  fFillColor := Value;
end;

procedure TPdfEnum.SetStrokeColor(const Value: integer);
begin
  if fStrokeColor=Value then
    exit;
  Canvas.SetRGBStrokeColor(Value);
  fStrokeColor := Value;
end;

function DXTextWidth(DX: PIntegerArray; n: Integer): integer;
var i: integer;
begin
  result := 0;
  for i := 0 to n-1 do
    inc(result,DX^[i]);
end;

procedure TPdfEnum.TextOut(var R: TEMRExtTextOut);
var nspace,i: integer;
    cur: cardinal;
    wW, measW, W,H,hscale: Single;
    DX: PIntegerArray; // not handled during drawing yet
    Posi: TPoint;
    AWidth, ASize, PosX, PosY: single;
    APDFFont: TPDFFont;
    tmp: array of WideChar; // R.emrtext is not #0 terminated -> use tmp[]
    tmpChar: array[0..1] of WideChar;
    a, acos, asin, fscaleX, fscaleY: single;
    AUseDX, WithClip, bOpaque: Boolean;
    ClipRect: TPdfBox;
    ASignX, ASignY: Integer;
    backRect: TRect;
    Positioning: TPdfCanvasRenderMetaFileTextPositioning;
    {$ifdef USE_UNISCRIBE}
    ADC: HDC;
    AnExtent: TSize;
    {$endif}

procedure DrawLine(var P: TPoint; aH: Single);
var tmp: TPdfEnumStatePen;
begin
  with DC[nDC] do begin
    tmp := Pen;
    pen.color := font.color;
    pen.width := aSize / 15 / Canvas.GetWorldFactorX / Canvas.FDevScaleX;
    pen.style := PS_SOLID;
    pen.null := False;
    NeedPen;
    if font.spec.angle=0 then begin
      // P = textout original coords
      // (-W,-H) = delta to text start pos (at baseline)
      // wW = text width
      // aH = delta H for drawed line (from baseline)
      Canvas.MoveToI(P.X  -W,(P.Y-(H-aH)));  //  deltax := -W     deltaY := (-H+aH)
      Canvas.LineToI(P.X -W+wW,(P.Y-(H-aH)));//  deltax := -W+wW  deltaY := (-H+aH)
    end else begin
      // rotation pattern :
      //       rdx = deltax * acos + deltay * asin
      //       rdy = deltay * acos - deltax * asin
      Canvas.MoveToI( P.X+( (-W)  *acos +(-H+aH)*asin ),
                      P.Y+((-H+aH)*acos -(-W)   *asin )  );

      Canvas.LineToI( P.X+((-W+wW) *acos +(-H+aH)*asin ),
                      P.Y+((-H+aH) *acos -(-W+wW)*asin )  );
    end;
    Canvas.Stroke;
    Pen := tmp;
    NeedPen;
  end;
end;

begin
  if R.emrtext.nChars>0 then
  with DC[nDC] do begin
    SetLength(tmp,R.emrtext.nChars+1); // faster than WideString for our purpose
    MoveFast(pointer(PtrUInt(@R)+R.emrtext.offString)^,tmp[0],R.emrtext.nChars*2);
    ASignY := 1;
    ASignX := 1;
    if (Canvas.FWorldFactorY) < 0 then
      ASignY := -1;
    if (Canvas.FWorldFactorX) < 0 then
      ASignX := -1;
    fscaleY := Abs(Canvas.fFactorY * Canvas.GetWorldFactorY * Canvas.FDevScaleY);
    fscaleX := Abs(Canvas.fFactorX * Canvas.GetWorldFactorX * Canvas.FDevScaleX);
    // guess the font size
    if font.LogFont.lfHeight<0 then
      ASize := Abs(font.LogFont.lfHeight)*fscaleY else
      ASize := Abs(font.spec.cell)*fscaleY;
    // ensure this font is selected (very fast if was already selected)
    APDFFont := Canvas.SetFont(Canvas.FDoc.FDC, font.LogFont, ASize);
    // calculate coordinates
    Positioning := Canvas.fUseMetaFileTextPositioning;
    if (R.emrtext.fOptions and ETO_GLYPH_INDEX<>0) then
      measW := 0 else begin
      AWidth := 0;
      {$ifdef USE_UNISCRIBE}
      if Assigned(APDFFont) and Canvas.fDoc.UseUniScribe and
         APDFFont.InheritsFrom(TPdfFontTrueType) then begin
        ADC := Canvas.FDoc.GetDCWithFont(TPdfFontTrueType(APDFFont));
        if GetTextExtentPoint32W(ADC,Pointer(tmp),R.emrtext.nChars,AnExtent) then
          AWidth := (AnExtent.cX * Canvas.FPage.FFontSize) / 1000;
      end;
      {$endif}
      if AWidth=0 then
        AWidth := Canvas.UnicodeTextWidth(Pointer(tmp));
      measW := Round(AWidth / fscaleX);
    end;
    AUseDX := R.emrtext.offDx > 0;
    {$ifdef USE_UNISCRIBE}
    if Canvas.fDoc.UseUniScribe then
      AUseDX := AUseDX and (R.emrtext.fOptions and ETO_GLYPH_INDEX <> 0);
    {$endif}
    if AUseDX then begin
      DX := pointer(PtrUInt(@R)+R.emrtext.offDx);
      W := DXTextWidth(DX, R.emrText.nChars);
      if W<R.rclBounds.Right-R.rclBounds.Left then // offDX=0 or within box
        DX := nil;
    end else
      DX := nil;
    if DX=nil then begin
      W := measW;
      if Positioning=tpExactTextCharacterPositining then
        Positioning := tpSetTextJustification; // exact position expects DX
    end;
    nspace := 0;
    hscale := 100;
    if measW<>0 then begin
      for i := 0 to R.emrtext.nChars-1 do
        if tmp[i]=' ' then
          inc(nspace);
      if (Positioning=tpSetTextJustification) and
         ((nspace=0) or ((W-measW)<nspace)) then
          Positioning := tpKerningFromAveragePosition;
      if (Positioning=tpExactTextCharacterPositining) and (font.spec.angle<>0) then
        Positioning := tpKerningFromAveragePosition;
      case Positioning of
      tpSetTextJustification:
        // we should have had a SetTextJustification() call -> modify word space
        with Canvas do
          SetWordSpace(((W-measW) * fscaleX)/nspace);
      tpKerningFromAveragePosition: begin
        // check if DX[] width differs from PDF width
        hscale := (W*100) / measW;
        // implement some global kerning if needed (allow hysteresis around 100%)
        if (hscale<Canvas.fKerningHScaleBottom) or
           (hscale>Canvas.fKerningHScaleTop) then begin
          if font.spec.angle=0 then
            Canvas.SetHorizontalScaling(hscale) else
            hscale := 100;
        end else
          hscale := 100;
      end;
      tpExactTextCharacterPositining:
        tmpChar[1] := #0;
      end;
    end else
      Positioning := tpSetTextJustification;
    wW := W;                                    // right x
    // H Align Mask = TA_CENTER or TA_RIGHT or TA_LEFT = TA_CENTER
    if (font.Align and TA_CENTER)=TA_CENTER then
      W := W/2                                  // center x
    else if (font.Align and TA_CENTER)=TA_LEFT then
      W := 0;                                   // left x
    // V Align mask = TA_BASELINE or TA_BOTTOM or TA_TOP = TA_BASELINE
    if (font.Align and TA_BASELINE) = TA_BASELINE then
      // always zero ?
      H := Abs(font.LogFont.lfHeight) - Abs(font.spec.cell)  // center y
    else if (font.Align and TA_BASELINE)= TA_BOTTOM then
      H := Abs(font.spec.descent)               // bottom y
    else
     // H := - Abs(font.spec.cell); // top
      // needs - vertical coords of baseline from top
      H := -abs(font.spec.ascent); // top
    if ASignY<0 then                            //inverted coordinates
      H := Abs(font.LogFont.lfHeight)+H;
    if ASignX<0 then
      W := W+wW;
    if (font.align and TA_UPDATECP)=TA_UPDATECP then
      Posi := Position else
      Posi := R.emrtext.ptlReference;
    // detect clipping
    if Canvas.fUseMetaFileTextClipping<>tcNeverClip then begin
      with R.emrtext.rcl do
        WithClip := (Right>Left) and (Bottom>Top);
      if WithClip then
        ClipRect := Canvas.BoxI(R.emrtext.rcl,true) else begin
        if Canvas.fUseMetaFileTextClipping=tcClipExplicit then
          with R.rclBounds do
            WithClip := (Right>Left) and (Bottom>Top);
        if WithClip then
          ClipRect := Canvas.BoxI(R.rclBounds,true) else begin
          WithClip := not ClipRgnNull and
                      (Canvas.fUseMetaFileTextClipping=tcAlwaysClip);
          if WithClip then
            ClipRect := GetClipRect;
        end;
      end;
    end else
      WithClip := False;
    bOpaque := not brush.null and (brush.Color<>clWhite) and
       ((R.emrtext.fOptions and ETO_OPAQUE<>0) or
        ((font.BkMode=OPAQUE) and (font.BkColor=brush.color)));
    if bOpaque then
      if WithClip then
        backRect := R.emrtext.rcl else begin
        backRect.TopLeft := Posi;
        backRect.BottomRight := Posi;
        inc(backRect.Right,Trunc(wW));
        inc(backRect.Bottom,Abs(font.LogFont.lfHeight));
      end;
    NormalizeRect(backRect);
    if WithClip then begin
      Canvas.GSave;
      Canvas.NewPath;
      Canvas.Rectangle(ClipRect.Left,ClipRect.Top,ClipRect.Width,ClipRect.Height);
      Canvas.ClosePath;
      Canvas.Clip;
      if bOpaque then begin
        FillRectangle(backRect,false);
        bOpaque := False; //do not handle more
      end else
        Canvas.NewPath;
      Canvas.fNewPath := False;
    end;
    // draw background (if any)
    if bOpaque then
      // don't handle BkMode, since global to the page, but only specific text
      // don't handle rotation here, since should not be used much
      FillRectangle(backRect,true);
    // draw text
    FillColor := font.color;
{$ifdef USE_UNISCRIBE}
    Canvas.RightToLeftText := (R.emrtext.fOptions and ETO_RTLREADING)<>0;
{$endif}
    Canvas.BeginText;
    if font.spec.angle<>0 then begin
      a := font.spec.angle*cPIdiv180;
      acos := cos(a);
      asin := sin(a);
      PosX := 0;
      PosY := 0;
      Canvas.SetTextMatrix(acos, asin, -asin, acos,
        Canvas.I2X(Posi.X-Round(W*acos+H*asin)),
        Canvas.I2Y(Posi.Y-Round(H*acos-W*asin)));
    end else
    if (WorldTransform.eM11 = WorldTransform.eM22) and
       (WorldTransform.eM12 = -WorldTransform.eM21) and
       not SameValue(ArcCos(WorldTransform.eM11), 0, 0.0001) then
    begin
      PosX := 0;
      PosY := 0;
      if SameValue(ArcCos(WorldTransform.eM11), 0, 0.0001) or       //0deg
         SameValue(ArcCos(WorldTransform.eM11), cPI, 0.0001) then   //180deg
        Canvas.SetTextMatrix(WorldTransform.eM11, WorldTransform.eM12, WorldTransform.eM21, WorldTransform.eM22,
          Canvas.I2X(posi.X * WorldTransform.eM11 + posi.Y * WorldTransform.eM21 + WorldTransform.eDx),
          Canvas.I2y(posi.X * WorldTransform.eM12 + posi.Y * WorldTransform.eM22 + WorldTransform.eDy))
      else
        Canvas.SetTextMatrix(-WorldTransform.eM11, -WorldTransform.eM12, -WorldTransform.eM21, -WorldTransform.eM22,
          Canvas.I2X(posi.X * WorldTransform.eM11 + posi.Y * WorldTransform.eM21 + WorldTransform.eDx),
          Canvas.I2y(posi.X * WorldTransform.eM12 + posi.Y * WorldTransform.eM22 + WorldTransform.eDy));
    end
    else
    begin
      acos := 0;
      asin := 0;
      if Canvas.fViewSize.cx>0 then
        PosX := Posi.X-W else // zero point left
        PosX := Posi.X+W;     //            right
      if Canvas.fViewSize.cy>0 then
        PosY := Posi.Y-H else // zero point beyond
        PosY := Posi.Y+H;     //            above
      Canvas.MoveTextPoint(Canvas.I2X(PosX),Canvas.I2Y(PosY));
    end;
    if (R.emrtext.fOptions and ETO_GLYPH_INDEX)<>0 then
      Canvas.ShowGlyph(pointer(tmp),R.emrtext.nChars) else
      if Positioning=tpExactTextCharacterPositining then begin
        cur := 0;
        repeat
          tmpChar[0] := tmp[cur];
          Canvas.ShowText(@tmpChar,false);
          if cur=R.emrtext.nChars-1 then
            break;
          PosX := PosX+DX^[cur];
          Canvas.EndText;
          Canvas.BeginText;
          Canvas.MoveTextPoint(Canvas.I2X(PosX),Canvas.I2Y(PosY));
          inc(cur);
        until false;
      end else
        Canvas.ShowText(pointer(tmp));
    Canvas.EndText;
    // handle underline or strike out styles (direct draw PDF lines on canvas)
    if font.LogFont.lfUnderline<>0 then
      DrawLine(Posi, aSize / 8 / Canvas.GetWorldFactorX / Canvas.FDevScaleX);
    if font.LogFont.lfStrikeOut<>0 then
      DrawLine(Posi, - aSize / 3 / Canvas.GetWorldFactorX / Canvas.FDevScaleX);
    // end any pending clipped TextRect() region
    if WithClip then begin
      Canvas.GRestore;
      fFillColor := -1; // force set drawing color
    end;
    case Positioning of // reset to be done after Canvas.GRestore
    tpSetTextJustification:
      if nspace>0 then
        Canvas.SetWordSpace(0);
    tpKerningFromAveragePosition:
      if hscale<>100 then
        Canvas.SetHorizontalScaling(100); 
    end;
    if not Canvas.FNewPath then begin
      if WithClip then
        if not DC[nDC].ClipRgnNull then begin
          ClipRect := GetClipRect;
          Canvas.GSave;
          Canvas.Rectangle(ClipRect.Left, ClipRect.Top, ClipRect.Width, ClipRect.Height);
          Canvas.Clip;
          Canvas.GRestore;
          Canvas.NewPath;
          Canvas.fNewPath := False;
        end;
    end else
      Canvas.fNewPath := False;
    if (font.align and TA_UPDATECP)=TA_UPDATECP then begin
      Position.X := Posi.X+Trunc(wW);
      Position.Y := Posi.Y;
    end;
  end;
end;


{ TPdfForm }

constructor TPdfForm.Create(aDoc: TPdfDocumentGDI; aMetaFile: TMetafile);
var P: TPdfPageGDI;
    FResources: TPdfDictionary;
    W,H: integer;
    oldPage: TPdfPage;
begin
  inherited Create(aDoc,true);
  W := aMetaFile.Width;
  H := aMetaFile.Height;
  P := TPdfPageGDI.Create(nil);
  try
    FResources := TPdfDictionary.Create(aDoc.FXref);
    FFontList := TPdfDictionary.Create(nil);
    FResources.AddItem('Font',FFontList);
    FResources.AddItem('ProcSet',TPdfArray.CreateNames(nil,['PDF','Text','ImageC']));
    with aDoc.FCanvas do begin
      oldPage := FPage;
      FPage := P;
      try
        FPageFontList := FFontList;
        FContents := self;
        FPage.SetPageHeight(H);
        FFactor := 1;
        RenderMetaFile(aMetaFile);
      finally
        if oldPage<>nil then
          SetPage(oldPage);
      end;
    end;
    FAttributes.AddItem('Type','XObject');
    FAttributes.AddItem('Subtype','Form');
    FAttributes.AddItem('BBox',TPdfArray.Create(nil,[0,0,W,H]));
    FAttributes.AddItem('Matrix',TPdfRawText.Create('[1 0 0 1 0 0]'));
    FAttributes.AddItem('Resources',FResources);
  finally
    P.Free;
  end;
end;

{$endif USE_METAFILE}

{$ifdef USE_BITMAP}

{ TPdfImage }

constructor TPdfImage.Create(aDoc: TPdfDocument; aImage: TGraphic; DontAddToFXref: boolean);
var B: TBitmap;
    PInc, y: integer;
    Pal: PDFString;
    Pals: array of TPaletteEntry;
    CA: TPdfArray;
    TransparentColor: TPdfColorRGB;
procedure NeedBitmap(PF: TPixelFormat);
begin
  B := TBitmap.Create; // create a temp bitmap (pixelformat may change)
  B.PixelFormat := PF;
  B.Width := fPixelWidth;
  B.Height := fPixelHeight;
  B.Canvas.Draw(0,0,aImage);
end;
procedure WritePal(P: PAnsiChar; Pal: PPaletteEntry);
var i: integer;
begin
  P^ := '<'; inc(P);
  for i := 0 to 255 do
  with Pal^ do begin
    P[0] := HexChars[peRed shr 4];
    P[1] := HexChars[peRed and $F];
    P[2] := HexChars[peGreen shr 4];
    P[3] := HexChars[peGreen and $F];
    P[4] := HexChars[peBlue shr 4];
    P[5] := HexChars[peBlue and $F];
    P[6] := ' ';
    inc(P,7);
    inc(Pal);
  end;
  P^ := '>';
end;
begin
  inherited Create(aDoc,DontAddToFXref);
  fPixelWidth := aImage.Width;
  fPixelHeight := aImage.Height;
  FAttributes.AddItem('Type','XObject');
  FAttributes.AddItem('Subtype','Image');
  if aImage.InheritsFrom(TJpegImage) then begin
    FAttributes.AddItem('ColorSpace','DeviceRGB');
    FFilter := 'DCTDecode';
    FWriter.Save; // flush to allow direct access to fDestStream
    with TJpegImage(aImage) do begin
      if aDoc.ForceJPEGCompression<>0 then
        CompressionQuality := aDoc.ForceJPEGCompression;
      {$ifdef USE_SYNGDIPLUS}
      if aDoc.ForceJPEGCompression=0 then // recompression only if necessary
        SaveInternalToStream(FWriter.fDestStream) else
      {$endif}
        SaveToStream(FWriter.fDestStream); // with CompressionQuality recompress
      end;
    FWriter.fDestStreamPosition := FWriter.fDestStream.Seek(0,soCurrent);
  end else begin
    if aImage.InheritsFrom(TBitmap) then
      B := TBitmap(aImage) else
      NeedBitmap(pf24bit);
    try
      case B.PixelFormat of
        pf1bit, pf4bit, pf8bit: begin
          if B.PixelFormat<>pf8bit then
            NeedBitmap(pf8bit);
          SetLength(Pals,256);
          if GetPaletteEntries(B.Palette,0,256,Pals[0])<>256 then
            raise EPdfInvalidValue.Create('TPdfImage');
          SetLength(Pal,7*256+2);
          WritePal(pointer(Pal),pointer(Pals));
          CA := TPdfArray.Create(nil);
          CA.AddItem(TPdfName.Create('Indexed'));
          CA.AddItem(TPdfName.Create('DeviceRGB'));
          CA.AddItem(TPdfNumber.Create(255));
          CA.AddItem(TPdfRawText.Create(Pal));
          FAttributes.AddItem('ColorSpace',CA);
          for y := 0 to fPixelHeight-1 do
            FWriter.Add(PAnsiChar(B.ScanLine[y]),fPixelWidth);
        end;
        else begin
          FAttributes.AddItem('ColorSpace','DeviceRGB');
          if not (B.PixelFormat in [pf24bit,pf32bit]) then
            NeedBitmap(pf24bit);
          if B.PixelFormat=pf24bit then
            PInc := 3 else
            PInc := 4;
          for y := 0 to fPixelHeight-1 do
            FWriter.AddRGB(B.ScanLine[y],PInc,fPixelWidth);
          if (PInc=3) and (B.TransparentMode=tmFixed) then begin
            // [ min1 max1 ... minn maxn ]
            TransparentColor := B.TransparentColor;
            FAttributes.AddItem('Mask',TPdfArray.CreateReals(nil,
              [(TransparentColor and $ff), (TransparentColor and $ff),
              (TransparentColor shr 8 and $ff), (TransparentColor shr 8 and $ff),
              (TransparentColor shr 16 and $ff), (TransparentColor shr 16 and $ff)]));
          end;
        end;
      end;
    finally
      if B<>aImage then
        B.Free;
    end;
  end;
  FAttributes.AddItem('Width',fPixelWidth);
  FAttributes.AddItem('Height',fPixelHeight);
  FAttributes.AddItem('BitsPerComponent',8);
end;

constructor TPdfImage.CreateJpegDirect(aDoc: TPdfDocument;
  const aJpegFileName: TFileName; DontAddToFXref: boolean);
var MS: THeapMemoryStream;
begin
  MS := THeapMemoryStream.Create;
  try
    MS.LoadFromFile(aJpegFileName);
    CreateJpegDirect(aDoc,MS,DontAddToFXRef);
  finally
    MS.Free;
  end;
end;

function GetJpegSize(jpeg: TMemoryStream; out width, height, BitDepth: integer): boolean;
var n: integer;
    b: byte;
    w: Word;
begin
  result := false;
  n := jpeg.Size-8;
  jpeg.Position := 0;
  if n<=0 then
    exit;
  jpeg.Read(w,2);
  if w<>$D8FF then
    exit; // invalid format
  jpeg.Read(b,1);
  while (jpeg.Position<n) and (b=$FF) do begin
    jpeg.Read(b,1);
    case b of
      $C0..$C3: begin
        jpeg.Seek(3,soCurrent);
        jpeg.Read(w,2);
        height := swap(w);
        jpeg.Read(w,2);
        width := swap(w);
        jpeg.Read(b,1);
        BitDepth := b*8;
        Result := true; // JPEG format OK
        exit;
      end;
      $FF:
        jpeg.Read(b,1);
      $D0..$D9, $01: begin
        jpeg.Seek(1,soCurrent);
        jpeg.Read(b,1);
      end;
      else begin
        jpeg.Read(w,2);
        jpeg.Seek(swap(w)-2, soCurrent);
        jpeg.Read(b,1);
      end;
    end;
  end;
end;

constructor TPdfImage.CreateJpegDirect(aDoc: TPdfDocument;
  aJpegFile: TMemoryStream; DontAddToFXref: boolean);
var Len, BitDepth: integer;
begin
  inherited Create(aDoc,DontAddToFXref);
  Len := aJpegFile.Size;
  if not GetJpegSize(aJpegFile,fPixelWidth,fPixelHeight,BitDepth) then
    exit; // JPEG format expected
  FAttributes.AddItem('Type','XObject');
  FAttributes.AddItem('Subtype','Image');
  FFilter := 'DCTDecode';
  FWriter.Save; // flush to allow direct access to fDestStream
  FWriter.Add(aJpegFile.Memory,Len);
  FWriter.fDestStreamPosition := FWriter.fDestStream.Seek(0,soCurrent);
  FAttributes.AddItem('Width',fPixelWidth);
  FAttributes.AddItem('Height',fPixelHeight);
  case BitDepth of
    8:  FAttributes.AddItem('ColorSpace','DeviceGray');
    24: FAttributes.AddItem('ColorSpace','DeviceRGB');
  end;
  FAttributes.AddItem('BitsPerComponent',8);
end;

{$endif USE_BITMAP}


{ TPdfFormWithCanvas }

constructor TPdfFormWithCanvas.Create(aDoc: TPdfDocument; W, H: Integer);
var FResources: TPdfDictionary;
begin
  inherited Create(aDoc,true);
  FResources := TPdfDictionary.Create(aDoc.FXref);
  FFontList := TPdfDictionary.Create(nil);
  FResources.AddItem('Font',FFontList);
  FResources.AddItem('ProcSet',TPdfArray.CreateNames(nil,['PDF','Text','ImageC']));
  FPage := TPdfPage.Create(nil);
  FCanvas := TPdfCanvas.Create(aDoc);
  FCanvas.FPage := FPage;
  FCanvas.FPageFontList := FFontList;
  FCanvas.FContents := self;
  FCanvas.FFactor := 1;
  FAttributes.AddItem('Type','XObject');
  FAttributes.AddItem('Subtype','Form');
  FAttributes.AddItem('BBox',TPdfArray.Create(nil,[0,0,W,H]));
  FAttributes.AddItem('Matrix',TPdfRawText.Create('[1 0 0 1 0 0]'));
  FAttributes.AddItem('Resources',FResources);
end;

destructor TPdfFormWithCanvas.Destroy;
begin
  CloseCanvas;
  inherited;
end;

procedure TPdfFormWithCanvas.CloseCanvas;
begin
  FreeAndNil(FCanvas);
  FreeAndNil(FPage);
end;


{$ifdef USE_PDFSECURITY}

{ TPdfEncryption }

constructor TPdfEncryption.Create(aLevel: TPdfEncryptionLevel;
  aPermissions: TPdfEncryptionPermissions;
  const aUserPassword, aOwnerPassword: string);
begin
  fLevel := aLevel;
  fPermissions := aPermissions;
  fUserPassword := aUserPassword;
  if aOwnerPassword='' then
    raise EPdfInvalidOperation.CreateFmt(
      '%s expect a non void owner password',[ClassName]);
  fOwnerPassword := aOwnerPassword;
end;

class function TPdfEncryption.New(aLevel: TPdfEncryptionLevel;
  const aUserPassword, aOwnerPassword: string;
  aPermissions: TPdfEncryptionPermissions): TPdfEncryption;
begin
  case aLevel of
  elRC4_40, elRC4_128:
    result := TPdfEncryptionRC4MD5.Create(aLevel,aPermissions,aUserPassword,aOwnerPassword);
  else
    result := nil;
  end;
end;

procedure TPdfEncryption.AttachDocument(aDoc: TPdfDocument);
begin
  fDoc := aDoc;
end;


{ TPdfEncryptionRC4MD5 }

const
  // see "Algorithm 3.2 Computing an encryption key" in the PDF reference doc
  PDF_PADDING: TPdfBuffer32 =
    ($28,$BF,$4E,$5E,$4E,$75,$8A,$41,$64,$00,$4E,$56,$FF,$FA,$01,$08,
     $2E,$2E,$00,$B6,$D0,$68,$3E,$80,$2F,$0C,$A9,$FE,$64,$53,$69,$7A);

procedure TPdfEncryptionRC4MD5.AttachDocument(aDoc: TPdfDocument);
procedure Pad(const source: string; var dest: TPdfBuffer32);
var L: integer;
    tmp: WinAnsiString;
begin
  tmp := StringToWinAnsi(source);
  L := Length(tmp);
  if L>SizeOf(dest) then
    L := SizeOf(dest) else
    MoveFast(PDF_PADDING,dest[L],SizeOf(dest)-L);
  MoveFast(pointer(tmp)^,dest,L);
end;
const HASHSIZE: array[elRC4_40..elRC4_128] of integer = (5,16);
      DICT: array[elRC4_40..elRC4_128] of record V,R,L: integer end =
        ((V:1;R:2;L:40),(V:2;R:3;L:128));
      FLAGPATTERN: array[elRC4_40..elRC4_128] of cardinal = ($FFFFFFC0,$FFFFF0C0);
      FLAGBIT: array[TPdfEncryptionPermission] of byte = (2,3,4,5,8,9,10,11);
var RC4: TRC4;
    MD5: TMD5;
    f: TPdfEncryptionPermission;
    Digest, Digest2: TMD5Digest;
    i,j: integer;
    own, usr: TPdfBuffer32;
begin
  inherited;
  // compute corresponding flags
  fFlags := FLAGPATTERN[fLevel];
  for f := low(f) to high(f) do
    if f in fPermissions then
      fFlags := fFlags or (1 shl FLAGBIT[f]);
  if fDoc.fFileFormat<pdf14 then
    fDoc.fFileFormat := pdf14;
  // calc fOwnerPass key (Algorithm 3.3 in PDF reference doc)
  Pad(fUserPassword,usr);
  Pad(fOwnerPassword,own);
  MD5.Full(@own,SizeOf(own),Digest);
  if fLevel=elRC4_128 then
    for i := 1 to 50 do
      MD5.Full(@Digest,sizeof(Digest),Digest);
  RC4.Init(Digest,HASHSIZE[fLevel]);
  RC4.Encrypt(usr,fOwnerPass,sizeof(fOwnerPass));
  if fLevel=elRC4_128 then
    for i := 1 to 19 do begin
      for j := 0 to high(Digest2) do
        Digest2[j] := Digest[j] xor i;
      RC4.Init(Digest2,sizeof(Digest2));
      RC4.Encrypt(fOwnerPass,fOwnerPass,sizeof(fOwnerPass));
    end;
  // calc main file key (Algorithm 3.2 in PDF reference doc)
  MD5.Init;
  MD5.Update(usr,SizeOf(usr));
  MD5.Update(fOwnerPass,sizeof(fOwnerPass));
  MD5.Update(fFlags,sizeof(fFlags));
  MD5.Update(aDoc.fFileID,sizeof(aDoc.fFileID));
  MD5.Final(Digest);
  if fLevel=elRC4_128 then
    for i := 1 to 50 do
      MD5.Full(@Digest,sizeof(Digest),Digest);
  SetLength(fInternalKey,HASHSIZE[fLevel]);
  MoveFast(Digest,fInternalKey[0],HASHSIZE[fLevel]);
  // calc fUserPass content
  case fLevel of
  elRC4_40: begin   // Algorithm 3.4 in PDF reference doc
    RC4.Init(fInternalKey[0],HASHSIZE[fLevel]);
    RC4.Encrypt(PDF_PADDING,fUserPass,sizeof(PDF_PADDING));
  end;
  elRC4_128: begin  // Algorithm 3.5 in PDF reference doc
    MD5.Init;
    MD5.Update(PDF_PADDING,sizeof(PDF_PADDING));
    MD5.Update(aDoc.fFileID,sizeof(aDoc.fFileID));
    MD5.Final(Digest);
    for i := 0 to 19 do begin
      for j := 0 to high(Digest2) do
        Digest2[j] := fInternalKey[j] xor i;
      RC4.Init(Digest2,SizeOf(Digest2));
      RC4.Encrypt(Digest,Digest,SizeOf(Digest));
    end;
    MoveFast(Digest,fUserPass,SizeOf(Digest));
    MoveFast(Digest,fUserPass[SizeOf(Digest)],SizeOf(Digest));
  end;
  end;
  // add encryption dictionary object
  if aDoc.fEncryptionObject=nil then
    aDoc.fEncryptionObject := TPdfDictionary.Create(aDoc.FXref);
  with aDoc.fEncryptionObject, DICT[fLevel] do begin
    AddItem('Filter','Standard');
    AddItem('V',V);
    AddItem('R',R);
    AddItem('Length',L);
    AddItem('P',fFlags); // expected to be written as signed integer
    AddItem('O',TPdfClearText.Create(@fOwnerPass,sizeof(fOwnerPass)));
    AddItem('U',TPdfClearText.Create(@fUserPass,sizeof(fUserPass)));
  end;
  aDoc.FTrailer.Attributes.AddItem('Encrypt',aDoc.fEncryptionObject);
end;

procedure TPdfEncryptionRC4MD5.EncodeBuffer(const BufIn; var BufOut; Count: cardinal);
// see http://www.cs.cmu.edu/~dst/Adobe/Gallery/anon21jul01-pdf-encryption.txt
// see "Algorithm 3.1 Encryption of data" in PDF Reference document
  procedure ComputeNewRC4Key;
  const KEYSIZE:  array[elRC4_40..elRC4_128] of integer = (10,16);
  var MD5: TMD5;
      Digest: TMD5Digest;
  begin
    MD5.Init;
    MD5.Update(fInternalKey[0],length(fInternalKey));
    MD5.Update(fDoc.fCurrentObjectNumber,3);
    MD5.Update(fDoc.fCurrentGenerationNumber,2);
    MD5.Final(Digest);
    fLastRC4Key.Init(Digest,KEYSIZE[fLevel]);
    fLastObjectNumber := fDoc.fCurrentObjectNumber;
    fLastGenerationNumber := fDoc.fCurrentGenerationNumber;
  end;
var work: TRC4; // Encrypt() changes the RC4 state -> local copy for reuse
begin
  if (fDoc.fCurrentObjectNumber<>fLastObjectNumber) or
     (fDoc.fCurrentGenerationNumber<>fLastGenerationNumber) then
    // a lot of string encodings have the same context
    ComputeNewRC4Key;
  work := fLastRC4Key;
  work.Encrypt(BufIn,BufOut,Count); // RC4 allows in-place encryption :)
end;

{$endif USE_PDFSECURITY}


{ TPdfObjectStream }

function TPdfObjectStream.AddObject(Value: TPdfObject): integer;
begin
  result := fObjectCount;
  inc(fObjectCount);
  if fObjectCount>length(fObject) then
    SetLength(fObject,fObjectCount+15);
  fObject[result].Number := Value.ObjectNumber;
  fObject[result].Position := fAddingStream.Position;
  Value.InternalWriteTo(fAddingStream);
end;

constructor TPdfObjectStream.Create(aDoc: TPdfDocument);
begin
  inherited Create(aDoc,false);
  Attributes.AddItem('Type','ObjStm');
  fAddingStream := TPdfWrite.Create(ADoc,THeapMemoryStream.Create);
end;

destructor TPdfObjectStream.Destroy;
begin
  fAddingStream.fDestStream.Free;
  fAddingStream.Free;
  inherited;
end;

procedure TPdfObjectStream.InternalWriteTo(W: TPdfWrite);
var i: integer;
begin
  Attributes.AddItem('N',fObjectCount);
  for i := 0 to fObjectCount-1 do
    with fObject[i] do
      Writer.Add(Number).Add(' ').Add(Position).Add(' ');
  Attributes.AddItem('First',Writer.Position);
  Writer.Add(fAddingStream.ToPDFString);
  inherited;
end;


initialization
  {$ifdef USE_SYNGDIPLUS}
  // initialize Gdi+ if necessary (and possible, i.e. not from a dll)
  if (Gdip=nil) and not IsLibrary then
    Gdip := TGDIPlus.Create('gdiplus.dll');
  {$endif}

finalization
  if (FontSub<>0) and (FontSub<>INVALID_HANDLE_VALUE) then
    FreeLibrary(FontSub);
end.