{*************************************************************************}
{ TMS PDF Engine                                                          }
{ for Delphi & C++Builder                                                 }
{                                                                         }
{ written by TMS Software                                                 }
{           copyright © 2015                                              }
{           Email : info@tmssoftware.com                                  }
{           Web : http://www.tmssoftware.com                              }
{                                                                         }
{ The source code is given as is. The author is not responsible           }
{ for any possible damage done due to the use of this code.               }
{ The component can be freely used in any application. The complete       }
{ source code remains property of the author and may not be distributed,  }
{ published, given or sold in any form as such. No parts of the source    }
{ code can be included in any other component or application without      }
{ written authorization of the author.                                    }
{*************************************************************************}
unit IwAdvPDFLIB;

{$I TMSDEFS.INC}

interface

uses
  ZLib, Windows, Classes, SysUtils, Dialogs, Graphics, StrUtils, Math,
  JPEG, PngImage, Generics.Collections, ImgList, IwAdvPDFFuncs, IWApplication
  {$IFDEF DELPHIXE3_LVL}
  , System.UITypes
  {$ENDIF}
  ;

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;

const
//  sLineBreak =  #10;
  FONTSIZE = 11;
  TTFCFP_MAC_PLATFORMID = 1;
  TTFCFP_MS_PLATFORMID = 3;
  TTFCFP_SYMBOL_CHAR_SET = 0;
  TTFCFP_UNICODE_CHAR_SET = 1;
  TTFCFP_FLAGS_SUBSET = 1;
  TTFMFP_SUBSET = 0;

type
{$IFNDEF DELPHIXE2_LVL}
  z_stream = TZStreamRec;
{$ENDIF}

  TTextType = (ttText,ttHTML,ttRTF,ttFormula,ttURL,ttUnicode);

  RawUTF8 = type AnsiString(CP_UTF8);
  TRawUTF8DynArray = array of RawUTF8;

  TPdfFont = class;

  TPDFDocument = class;
  TPDFPageItem = class;
  TPDFTableItem = class;
  TPDFTableRowItem = class;

  TPDFALIGNMENT = (alLeft, alRight, alCenter);

  TPDFPageLayout = (plLandscape, plPortrait);

  TPDFBulletStyle = (bsNone, bsStar, bsArrow, bsSquare, bsCheck, bsCircle);

  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;

  // The '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;

  // The '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;

  TPdfDictionaryWrapper = class(TPersistent)
  private
    FData: TObject;
    function GetHasData: Boolean;
  protected
    procedure SetData(AData: TObject);
  public
    // The associated dictionary, containing all data
    property Data: TObject read FData write SetData;
    // return TRUE if has any data stored within
    property HasData: Boolean read GetHasData;
  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: TPdfFont); reintroduce;
  end;

  TPdfObjectMgr = class(TObject)
  public
    procedure AddObject(AObject: TObject); virtual; abstract;
    function GetObject(ObjectID: Integer): TObject; virtual; abstract;
  end;

  TPdfXrefEntry = class(TObject)
  private
    FEntryType: PDFString;
    FByteOffset: Integer;
    FGenerationNumber: Integer;
    FObjectStreamIndex: Integer;
    FValue: TObject;
  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: TObject);
    // Release the memory, and the associated value, if any
    destructor Destroy; override;
    // 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: TObject read FValue;
  end;

  TPdfXref = class(TPdfObjectMgr)
  private
    FXrefEntries: TList;
    function GetItem(ObjectID: Integer): TPdfXrefEntry; {$ifdef HASINLINE}inline;{$endif}
    function GetItemCount: Integer; {$ifdef HASINLINE}inline;{$endif}
  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
    function GetObject(ObjectID: Integer): TObject; 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;

  TPdfFont = class(TPdfDictionaryWrapper)
  protected
    FM: TTextMetric;
    FOTM: POutlineTextmetric;
    FFontStyle:TFontStyles;
    FAlias: string;
    FWinAnsiWidth: PPdfWinAnsiWidth;
    FUsedWide: TUsedWide;
    FDocucment:TPDFDocument;
    FHGDI: HGDIOBJ;
    FUsedWideChar: TSortedWordArray;
    FSubType: string;
    Encoding: string;
    FFixedWidth: Boolean;
    FName: string;
    FShortCut: PDFString;
    FFirstChar, FLastChar: Integer;
    FDefaultWidth: word;
    FAscent, fDescent: Integer;
    FUnicode: Boolean;
    FEmbedFont: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;
    FWinUnicodeUsed: array of WideChar;
    procedure Init();
  public
    // Create the PDF font object instance
    property  FontStyle:TFontStyles read FFontStyle write FFontStyle;
    property EmbedFont:boolean read FEmbedFont write FEmbedFont;
    function FindOrAddUsedWideChar(aWideChar: WideChar): Integer;
    constructor Create(Parent:TPDFDocument;const AName: string);
    destructor Destroy; override;

    function GetTTFXData(Doc: TPDFDocument): ansistring;
    // Mark some WinAnsi char as used
    procedure AddUsedUnicodeChar(aChar: Widechar);
    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 Alias: string read FAlias write FAlias;
    property Name: string 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 write FUnicode;
  end;


  // 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;

  TPdfCellImageType = (citBitmap, citPicture, citFilePicture, citImageList, citImages);

  TPdfVerticalAlignment = (vtaTop, vtaCenter, vtaBottom);

  TPdfCellHAlign = (haLeft, haRight, haCenter, haBeforeText, haAfterText, haFull);

  TPdfCellVAlign = (vaTop, vaBottom, vaCenter, vaUnderText, vaAboveText, vaFull);


  THTMLRef = record
    BGColor: TColor;
    Color: TColor;
    HasImage: Boolean;
    IsUrl: Boolean;
    ImgIdx: Integer;
    FontName: string;
    FontStyle: TFontStyles;
    Size: Integer;
    Text: string;
    Url: string;
    X: Integer;
    Y: Integer;
  end;

  // Table supporting objects

  // Table cell

  TPDFTableRowCellItem = class(TCollectionItem)
  private
    FFont: TFont;
    FText: string;
    FAlignment: TPDFALIGNMENT;
    FBordercolor: TColor;
    FBackgroundColor: TColor;
    FIsMerged: Boolean;
    FBaseCell: TPoint;
    FHAlign: TAlignment;
    FVAlign: TPdfVerticalAlignment;
    FCellSpan: TPoint;
    FImageType: TPdfCellImageType;
    FBitmaps: TObjectList<TBitmap>;
    FImageHAlign: TPdfCellHAlign;
    FImageVAlign: TPdfCellVAlign;
    FBackgroundColorFrom: TColor;
    FBackgroundColorTo: TColor;
    FBackgroundMirrorColorTo: TColor;
    FBackgroundMirrorColorFrom: TColor;
    FBackgroundOrientation: Boolean;
    FGradientRef: string;
    FPage: Integer;
    FUrl: string;
    FUrlColor: TColor;
    FHTMLText: string;
    FHTML: TList<THTMLRef>;
    FIsCheckbox: Boolean;
    FChecked: Boolean;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property Alignment: TPDFALIGNMENT read FAlignment write FAlignment;
    property BackgroundColor: TColor read FBackgroundColor write FBackgroundColor;
    property BackgroundColorFrom: TColor read FBackgroundColorFrom write FBackgroundColorFrom;
    property BackgroundColorTo: TColor read FBackgroundColorTo write FBackgroundColorTo;
    property BackgroundMirrorColorFrom: TColor read FBackgroundMirrorColorFrom write FBackgroundMirrorColorFrom;
    property BackgroundMirrorColorTo: TColor read FBackgroundMirrorColorTo write FBackgroundMirrorColorTo;
    property BackgroundOrientation: Boolean read FBackgroundOrientation write FBackgroundOrientation;
    property BaseCell: TPoint read FBaseCell write FBaseCell;
    property Bitmaps: TObjectList<TBitmap> read FBitmaps write FBitmaps;
    property BorderColor: TColor read FBordercolor write FBordercolor;
    property CellSpan: TPoint read FCellSpan write FCellSpan;
    property Checked: Boolean read FChecked write FChecked;
    property GradientRef: string read FGradientRef write FGradientRef;
    property HAlign: TAlignment read FHAlign write FHAlign;
    property HTMLText: string read FHTMLText write FHTMLText;
    property HTML: TList<THTMLRef> read FHTML write FHTML;
    property IsCheckbox: Boolean read FIsCheckbox write FIsCheckbox;
    property IsMerged: Boolean read FIsMerged write FIsMerged;
    property ImageType: TPdfCellImageType read FImageType write FImageType;
    property ImageHAlign: TPdfCellHAlign read FImageHAlign write FImageHAlign;
    property ImageVAlign: TPdfCellVAlign read FImageVAlign write FImageVAlign;
    property Page: Integer read FPage write FPage;
    property Text: string read FText write FText;
    property TextFont: TFont read FFont write FFont;
    property Url: string read FUrl write FUrl;
    property UrlColor: TColor read FUrlColor write FUrlColor;
    property VAlign: TPdfVerticalAlignment read FVAlign write FVAlign;
  end;

  // Table row of cells

  TPDFTableRowCellItems = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TPDFTableRowCellItem;
    procedure SetItem(Index: Integer; const Value: TPDFTableRowCellItem);
  public
    constructor Create(AOwner: TPDFTableRowItem);
    destructor Destroy; override;

    function Add: TPDFTableRowCellItem;
    function Insert(Index: Integer): TPDFTableRowCellItem;
    property Items[Index: Integer]: TPDFTableRowCellItem read GetItem write SetItem; default;
  end;

  // Table row

  TPDFTableRowItem = class(TCollectionItem)
  private
    FCells: TPDFTableRowCellItems;
    FHeight: Integer;
    procedure SetCells(const Value: TPDFTableRowCellItems);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property Cells: TPDFTableRowCellItems read FCells write SetCells;
    property Height: Integer read FHeight write FHeight;
  end;

  // Table rows collection

  TPDFTableRowItems = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TPDFTableRowItem;
    procedure SetItem(Index: Integer; const Value: TPDFTableRowItem);
  public
    constructor Create(AOwner: TPDFTableItem);
    destructor Destroy; override;

    function Add: TPDFTableRowItem;
    function Insert(Index: Integer): TPDFTableRowItem;
    property Items[Index: Integer]: TPDFTableRowItem read GetItem write SetItem; default;
  end;

  // Table column

  TPDFTableColumnItem = class(TCollectionItem)
  private
    FCaption: string;
    FWidth: Integer;
    FTextFont: TFont;
    procedure SetTextFont(const Value: TFont);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property Width: Integer read FWidth write FWidth;
    property Caption: string read FCaption write FCaption;
    property TextFont: TFont read FTextFont write SetTextFont;
  end;

  // Table columns collection

  TPDFTableColumnItems = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TPDFTableColumnItem;
    procedure SetItem(Index: Integer; const Value: TPDFTableColumnItem);
  public
    constructor Create(AOwner: TPDFTableItem);
    destructor Destroy; override;
    function Add: TPDFTableColumnItem;
    function Insert(Index: Integer): TPDFTableColumnItem;
    property Items[Index: Integer]: TPDFTableColumnItem read GetItem write SetItem; default;
  end;

  TTableType = (ttFit, ttWysiwyg);

  TPDFTableItem = class(TCollectionItem)
  private
    FColumns: TPDFTableColumnItems;
    FRows: TPDFTableRowItems;
    FX: Integer;
    FY: Integer;
    FWidth: Integer;
    FColor: TColor;
    FTableType: TTableType;
    procedure SetColumns(const Value: TPDFTableColumnItems);
    procedure SetRows(const Value: TPDFTableRowItems);
  protected
    function PDFPage: TPDFPageItem;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure DrawTable;
    procedure DrawFixedTable;
    property Color: TColor read FColor write FColor;
    property Columns: TPDFTableColumnItems read FColumns write SetColumns;
    property Rows: TPDFTableRowItems read FRows write SetRows;
    property TableType: TTableType read FTableType write FTableType;
    property Width: Integer read FWidth write Fwidth;
    property X: Integer read FX write FX;
    property Y: Integer read FY write FY;
  end;

  TPDFTableItems = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TPDFTableItem;
    procedure SetItem(Index: Integer; const Value: TPDFTableItem);
  public
    constructor Create(AOwner: TPDFPageItem);
    destructor Destroy; override;

    function Add: TPDFTableItem;
    function Insert(Index: Integer): TPDFTableItem;
    property Items[Index: Integer]: TPDFTableItem read GetItem write SetItem; default;
  end;

  TPdfMarges = record
    Left: Integer;
    Right: Integer;
    Top: Integer;
    Bottom: Integer;
  end;

  TImageRef = record
    ImageFileName: string;
    Image: TMemoryStream;
  end;

  TGradientPatern = record
    X1: Integer;
    X2: Integer;
    Y1: Integer;
    Y2: Integer;
    ColorFrom: TColor;
    ColorTo: TColor;
    ColorMirrorFrom: TColor;
    ColorMirrorTo: TColor;
    Orientation: Boolean;
  end;

  // PDF page within PDF document

  TPDFPageItem = class(TCollectionItem)
  private
    FFontSize: Integer;
    FContent: string;
    FTableItems: TPDFTableItems;
    FTextRise: Integer;
    FIndent: Integer;
    FBulletStyle: TPDFBulletStyle;
    FMarges: TPdfMarges;
    FBgColor: TColor;
    FIsUrl: Boolean;
    FImagesList: TList<TImageRef>;
    FShadingCount: Integer;
    FUrl: string;
    FVLineSpacing: Integer;
    FShadingList: TList<TGradientPatern>;
    procedure SetTableItems(const Value: TPDFTableItems);
    function AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar; SourceChars: Cardinal): PWideChar;
    function SetUnicodeText(IsUnicodeText: Boolean; AText: string): Boolean;
    function SetTextStyles(AFont: TFont): string;
    function SetTextLineStyles(R,G,B: string; APosX, tw: Integer; AFont: TFont): string;
    function SetTextFont(font: TpdfFont; AFont: TFont; IsUnicodeText: Boolean): string;
    function SetPosXByAlignment(APosX, X, tw, occ: Integer; Alignment: TPDFALIGNMENT): Integer;
    function SetPosXByIndent(APosX: Integer; Alignment: TPDFALIGNMENT): Integer;
    procedure SetBulletsInText(AFont: TFont);
    function SetDefaultFontName(AName: string): string;
    procedure SetTextBackgroundColor(AText: string; AFont: TFont; tw,occ,AposX: Integer);
    procedure SetMarges(const Value: TPdfMarges);
    procedure SetTextUrl(APosX, tw: Integer; AFont: TFont);
    function TagReplaceString(const Srch, Repl: string; var Dest: string): Boolean;
    function IPos(su, s: string): Integer;
    function VarPos(su, s: string; var Res: Integer): Integer;
    function Hex2Color(s: string): TColor;
    function HexVal(s: string): Integer;
    function Text2Color(s: string): tcolor;
    function IStrToInt(s: string): Integer;
    function SetCheckboxInText(X,Y: Integer; AFont: TFont; Checked: Boolean): string;
  protected
    FAnsiToWide: TWordDynArray;
    FWideToAnsi: TByteDynArray;
    function PDFDocument: TPDFDocument;

    property ShadingList: TList<TGradientPatern> read FShadingList ;
    property ShadingCount: Integer read FShadingCount write FShadingCount;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    function FindOrAddUsedWideChar(aWideChar: WideChar): Integer;

    class function GetConvertedText(AText: string;IsUnicodeText: Boolean;Font:TPdfFont): string;
    function AddTextLine(APosX, APosY: Integer; AText: string; AFont: TFont; Alignment: TPDFALIGNMENT = alLeft; AutomaticLineBreak: Boolean = True;IsUnicodeText: Boolean=false; AddNewPage: Boolean = True): string;
    function ConvertHTMLLine(var s: string; Calc: Boolean; Cell: TPDFTableRowCellItem): string;
    function FitText(AText: string; AFont: TFont; AWidth,AHeight: Integer): string;
    function GetWidthText(const AText: String; AFont: TFont): Integer;
    function HtmlToColor(s:string;aDefault:Tcolor):TColor;
    function HtmlToPdf(s: string; Cell: TPDFTableRowCellItem): string;

    procedure AddNewLine;
    procedure AddBmp(APosX, APosY: Integer; AWidth, AHeight: Integer; AFileName: string; Alignment: TPDFALIGNMENT = alLeft);
    procedure AddJpeg(APosX, APosY: Integer; AWidth, AHeight: Integer; AJPEGFileName: string; Alignment: TPDFALIGNMENT = alLeft); overload;
    procedure AddJpeg(APosX, APosY, AWidth, AHeight: Integer; AJPEGImage: TMemoryStream; ImgRef: string = ''; Alignment: TPDFALIGNMENT = alLeft; AddRef: Boolean = false); overload;
    procedure AddPng(APosX, APosY: Integer; AWidth, AHeight: Integer; AFileName: string; Alignment: TPDFALIGNMENT = alLeft);
    procedure DrawRectangle(APosX,APosY,APosYEnd,AWidth: Integer; ABorderColor,ABackgroundColor: TColor; APageIndex: Integer; NoBorder: Boolean = False);

    property BulletStyle: TPDFBulletStyle read FBulletStyle write FBulletStyle;
    property BackgroundColor: TColor read FBgColor write FBgColor;
    property Content: string read FContent write FContent;
    property FontSize: Integer read FFontSize write FFontSize;
    property ImagesList: TList<TImageRef> read FImagesList;
    property Indenting: Integer read FIndent write FIndent;
    property IsUrl: Boolean read FIsUrl write FIsUrl;
    property Marges: TPdfMarges read FMarges write SetMarges;
    property Tables: TPDFTableItems read FTableItems write SetTableItems;
    property TextRise: Integer read FTextRise write FTextRise;
    property Url: string read FUrl write FUrl;
    property VerticalLineSpacing: Integer read FVLineSpacing write FVLineSpacing;
  end;

  // PDF pages collection

  TPDFPageItems = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TPDFPageItem;
    procedure SetItem(Index: Integer; const Value: TPDFPageItem);
  public
    constructor Create(AOwner: TPDFDocument);
    function Add: TPDFPageItem;
    function Insert(Index: Integer): TPDFPageItem;
    property Items[Index: Integer]: TPDFPageItem read GetItem write SetItem; default;
  end;

  // PDF Metadata

  TPDFMetaData = class(TPersistent)
  private
    FCompany: string;
    FCreateDate: string;
    FCreator: string;
    FCreatorTool: string;
    FProducer: string;
    FTitle: string;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Company: string read FCompany write FCompany;
    property CreateDate: string read FCreateDate write FCreateDate;
    property Creator: string read FCreator write FCreator;
    property CreatorTool: string read FCreatorTool write FCreatorTool;
    property Producer: string read FProducer write FProducer;
    property Title: string read FTitle write FTitle;
  end;

  // PDF header of footer

  TPDFHeader = class(TPersistent)
  private
    FPageNumberFont: TFont;
    FPageNumberHAlign: TAlignment;
    FPageNumberVAlign: TVerticalAlignment;
    FText: string;
    FTextFont: TFont;
    FTextHAlign: TAlignment;
    FTextVAlign: TVerticalAlignment;
    FPageNumberVisible: Boolean;
    procedure SetPageNumberFont(const Value: TFont);
    procedure SetTextFont(const Value: TFont);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property PageNumberFont: TFont read FPageNumberFont write SetPageNumberFont;
    property PageNumberHAlign: TAlignment read FPageNumberHAlign write FPageNumberHAlign;
    property PageNumberVAlign: TVerticalAlignment read FPageNumberVAlign write FPageNumberVAlign;
    property PageNumberVisible: Boolean read FPageNumberVisible write FPageNumberVisible;
    property Text: string read FText write FText;
    property TextFont: TFont read FTextFont write SetTextFont;
    property TextHAlign: TAlignment read FTextHAlign write FTextHAlign;
    property TextVAlign: TVerticalAlignment read FTextVAlign write FTextVAlign;
  end;

  // PDF document

  TPDFDocument = class(TPersistent)
  private
    FFontFallBackIndex: integer;
    FTrueTypeFonts: TRawUTF8DynArray;
    FDC, FSelectedDCFontOld: HDC;
    FEnd: string;
    FHeight: Integer;
    FLineXPosition: Integer;
    FLineYPosition: Integer;
    FObjectCount: Integer;
    FOutput: string;
    FPages: TPDFPageItems;
    FStart: string;
    FTextWidth: Integer;
    FImageQuality: TJPEGQualityRange;
    FWidth: Integer;
    FDefaultFont: TFont;
    FFitOption: TPdfFitOptions;
    FFontsList: TList<TPDFFont>;
    FAnnots: TList<string>;
    FImagesList: TCustomImageList;
    FHeader: TPDFHeader;
    FFooter: TPDFHeader;
    FMetaData: TPDFMetaData;
    FRootPath: string;
    function GetFontIndexByName(Name: string;Style:TFontStyles): Integer;
    function GetFontByName(FontName: string;Style:TFontStyles):TPdfFont;
    function AddFont(FontName: string;Style:TFontStyles;Unicode: Boolean): TPdfFont;
    procedure AddFontAndUsedChar(FontName: string;Style:TFontStyles;AText:WideString);

    procedure DoSetFooter;
    procedure DoSetHeader;
    procedure SetPages(const Value: TPDFPageItems);
    procedure SetDefaultFont(const Value: TFont);
    procedure SetFitOption(const Value: TPdfFitOptions);
    function GenerateXrefTable: string;
    function GetXrefStart(outansi: string): string;
    procedure SetFooter(const Value: TPDFHeader);
    procedure SetHeader(const Value: TPDFHeader);
    procedure SetMetaData(const Value: TPDFMetaData);
    procedure SetImagesList(const Value: TCustomImageList);
  protected
    function FindFontIndex(Name:string):integer;
    function GetDCWithFont(TTF: TPdfFont): HDC;
    function GenerateJpeg(idx: Integer; objectindex: Integer; APage: Integer): string;

    property Annotations: TList<string> read FAnnots write FAnnots;
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy; override;

    procedure GeneratePDF(AFileName: string);

    function CurrentPage: TPDFPageItem;
    function SetTextWidth(AWidth: Integer): Integer;
    property TextWidth: Integer read FTextWidth write FTextWidth;
    function TextWrap(AText: string; APosX,AWidth: Integer; AReplaceString: string; var occ: Integer;IsUnicodeText: Boolean=false;AFont: TFont=nil): string;
    function TextOccurences(const ASearch, AText: string): Integer;
    function TextType(s:string; AllowHTML: Boolean =  true): TTextType;

    property ImagesList: TCustomImageList read FImagesList write SetImagesList;
    property Output: string read FOutput write FOutput;
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
    property ImageQuality: TJPEGQualityRange read FImageQuality write FImageQuality default 100;
    property FitOption: TPdfFitOptions read FFitOption write SetFitOption;
    property Footer: TPDFHeader read FFooter write SetFooter;
    property Height: Integer read FHeight write FHeight;
    property Header: TPDFHeader read FHeader write SetHeader;
    property LineXPosition: Integer read FLineXPosition write FLineXPosition;
    property LineYPosition: Integer read FLineYPosition write FLineYPosition;
    property MetaData: TPDFMetaData read FMetaData write SetMetaData;
    property ObjectCount: Integer read FObjectCount write FObjectCount;
    property Pages: TPDFPageItems read FPages write SetPages;
    property RootPath: string read FRootPath write FRootPath;
    property Width: Integer read FWidth write FWidth;
  end;



implementation

{ TPDFDocument }
const
  MAX_WBITS   = 15; // 32K LZ77 window
  DEF_MEM_LEVEL = 8;

function AddRawUTF8(var Values: TRawUTF8DynArray; const Value: RawUTF8;
  NoDuplicates: boolean=false; CaseSensitive: boolean=true): boolean;
var
  i: integer;
begin
  i := length(Values);
  SetLength(Values,i+1);
  Values[i] := Value;
  result := true;
end;


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 = TRUETYPE_FONTTYPE) and (lfFaceName[0]<>'@') then
    begin
      Temp := UTF8Encode(lfFaceName);
      if (pointer(List)=nil) or (List[high(List)]<>Temp) then
        AddRawUTF8(List,Temp,true,true);
    end;
  Result := 1;
end;

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;

function Check(const Code: Integer; const ValidCodes: array of Integer): integer;
var
  i: Integer;
begin
  if Code = Z_MEM_ERROR then
    OutOfMemoryError;

  result := code;
  for i := Low(ValidCodes) to High(ValidCodes) do
    if ValidCodes[i] = Code then
      Exit;

  raise Exception.CreateFmt('Error %d during zip/deflate process',[Code]);
end;

function CompressMem(src, dst: pointer; srcLen, dstLen: integer;
  CompressionLevel: integer = 6; ZipFormat: Boolean=false) : integer;
var
  strm: z_stream;
  Bits:integer;
begin
  FillChar(strm,sizeof(z_stream),0);
  strm.next_in := src;
  strm.avail_in := srcLen;
  strm.next_out := dst;
  strm.avail_out := dstLen; // -MAX_WBITS -> no zLib header => .zip compatible !

  if ZipFormat then
    Bits := MAX_WBITS
  else
    Bits := -MAX_WBITS;

  if deflateInit2_(strm, CompressionLevel, Z_DEFLATED, Bits, DEF_MEM_LEVEL,
    Z_DEFAULT_STRATEGY, ZLIB_VERSION, sizeof(z_stream))>=0 then
  try
    Check(deflate(strm,Z_FINISH),[Z_STREAM_END,Z_OK]);
  finally
    deflateEnd(strm);
  end;

  Result := strm.total_out;
end;

function CompressString(Value:AnsiString):AnsiString;
begin
  SetLength(Result,Length(Value));
  SetLength(Result,CompressMem(@Value[1],@Result[1],Length(Value),Length(Value),6,true));
end;

function ZCompressString(aText: ansistring; aCompressionLevel: TZCompressionLevel): ansistring;
var
  strInput, strOutput: TStringStream;
  Zipper: TZCompressionStream;
  I: Integer;
begin
  Result:= '';
  strInput := TStringStream.Create(string(aText),TEncoding.ASCII);
  strOutput := TStringStream.Create;
  try
    Zipper := TZCompressionStream.Create(strOutput);
    try
      Zipper.CopyFrom(strInput, strInput.Size);
    finally
      Zipper.Free;
    end;
    SetLength(Result,strOutput.Size);
    for I := 0 to strOutput.Size-1 do begin
      Result[I+1]:=AnsiChar(strOutput.Bytes[I]);
    end;
  finally
    strInput.Free;
    strOutput.Free;
  end;
end;

function TPDFDocument.GetFontIndexByName(Name: string;Style:TFontStyles): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to FFontsList.Count - 1 do
     if (LowerCase(FFontsList[I].Name) = LowerCase(Name)) and (FFontsList[I].FontStyle=Style) then
       Exit(I);
end;

function TPDFDocument.GetFontByName(FontName: string;Style:TFontStyles):TPdfFont;
var
  I: Integer;
begin
  I := GetFontIndexByName(FontName,Style);

  Result := nil;
  if I <> -1 then
     Exit(FFontsList[I]);
end;

function TPDFDocument.AddFont(FontName: string; Style:TFontStyles;Unicode: Boolean): TPdfFont;
var
  f: TPdfFont;
begin
  if GetFontIndexByName(FontName,Style) = -1 then
  begin
    f := TPdfFont.Create(Self,FontName);
    Result := f;
    Result.FDocucment := Self;
    FFontsList.Add(Result);
    Result.Alias := IntToStr(FFontsList.Count-1);
    Result.Unicode := Unicode;
    Result.FontStyle:=Style;
    Exit(Result);
  end;
  Exit(GetFontByName(FontName,Style));
end;

procedure TPDFDocument.AddFontAndUsedChar(FontName: string;Style:TFontStyles;AText:WideString);
var
  font:TPdfFont;
  I: Integer;
begin
  font := AddFont(FontName,Style,true);
  for I := 1 to Length(AText) do
    font.AddUsedUnicodeChar(AText[I]);
end;

function CodePageToCharSet(CodePage: Cardinal): Integer;
begin
  case CodePage of
  932:  result := SHIFTJIS_CHARSET;
  949:  result := HANGEUL_CHARSET;
  936:  result := GB2312_CHARSET;
  1255: result := HEBREW_CHARSET;
  1256: result := ARABIC_CHARSET;
  1253: result := GREEK_CHARSET;
  1254: result := TURKISH_CHARSET;
  1258: result := VIETNAMESE_CHARSET;
  874:  result := THAI_CHARSET;
  1250: result := EASTEUROPE_CHARSET;
  1251: result := RUSSIAN_CHARSET;
  1257: result := BALTIC_CHARSET;
  else
    result := ANSI_CHARSET; // default is iso-8859-1 = windows-1252
  end;
end;

procedure TPdfFont.Init;
var
  size:integer;
  AFont: TLogFontW;
  I: integer;
begin
  FillChar(AFont,Sizeof(TLogFontW),#0);

  with AFont do
  begin
    lfHeight := -1000;
    if fsBold in FontStyle then
      lfWeight := FW_BOLD
    else
      lfWeight := FW_NORMAL;

    lfItalic := Byte(fsItalic in FontStyle);
    lfUnderline := Byte(fsUnderline in FontStyle);
    lfStrikeOut := Byte(fsStrikeOut in FontStyle);
    lfCharSet := CodePageToCharSet(0);
    for I := 0 to Length(Name) do
      lfFaceName[I] := Name[I+1];
  end;

  FHGDI := CreateFontIndirectW(AFont);
  FDocucment.GetDCWithFont(Self);
  GetTextMetrics(FDocucment.FDC,fM);
  Size := GetOutlineTextMetrics(FDocucment.FDC,SizeOf(TOutlineTextMetric),nil);

  if fM.tmPitchAndFamily and TMPF_FIXED_PITCH=0 then
    fFixedWidth := true;

  Dispose(FOTM);
  GetMem(FOTM,Size);
  FOTM.otmSize := Size;
  GetOutlineTextMetrics(FDocucment.FDc,Size,FOTM);
  FAscent := FOTM.otmAscent;
  fDescent := FOTM.otmDescent;
end;

function TPDFDocument.FindFontIndex(Name: string):integer;
var
  I: Integer;
  s1,s2:String;
begin
  Result := -1;
  s1 := Uppercase(ReplaceStr(Name,' ',''));
  for I := 0 to Length(FTrueTypeFonts)-1 do
  begin
    s2 := Uppercase(ReplaceStr(string(FTrueTypeFonts[I]),' ',''));
    if s1 = s2 then
      Exit(I);
  end;
end;

constructor TPDFDocument.Create(AOwner: TComponent);
var
  ds: string;
  LFont: TLogFontW;
  i:integer;
begin
  inherited Create;

  ImagesList := TCustomImageList.Create(AOwner); //nil;

  ImageQuality := 100;
  FWidth := 595;
  FHeight := 842;

  FDc := CreateCompatibleDC(0);
  LFont.lfCharset := DEFAULT_CHARSET; // enumerate ALL fonts
  FillChar(LFont, SizeOf(LFont), 0);
  EnumFontFamiliesExW(FDC, LFont, @EnumFontsProcW, PtrInt(@FTrueTypeFonts), 0);
  fFontFallBackIndex := FindFontIndex('Calibri'); //Arial Unicode MS');

  if fFontFallBackIndex = -1 then
  begin
    for i := 0 to high(FTrueTypeFonts) do
      if Pos('Calibri',Lowercase(string(FTrueTypeFonts[i])))>0 then
      begin
        FFontFallBackIndex := i;
        Break;
      end;
  end;

  FAnnots := TList<string>.Create;
  FPages := TPDFPageItems.Create(Self);
  FFontsList := TList<TPDFFont>.Create;
  FDefaultFont := TFont.Create;
  FDefaultFont.Color := clBlack;
  FDefaultFont.Size := FONTSIZE;
  FDefaultFont.Name := 'Microsoft Sans Serif';

  FTextWidth := 575;

  FOutput := EmptyStr;

  FStart := '%PDF-1.4' + sLineBreak + '%¡³Å×';
  FObjectCount := 1;

  DateTimeToString(ds, 'yyyymmddhms', Now);

  FEnd := '%%EOF';

  FFooter := TPDFHeader.Create;
  FHeader := TPDFHeader.Create;
  FMetaData := TPDFMetaData.Create;

  // Begin the document by adding a page
  Pages.Add;
end;

function TPDFDocument.CurrentPage: TPDFPageItem;
begin
  Result := TPDFPageItem(Pages[pages.Count-1]);
end;

destructor TPDFDocument.Destroy;
var
  i: Integer;
begin
  ReleaseDC(0,FDC);
  ReleaseDC(0,fSelectedDCFontOld);
  FPages.Free;

  for i := 0 to FFontsList.Count - 1 do
    FFontsList.Items[i].Free;

  FFontsList.Clear;
  for I := 0 to FFontsList.Count - 1 do
  begin
    FFontsList[I].Free;
  end;

  FFooter.Free;
  FHeader.Free;
  FMetaData.Free;

  FFontsList.Free;
  FDefaultFont.Free;
  FAnnots.Free;

  inherited;
end;

procedure TPDFDocument.DoSetFooter;
var
  X, Y: Integer;
  M: TPdfMarges;
  R: Integer;
begin
  X := 0;
  Y := 0;
  R := 0;

  // Calculate text positions
  case Footer.TextHAlign of
    taLeftJustify: X := 15 + Round(CurrentPage.GetWidthText(IntToStr(Pages.Count), Footer.TextFont));
    taRightJustify: X := Width - 15 - Round(CurrentPage.GetWidthText(Footer.Text, Footer.TextFont)) - Round(CurrentPage.GetWidthText(IntToStr(Pages.Count), Footer.TextFont));
    taCenter: X := Round((Width -CurrentPage.GetWidthText(Footer.Text, Footer.TextFont))/2);
  end;

  case Footer.TextVAlign of
    taAlignTop: Y := 15 ;
    taAlignBottom: Y := 15 + Footer.TextFont.Size;
    taVerticalCenter: Y :=  15 + Round((Footer.TextFont.Size)/2);
  end;

  // Draw the text
  CurrentPage.AddTextLine(X, Height - Y, Footer.Text, Footer.TextFont, alLeft, True, True, False);

//  R := 0;
  if Footer.PageNumberVisible then
  begin
    // Calculate pagenumber positions
    case Footer.PageNumberHAlign of
      taLeftJustify: X := 15;
      taRightJustify: X := Width - 15 - Round(CurrentPage.GetWidthText(IntToStr(Pages.Count), Footer.PageNumberFont));
      taCenter: X := Round(Width/2) - Round(CurrentPage.GetWidthText(IntToStr(Pages.Count), Footer.PageNumberFont)*0.75);
    end;

    case Footer.PageNumberVAlign of
      taAlignTop: Y := 15;
      taAlignBottom: Y := 15 - Round((Footer.PageNumberFont.Size)/2);
      taVerticalCenter: Y := 15 - Footer.PageNumberFont.Size;
    end;

    Y := Height - Y;

    // Draw the number
    CurrentPage.AddTextLine(X, Y, IntToStr(Pages.Count), Footer.PageNumberFont, alLeft, True, True, False);

    if Footer.PageNumberFont.Size > Footer.TextFont.Size then
      R := Footer.PageNumberFont.Size
    else
      R := Footer.TextFont.Size;

  end;
  M.Left := CurrentPage.Marges.Left;
  M.Right := CurrentPage.Marges.Right;
  m.Bottom := CurrentPage.Marges.Bottom + R;
  M.Top := CurrentPage.Marges.Top + Header.PageNumberFont.Size;
  CurrentPage.Marges := M;
end;

procedure TPDFDocument.DoSetHeader;
var
  X, Y: Integer;
  M: TPdfMarges;
  R: Integer;
begin
  X := 0;
  Y := 0;

  // Calculate text positions
  if Header.PageNumberFont.Size > Header.TextFont.Size then
    R := Header.PageNumberFont.Size
  else
    R := Header.TextFont.Size;

  case Header.TextHAlign of
    taLeftJustify: X :=  15 + Round( CurrentPage.GetWidthText(IntToStr(Pages.Count), Header.TextFont));
    taRightJustify: X := Width -  15 - Round( CurrentPage.GetWidthText(Header.Text, Header.TextFont)) - Round( CurrentPage.GetWidthText(IntToStr(Pages.Count), Header.TextFont));
    taCenter: X := Round((Width - CurrentPage.GetWidthText(Header.Text, Header.TextFont))/2);
  end;

  case Header.TextVAlign of
    taAlignTop: Y :=  15 + R;
    taAlignBottom: Y :=  15 + R;
    taVerticalCenter: Y :=  15 + Round((R)/2);
  end;

  // Draw the text

  if X > Width then
    X :=  15;
  CurrentPage.AddTextLine(X, Y, Header.Text, Header.TextFont, alLeft, True, True, False);

//  R := 0;
  if Header.PageNumberVisible then
  begin
    // Calculate pagenumber positions
    case Header.PageNumberHAlign of
      taLeftJustify: X :=  15;
      taRightJustify: X := Width -  15 - Round( CurrentPage.GetWidthText(IntToStr(Pages.Count), Header.PageNumberFont));
      taCenter: X := Round(Width/2) - Round( CurrentPage.GetWidthText(IntToStr(Pages.Count), Header.PageNumberFont)*0.75);
    end;

    case Header.PageNumberVAlign of
      taAlignTop: Y :=  15 + R;
      taAlignBottom: Y :=  15 + R;
      taVerticalCenter: Y :=  15 + Round((R)/2);
    end;

    // Draw the number
    if Pages.Count > 1 then
      CurrentPage.AddTextLine(X, Y, IntToStr(Pages.Count), Header.PageNumberFont, alLeft, False, True, False)
    else
    begin
      CurrentPage.AddTextLine(X, Y, IntToStr(Pages.Count), Header.PageNumberFont, alLeft, True, True, False);
      LineYPosition := LineYPosition - Header.PageNumberFont.Size;
    end;
  end;

  M.Left := CurrentPage.Marges.Left;
  M.Right := CurrentPage.Marges.Right;
  m.Bottom := CurrentPage.Marges.Bottom;
  M.Top := CurrentPage.Marges.Top + R;
  CurrentPage.Marges := M;
end;

function TPDFDocument.GenerateJpeg(idx, objectindex: Integer; APage: Integer): string;
var
  Len, BitDepth: Integer;
  aJpegFile: TMemoryStream;
  fPixelWidth,fPixelHeight: Integer;
  tmp: string;
  ac: ansichar;
  ir: TImageRef;
begin
  ir := Pages[APage].ImagesList.Items[idx];
  aJpegFile := ir.Image;

  Len := aJpegFile.Size;
  if not GetJpegSize(aJpegFile,fPixelWidth,fPixelHeight,BitDepth) then
    Exit; // JPEG format expected

  tmp := inttostr(objectindex)+ ' 0 obj' + sLineBreak;
  tmp := tmp + '<<' + sLineBreak;
  tmp := tmp +  '/Type              /XObject' + sLineBreak;
  tmp := tmp +  '/Subtype           /Image' + sLineBreak;
  tmp := tmp +  '/Filter            /DCTDecode' + sLineBreak;
  tmp := tmp +  '/Height           ' + inttostr(fPixelHeight) + sLineBreak;
  tmp := tmp +  '/Width            ' + inttostr(fPixelWidth) + sLineBreak;
  tmp := tmp +  '/BitsPerComponent  8' + sLineBreak;
  tmp := tmp +  '/Length           ' + inttostr(Len) + sLineBreak;
  case BitDepth of
  8:  tmp := tmp +  '/ColorSpace    /DeviceGray' + sLineBreak;
  24: tmp := tmp +  '/ColorSpace    /DeviceRGB' + sLineBreak;
  end;

  tmp := tmp + '>>' + sLineBreak;
  tmp := tmp + 'stream' + sLineBreak;

  ajpegfile.Position := 0;

  while ajpegfile.Position < ajpegfile.Size  do
  begin
    ajpegfile.Read(ac,1);
    tmp := tmp + string(ac);
  end;

  tmp := tmp + slinebreak + 'endstream' + sLineBreak;
  tmp := tmp + 'endobj' + sLineBreak;

  ajpegfile.Free;

  Result := tmp;
end;


procedure TPDFDocument.GeneratePDF(AFileName: string);
var
  I,Y: Integer;
  myFile : File;
  s,w,fx,imgx: string;
  annotref,annots: string;
  metaRef,pageReferences: string;
  patternRefs, patterns, ptmp, bounds: string;
  SBGR1, SBGR2, SBGR3, SBGR4, SBGG1, SBGG2, SBGG3, SBGG4,  SBGB1, SBGB2, SBGB3, SBGB4: string;
  CL: TColor;
  mewo,fg: Integer;
  imgstr: string;
  outansi: ansistring;
  outstr: string;
  ls,os,cs:integer;
  md: string;
  annot: string;
  p: TPDFPageItem;
  Shading: TGradientPatern;

begin
  // Page References
  FObjectCount:=0;

  FOutput := FStart + sLineBreak;
  FOutput := FOutput + '1 0 obj' + sLineBreak;
  FOutput := FOutput + '<</Type/Catalog/PageLayout/SinglePage/Pages 2 0 R /Metadata {METAREF} /AcroForm<</Fields[]>>>>' + sLineBreak;
  FOutput := FOutput + 'endobj' + sLineBreak;
  Inc(FObjectCount);
  FOutput := FOutput + '2 0 obj' + sLineBreak;
  FOutput := FOutput + '<</Type/Pages/Kids[{PAGEREFERENCES}]/Count ' + IntToStr(Pages.Count) + '>>' + sLineBreak;
  FOutput := FOutput + 'endobj' + sLineBreak;
  Inc(FObjectCount);
  Inc(FObjectCount);

  fx := '';
  for I := 0 to FFontsList.Count - 1 do
  begin
    w := '';
    // 909[207]941[488]997[525]821[638]
    if TPdfFont(FFontsList[I]).FWinUnicodeUsed <> nil then
      for mewo := 0 to length(TPdfFont(FFontsList[I]).FWinUnicodeUsed) do
      begin
        fg := TPdfFont(FFontsList[I]).FindOrAddUsedWideChar
          (TPdfFont(FFontsList[I]).FWinUnicodeUsed[mewo]);
        if TPdfFont(FFontsList[I]).FFixedWidth then
        w := w + IntToStr(TPdfFont(FFontsList[I]).FUsedWide[fg].Glyph) + '[' +
          IntToStr(600) + ']'
        else
        w := w + IntToStr(TPdfFont(FFontsList[I]).FUsedWide[fg].Glyph) + '[' +
          IntToStr(TPdfFont(FFontsList[I]).FUsedWide[fg].Width) + ']';
      end;

    FOutput := FOutput + format('%s 0 obj' + sLineBreak +
      '<</Type/Font/BaseFont/%s/Subtype/Type0/Encoding/Identity-H/Name/%s/DescendantFonts[%s 0 R]>>'
      + sLineBreak + 'endobj' + sLineBreak + '%s 0 obj' + sLineBreak +
      '<</Type/Font/Subtype/CIDFontType2/BaseFont/%s/CIDSystemInfo<</Supplement 0/Ordering(Identity)/Registry(Adobe)>>/DW 278/W [%s]/FontDescriptor %s 0 R>>'
      + sLineBreak + 'endobj' + sLineBreak, [IntToStr(FObjectCount),
      StripSpaces(TPdfFont(FFontsList[I]).Name), 'FU' + IntToStr(I),
      IntToStr(FObjectCount + 1), IntToStr(FObjectCount + 1),
      StripSpaces(TPdfFont(FFontsList[I]).Name), w,IntToStr(FObjectCount + 2)]);

    FOutput := FOutput+Format('%s 0 obj'+  sLineBreak +
        '<</Type/FontDescriptor/FontName/%s/Ascent %s/CapHeight 666/Descent %s/ItalicAngle 0/StemV 87/Flags 32/FontBBox[%s %s %s %s]/FontFile2 %s 0 R>>'+  sLineBreak+
        'endobj'+  sLineBreak,[IntToStr(FObjectCount + 2),StripSpaces(TPdfFont(FFontsList[I]).Name),IntTostr(TPdfFont(FFontsList[I]).FAscent), IntTostr(TPdfFont(FFontsList[I]).fDescent),IntTostr(TPdfFont(FFontsList[I]).FOTM.otmrcFontBox.Left),
        IntTostr(TPdfFont(FFontsList[I]).FOTM.otmrcFontBox.Bottom),IntTostr(TPdfFont(FFontsList[I]).FOTM.otmrcFontBox.Top),IntTostr(TPdfFont(FFontsList[I]).FOTM.otmrcFontBox.Right)
        ,IntToStr(FObjectCount + 3)]);

    s := string(TPdfFont(FFontsList[I]).GetTTFXData(Self));
    os := Length(s);
    s := string(CompressString(ansistring(s)));
    ls := Length(s);
    FOutput := FOutput + Format('%s 0 obj'+ sLineBreak +
        '<< /Length %s /Length1 %s /Filter /FlateDecode >>' +sLineBreak+
        'stream'+ sLineBreak+'%s'+ sLineBreak+'endstream'+sLineBreak+
        'endobj'+sLineBreak,[IntToStr(FObjectCount+3),IntToStr(ls),IntToStr(os),s]);

    FX := FX + '/FU' + IntToStr(I) + ' ' + IntToStr(FObjectCount) + ' 0 R/F' +
      IntToStr(I) + ' ' + IntToStr(FObjectCount + 1) + ' 0 R';
    FObjectCount := FObjectCount + 4;
  end;

(*
  FOutput := FOutput + '3 0 obj' + sLineBreak;
  FOutput := FOutput + '<</MediaBox[0 0 ' + IntToStr(Width) + ' ' + IntToStr(Height) + ']/Type/Page/Annots[ {ANNOTS}]/Parent 2 0 R /Resources<</Font<<{FONTS}>>/Pattern<<{PATTERNS}>>/XObject<<{IMGRES}>>/ProcSet[/PDF/Text/ImageC]>>/Contents 4 0 R >>' + sLineBreak; ///RYAN #D1#C7#ED#C7#E4<FEFF005200590041004E00200631062706CC06270646>>>' + sLineBreak;
  FOutput := FOutput + 'endobj' + sLineBreak;

  Inc(FObjectCount);

  // Page Content
  FOutput := FOutput + '4 0 obj' + sLineBreak;
  FOutput := FOutput + '<</Length ' + IntToStr(Length(TPDFPageItem(Pages[0]).Content)) + '>>';
  FOutput := FOutput + 'stream' + sLineBreak;
  FOutPut := FOutput + '' + TPDFPageItem(Pages[0]).Content;
  FOutput := FOutput + 'endstream' + sLineBreak;
  FOutput := FOutput + 'endobj' + sLineBreak;
  Inc(FObjectCount);*)

  // Meta Data
  md := ''+
  '<?xpacket begin="Ôªø" id="W5M0MpCehiHzreSzNTczkc9d"?>' + sLineBreak +
    '<x:xmpmeta xmlns:x="adobe:ns:meta/" x:xmptk="Adobe XMP Core 5.2-c001 63.139439,2010/09/27-13:37:26 ">' + sLineBreak +
      '<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">' + sLineBreak +
        '<rdf:Description rdf:about=""  xmlns:xmp="http://ns.adobe.com/xap/1.0/">' + sLineBreak +
          '<xmp:CreateDate>2011-04-25T15:33:20Z</xmp:CreateDate>' + sLineBreak +
          '<xmp:CreatorTool>' + MetaData.CreatorTool + '</xmp:CreatorTool>' + sLineBreak +
          '<xmp:ModifyDate>' + MetaData.CreateDate + '</xmp:ModifyDate>' + sLineBreak +
          '<xmp:MetadataDate>' + MetaData.CreateDate + '</xmp:MetadataDate>' + sLineBreak +
        '</rdf:Description>' + sLineBreak +
        '' + sLineBreak +
        '<rdf:Description rdf:about=""  xmlns:pdf="http://ns.adobe.com/pdf/1.3/">' + sLineBreak +
          '<pdf:Keywords/>' + sLineBreak +
          '<pdf:Producer>' + MetaData.Producer + ' </pdf:Producer>' + sLineBreak +
        '</rdf:Description>' + sLineBreak +
        '' + sLineBreak ;
  md := md +
          '<xmp:CreateDate>2011-04-25T15:33:20Z</xmp:CreateDate>' + sLineBreak +
          '<xmp:CreatorTool>' + MetaData.CreatorTool + '</xmp:CreatorTool>' + sLineBreak +
          '<xmp:ModifyDate>' + MetaData.CreateDate + '</xmp:ModifyDate>' + sLineBreak +
          '<xmp:MetadataDate>' + MetaData.CreateDate + '</xmp:MetadataDate>' + sLineBreak +
        '</rdf:Description>' + sLineBreak +
        '' + sLineBreak +
        '<rdf:Description rdf:about=""  xmlns:pdf="http://ns.adobe.com/pdf/1.3/">' + sLineBreak +
          '<pdf:Keywords/>' + sLineBreak +
          '<pdf:Producer>' + MetaData.Producer + ' </pdf:Producer>' + sLineBreak +
        '</rdf:Description>' + sLineBreak +
        '' + sLineBreak +
        '<rdf:Description rdf:about=""  xmlns:dc="http://purl.org/dc/elements/1.1/">' + sLineBreak +
        '<dc:format>application/pdf</dc:format>' + sLineBreak +
          '<dc:creator>' + sLineBreak +
            '<rdf:Seq>' + sLineBreak +
              '<rdf:li>PDF</rdf:li>' + sLineBreak +
            '</rdf:Seq>' + sLineBreak +
          '</dc:creator>' + sLineBreak +
          '<dc:title>' + sLineBreak +
            '<rdf:Alt>' + sLineBreak +
              '<rdf:li xml:lang="x-default">' + MetaData.Title + '</rdf:li>' + sLineBreak +
            '</rdf:Alt>' + sLineBreak +
          '</dc:title>' + sLineBreak +
        '</rdf:Description>' + sLineBreak +
        '<rdf:Description rdf:about=""  xmlns:xmpMM="http://ns.adobe.com/xap/1.0/mm/">' + sLineBreak +
          '<xmpMM:DocumentID>uuid:51b92418-85ef-f843-ba4d-9c6ea3482287</xmpMM:DocumentID>' + sLineBreak +
          '<xmpMM:InstanceID>uuid:5506218e-628b-8046-8af4-f2eb28096824</xmpMM:InstanceID>' + sLineBreak +
        '</rdf:Description>' + sLineBreak +
      '</rdf:RDF>' + sLineBreak +
    '</x:xmpmeta>' + sLineBreak +
  '<?xpacket end="w"?>';

  FOutput := FOutput + IntToStr(FObjectCount)+ ' 0 obj' + sLineBreak;
  FOutput := FOutput + '<</Type/Metadata /Subtype/XML /Length ' + IntToStr(Length(md)) + '>>';
  FOutput := FOutput + 'stream' + sLineBreak;
  FOutPut := FOutput + md;
  FOutput := FOutput + 'endstream' + sLineBreak;
  FOutput := FOutput + 'endobj' + sLineBreak;
  FOutput:=ReplaceStr(FOutput,'{METAREF}',IntToStr(FObjectCount)+ ' 0 R');
  Inc(FObjectCount);
  Inc(FObjectCount);

  annots := '';
  annotref := '';
  for annot in Annotations do
  begin
    annots := annots + ' ' + IntToStr(FObjectCount) + string(annot);
    annotref := annotref + ' ' + IntToStr(FObjectCount) + ' 0 R ';
    Inc(FObjectCount);
  end;

  patternRefs := '';
  patterns := '';
  I := 0;
  for Shading in Pages[0].FShadingList do
  begin
    // Build the references string
    patternRefs := patternRefs +
    '/LGradient' + IntToStr(I) + sLineBreak +
    '<<' + sLineBreak +
      '/Type /Pattern'+ sLineBreak +
      '/PatternType 2' + sLineBreak +
      '/Shading ' + IntToStr(FObjectCount) + ' 0 R' + sLineBreak +
    '>>';

    // Build the referenced objects

    // Cell 1st shading color
    CL := ColorToRGB(Shading.ColorFrom);
    {$IFDEF DELPHIXE_LVL}
    FormatSettings.DecimalSeparator := '.';
    {$ENDIF}
    {$IFNDEF DELPHIXE_LVL}
    DecimalSeparator := '.';
    {$ENDIF}
    SBGR1 := Format('%.2f',[GetRValue(CL)/255]);
    SBGG1 := Format('%.2f',[GetGValue(CL)/255]);
    SBGB1 := Format('%.2f',[GetBValue(CL)/255]);

    // Cell 2nd shading color
    CL := ColorToRGB(Shading.ColorTo);
    {$IFDEF DELPHIXE_LVL}
    FormatSettings.DecimalSeparator := '.';
    {$ENDIF}
    {$IFNDEF DELPHIXE_LVL}
    DecimalSeparator := '.';
    {$ENDIF}
    SBGR2 := Format('%.2f',[GetRValue(CL)/255]);
    SBGG2 := Format('%.2f',[GetGValue(CL)/255]);
    SBGB2 := Format('%.2f',[GetBValue(CL)/255]);

    ptmp := '   <<' + sLineBreak +
              '     /FunctionType 2' + sLineBreak +
              '     /Domain [0 1]' + sLineBreak +
              '     /N 1' + sLineBreak +
              '     /C0 [' + SBGR1 + ' ' + SBGG1 + ' ' + SBGB1 + ']' + sLineBreak +
              '     /C1 [' + SBGR2 + ' ' + SBGG2 + ' ' + SBGB2 + ']' + sLineBreak +
              '   >>' + sLineBreak;
    bounds := '1';
    if Shading.ColorMirrorTo <> clNone then
    begin
      bounds := '0.5';
      // Cell 3th shading color
      CL := ColorToRGB(Shading.ColorMirrorFrom);
      {$IFDEF DELPHIXE_LVL}
      FormatSettings.DecimalSeparator := '.';
      {$ENDIF}
      {$IFNDEF DELPHIXE_LVL}
      DecimalSeparator := '.';
      {$ENDIF}
      SBGR3 := Format('%.2f',[GetRValue(CL)/255]);
      SBGG3 := Format('%.2f',[GetGValue(CL)/255]);
      SBGB3 := Format('%.2f',[GetBValue(CL)/255]);

      // Cell 4th shading color
      CL := ColorToRGB(Shading.ColorMirrorTo);
      {$IFDEF DELPHIXE_LVL}
      FormatSettings.DecimalSeparator := '.';
      {$ENDIF}
      {$IFNDEF DELPHIXE_LVL}
      DecimalSeparator := '.';
      {$ENDIF}
      SBGR4 := Format('%.2f',[GetRValue(CL)/255]);
      SBGG4 := Format('%.2f',[GetGValue(CL)/255]);
      SBGB4 := Format('%.2f',[GetBValue(CL)/255]);

      ptmp := '   <<' + sLineBreak +
              '     /FunctionType 2' + sLineBreak +
              '     /Domain [0 1]' + sLineBreak +
              '     /N 1' + sLineBreak +
              '     /C0 [' + SBGR3 + ' ' + SBGG3 + ' ' + SBGB3 + ']' + sLineBreak +
              '     /C1 [' + SBGR4 + ' ' + SBGG4 + ' ' + SBGB4 + ']' + sLineBreak +
              '   >>' + sLineBreak;
    end;

    patterns := patterns + IntToStr(FObjectCount) +
    ' 0 obj' + sLineBreak +
    '<<' + sLineBreak +
    ' /ShadingType 2' + sLineBreak +
    ' /Extend [false false]' + sLineBreak +
    ' /ColorSpace /DeviceRGB' + sLineBreak +
    ' /Coords [' + IntToStr(Shading.X1+74) + ' ' + IntToStr(Shading.Y1) + ' ' + IntToStr(Shading.X2+74) + ' ' +IntToStr(Shading.Y2) + ']' + sLineBreak +
    ' /Function ' + sLineBreak +
    ' <<' + sLineBreak +
    '   /FunctionType 3' + sLineBreak +
    '   /Domain [0 1]' + sLineBreak +
    '   /Bounds [' + bounds + ']' + sLineBreak +
    '   /Encode [0 1 0 1]' + sLineBreak +
    '   /Functions' + sLineBreak +
    '   [' + sLineBreak +
    '   <<' + sLineBreak +
    '     /FunctionType 2' + sLineBreak +
    '     /Domain [0 1]' + sLineBreak +
    '     /N 1' + sLineBreak +
    '     /C0 [' + SBGR1 + ' ' + SBGG1 + ' ' + SBGB1 + ']' + sLineBreak +
    '     /C1 [' + SBGR2 + ' ' + SBGG2 + ' ' + SBGB2 + ']' + sLineBreak +
    '   >>' + sLineBreak
    + ptmp +
    '   ]' + sLineBreak +
    ' >>' + sLineBreak +
    '>>' + sLineBreak +
    'endobj' + sLineBreak ;

    Inc(I);
    Inc(FObjectCount);
  end;

  FOutput := ReplaceStr(FOutput,'{PATTERNS}',patternRefs);


  Inc(FObjectCount);
  pageReferences := '';

  //Loop for pages
  for I := 0 to Pages.Count - 1 do
  begin
    p := pages.Items[I];

    imgx := '';
    for Y := 0 to p.FImagesList.Count - 1 do
    begin
      FOutput := FOutput + GenerateJpeg(Y, FObjectCount, I);
      imgx := imgx + '/Im' + inttostr(Y + 1) +' '+ inttostr(FObjectCount) + ' 0 R' + sLineBreak;
      inc(FObjectCount);
    end;

    pageReferences := pageReferences + IntToStr(FObjectCount) + ' 0 R ';

    // Page References
    FOutput := FOutput {+ FStart }+ sLineBreak;
    FOutput := FOutput + ' ' + IntToStr(FObjectCount) +' 0 obj' + sLineBreak;
    Inc(FObjectCount);
    FOutput := FOutput + ' << /Type /Page /Annots[ {ANNOTS}] /Parent 2 0 R /MediaBox[0 0 ' + IntToStr(Width) + ' ' + IntToStr(Height) + '] /Resources<</Font<<{FONTS}>>/Pattern<<{PATTERNS}>>/XObject<<{IMGRES}>>/ProcSet[/PDF/Text/ImageC]>>/Contents ' + IntToStr(FObjectCount) + ' 0 R >>' + sLineBreak;
    FOutput := FOutput + ' endobj' + sLineBreak;

    // Page Content
    FOutput := FOutput + ' ' + IntToStr(FObjectCount) + ' 0 obj' + sLineBreak;
    FOutput := FOutput + ' << /Length ' +  IntToStr(Length(p.Content)) + '>>';
    FOutput := FOutput + ' stream' + sLineBreak;
    FOutput := FOutput + ' ' + p.Content;
    FOutput := FOutput + ' endstream' + sLineBreak;
    FOutput := FOutput + ' endobj' + sLineBreak;
    Inc(FObjectCount);

    FOutput := ReplaceStr(FOutput,'{IMGRES}',imgx);

    patternRefs := '';
    Y := 0;
    for Shading in Pages[I].FShadingList do
    begin
      // Build the references string
      patternRefs := patternRefs +
      '/LGradient' + IntToStr(Y) + sLineBreak +
      '<<' + sLineBreak +
        '/Type /Pattern'+ sLineBreak +
        '/PatternType 2' + sLineBreak +
        '/Shading ' + IntToStr(FObjectCount) + ' 0 R' + sLineBreak +
      '>>';

      // Build the referenced objects

      // Cell 1st shading color
      CL := ColorToRGB(Shading.ColorFrom);
      {$IFDEF DELPHIXE_LVL}
      FormatSettings.DecimalSeparator := '.';
      {$ENDIF}
      {$IFNDEF DELPHIXE_LVL}
      DecimalSeparator := '.';
      {$ENDIF}
      SBGR1 := Format('%.2f',[GetRValue(CL)/255]);
      SBGG1 := Format('%.2f',[GetGValue(CL)/255]);
      SBGB1 := Format('%.2f',[GetBValue(CL)/255]);

      // Cell 2nd shading color
      CL := ColorToRGB(Shading.ColorTo);
      {$IFDEF DELPHIXE_LVL}
      FormatSettings.DecimalSeparator := '.';
      {$ENDIF}
      {$IFNDEF DELPHIXE_LVL}
      DecimalSeparator := '.';
      {$ENDIF}
      SBGR2 := Format('%.2f',[GetRValue(CL)/255]);
      SBGG2 := Format('%.2f',[GetGValue(CL)/255]);
      SBGB2 := Format('%.2f',[GetBValue(CL)/255]);

      ptmp := '   <<' + sLineBreak +
                '     /FunctionType 2' + sLineBreak +
                '     /Domain [0 1]' + sLineBreak +
                '     /N 1' + sLineBreak +
                '     /C0 [' + SBGR1 + ' ' + SBGG1 + ' ' + SBGB1 + ']' + sLineBreak +
                '     /C1 [' + SBGR2 + ' ' + SBGG2 + ' ' + SBGB2 + ']' + sLineBreak +
                '   >>' + sLineBreak;
      bounds := '1';
      if Shading.ColorMirrorTo <> clNone then
      begin
        bounds := '0.5';
        // Cell 3th shading color
        CL := ColorToRGB(Shading.ColorMirrorFrom);
        {$IFDEF DELPHIXE_LVL}
        FormatSettings.DecimalSeparator := '.';
        {$ENDIF}
        {$IFNDEF DELPHIXE_LVL}
        DecimalSeparator := '.';
        {$ENDIF}
        SBGR3 := Format('%.2f',[GetRValue(CL)/255]);
        SBGG3 := Format('%.2f',[GetGValue(CL)/255]);
        SBGB3 := Format('%.2f',[GetBValue(CL)/255]);

        // Cell 4th shading color
        CL := ColorToRGB(Shading.ColorMirrorTo);
        {$IFDEF DELPHIXE_LVL}
        FormatSettings.DecimalSeparator := '.';
        {$ENDIF}
        {$IFNDEF DELPHIXE_LVL}
        DecimalSeparator := '.';
        {$ENDIF}
        SBGR4 := Format('%.2f',[GetRValue(CL)/255]);
        SBGG4 := Format('%.2f',[GetGValue(CL)/255]);
        SBGB4 := Format('%.2f',[GetBValue(CL)/255]);

        ptmp := '   <<' + sLineBreak +
                '     /FunctionType 2' + sLineBreak +
                '     /Domain [0 1]' + sLineBreak +
                '     /N 1' + sLineBreak +
                '     /C0 [' + SBGR3 + ' ' + SBGG3 + ' ' + SBGB3 + ']' + sLineBreak +
                '     /C1 [' + SBGR4 + ' ' + SBGG4 + ' ' + SBGB4 + ']' + sLineBreak +
                '   >>' + sLineBreak;
      end;

      patterns := patterns + IntToStr(FObjectCount) +
      ' 0 obj' + sLineBreak +
      '<<' + sLineBreak +
      ' /ShadingType 2' + sLineBreak +
      ' /Extend [false false]' + sLineBreak +
      ' /ColorSpace /DeviceRGB' + sLineBreak +
      ' /Coords [' + IntToStr(Shading.X1+74) + ' ' + IntToStr(Shading.Y1) + ' ' + IntToStr(Shading.X2+74) + ' ' +IntToStr(Shading.Y2) + ']' + sLineBreak +
      ' /Function ' + sLineBreak +
      ' <<' + sLineBreak +
      '   /FunctionType 3' + sLineBreak +
      '   /Domain [0 1]' + sLineBreak +
      '   /Bounds [' + bounds + ']' + sLineBreak +
      '   /Encode [0 1 0 1]' + sLineBreak +
      '   /Functions' + sLineBreak +
      '   [' + sLineBreak +
      '   <<' + sLineBreak +
      '     /FunctionType 2' + sLineBreak +
      '     /Domain [0 1]' + sLineBreak +
      '     /N 1' + sLineBreak +
      '     /C0 [' + SBGR1 + ' ' + SBGG1 + ' ' + SBGB1 + ']' + sLineBreak +
      '     /C1 [' + SBGR2 + ' ' + SBGG2 + ' ' + SBGB2 + ']' + sLineBreak +
      '   >>' + sLineBreak
      + ptmp +
      '   ]' + sLineBreak +
      ' >>' + sLineBreak +
      '>>' + sLineBreak +
      'endobj' + sLineBreak ;

      Inc(Y);
    Inc(FObjectCount);
    end;

    FOutput := ReplaceStr(FOutput,'{PATTERNS}',patternRefs);
  end;

  FOutput := StringReplace(FOutput,'{PAGEREFERENCES}', pageReferences, [rfReplaceAll]);

  // Page Initialization

  outstr := FOutput;
  outstr := outstr + {imgstr + }annots + patterns;

  outstr := outstr + GenerateXrefTable;

  outstr := outstr + 'trailer' + sLineBreak;
  outstr := outstr + '<</Root 1 0 R /Size ' + IntToStr(FObjectCount) + '>>' + sLineBreak;

  outstr := outstr + GetXrefStart(outstr);

  outstr := outstr + FEnd;

  outstr := ReplaceStr(outstr,'{FONTS}',fx);
  outstr := ReplaceStr(outstr,'{ANNOTS}', annotref);

  outansi := ansistring(outstr);

  AssignFile(myFile, AFileName);

  {$i-}
  ReWrite(myFile,1);
  {$i+}
  if IOResult <> 0 then
    raise Exception.Create('Cannot create PDF file');

  BlockWrite(myFile,outAnsi[1],Length(outAnsi));

  // Close the file
  CloseFile(myFile);
end;

function TPDFDocument.GenerateXrefTable: string;
var
  xref,p: string;
  I: Integer;
begin
  xref := 'xref' + sLineBreak;
  xref := xref + '0 ' + IntToStr(FObjectCount) + sLineBreak;
  xref := xref + '0000000000 65535 f ' + sLineBreak;

  for I := 1 to FObjectCount - 1 do
  begin
    p := IntToStr(Pos( IntToStr(I) + ' 0 obj', Foutput)-1);
    p := StringOfChar( '0', 10 - Length(p) ) + p + ' 00000 n ';
    xref := xref + p + sLineBreak;
  end;

  Result := xref;
end;

function TPDFDocument.GetXrefStart(outansi: string): string;
begin
  Result := 'startxref ' + sLineBreak + IntToStr(Pos( 'xref', outansi)) + sLineBreak;
end;

procedure TPDFDocument.SetDefaultFont(const Value: TFont);
begin
  FDefaultFont.Assign(Value);
end;

procedure TPDFDocument.SetFitOption(const Value: TPdfFitOptions);
begin
  FFitOption := Value;
end;

procedure TPDFDocument.SetFooter(const Value: TPDFHeader);
begin
  FFooter.Assign(Value);

  DoSetFooter;

  LineYPosition := CurrentPage.Marges.Top;
end;

procedure TPDFDocument.SetHeader(const Value: TPDFHeader);
begin
  FHeader.Assign(Value);
  DoSetHeader;
end;

procedure TPDFDocument.SetImagesList(const Value: TCustomImageList);
begin
  FImagesList := (Value);
end;

procedure TPDFDocument.SetMetaData(const Value: TPDFMetaData);
begin
  FMetaData.Assign(Value);
end;

procedure TPDFDocument.SetPages(const Value: TPDFPageItems);
begin
  FPages.Assign(Value);
end;

function TPDFDocument.SetTextWidth(AWidth: Integer): Integer;
begin
  FTextWidth := AWidth;
  Result := AWidth;
end;

function TPDFDocument.TextOccurences(const ASearch, AText: string): Integer;
var
  offset: Integer;
begin
  result := 0;
  offset := PosEx(ASearch, AText, 1);
  while offset <> 0 do
  begin
    inc(result);
    offset := PosEx(ASearch, AText, offset + length(ASearch));
  end;
end;

function TPDFDocument.TextWrap(AText: string; APosX,AWidth: Integer; AReplaceString: string; var occ: Integer;IsUnicodeText: Boolean=false;AFont: TFont=nil): string;
var
  i: Integer;
  atest,tmp: string;
  pdfFont: TPdfFont;
  Courier: Boolean;
  xFont:TFont;
begin
  if AFont = nil then
    AFont := DefaultFont;

  if LineXPosition = 0 then
    LineXPosition := CurrentPage.Marges.Left;

  tmp := '';
  occ := 0;
  Courier := False;
  pdfFont := AddFont(AFont.Name, Afont.Style, IsUnicodeText);
  pdfFont.FHGDI := AFont.Handle;
  xfont := TFont.Create;
  xfont.Assign(AFont);
  pdfFont.FHGDI := xFont.Handle;
  pdfFont.Init;
  xfont.Free;

  while AText<>'' do
  begin
    i := 1;
    atest := '';

    while (i<Length(AText)) do
    begin
       while (i < Length(AText)) and (AText[I] <> ' ') do
          Inc(i);
       if APosX + Round(CurrentPage.GetWidthText(Copy(AText,1,i), AFont)*0.8) > AWidth then
       begin
         break;
       end;
       Inc(i);
    end;

    atest := Copy(AText,1,i);
    atext := Copy(AText,i+1,65535);

    AddFontAndUsedChar(AFont.Name,AFont.Style, atest);


    if AnsiContainsStr(LowerCase(AFont.Name), 'courier') then
    begin
      Courier := true;
    end;

    tmp := tmp + #10 + Format(AReplaceString,[IntToStr(APosX), IntToStr(Height - LineYPosition), TPDFPageItem.GetConvertedText(Copy(atest, 0, 65535),IsUnicodeText,pdfFont)]);
    LineYPosition:=(LineYPosition + Round((AFont.Size*1.5)));

    APosX := CurrentPage.Marges.Left;

    Inc(occ);
  end;

  if occ = 0 then
    occ := 1;

  if occ > 1 then
  begin
    LineXPosition := CurrentPage.Marges.Left;
    LineYPosition:=(LineYPosition - Round((AFont.Size*1.5)));
  end;

  if Courier then
    LineXPosition := LineXPosition + Round(CurrentPage.GetWidthText(atest, AFont) * 0.68 )
  else
    LineXPosition := LineXPosition + Round(CurrentPage.GetWidthText(atest, AFont) * 0.75 );

  Result:=tmp;
end;

//------------------------------------------------------------------------------

{ TPDFPageItems }

function TPDFPageItems.Add: TPDFPageItem;
begin
  Result := TPDFPageItem(inherited Add);
end;

constructor TPDFPageItems.Create(AOwner: TPDFDocument);
begin
  inherited Create(AOwner, TPDFPageItem);
end;

function TPDFPageItems.GetItem(Index: Integer): TPDFPageItem;
begin
  Result := TPDFPageItem(inherited Items[Index]);
end;

function TPDFPageItems.Insert(Index: Integer): TPDFPageItem;
begin
  Result := TPDFPageItem(inherited Insert(Index));
end;

procedure TPDFPageItems.SetItem(Index: Integer; const Value: TPDFPageItem);
begin
  inherited Items[Index] := Value;
end;

//------------------------------------------------------------------------------

{ TPDFPageItem }

class function TPDFPageItem.GetConvertedText(AText: string;IsUnicodeText: Boolean;Font:TPdfFont): string;
const
  HexChars: array[0..15] of Char = '0123456789ABCDEF';

  function AddHex4(aWordValue: cardinal) : String;
  var
    v: Cardinal;
    B: String;
  begin
    v := aWordValue shr 8;
    aWordValue := aWordValue and $ff;
    B := '    ';
    B[1] := HexChars[v shr 4];            // MSB stored first (BigEndian)
    B[2] := HexChars[v and $F];
    B[3] := HexChars[aWordValue shr 4];   // LSB stored last (BigEndian)
    B[4] := HexChars[aWordValue and $F];
    result := B;
  end;

var
  lntext: string;
  I: Integer;
  isinUnicode: Boolean;
  glyph:Cardinal;

begin
  lntext:='';

  isinUnicode := IsUnicodeText;

  if IsInUnicode then
  begin
    lntext := '<';//+#254#255;
    for I := 1 to Length(AText) do
    begin
      if High(Font.fUsedWide) > 0 then
      begin
        glyph := Font.fUsedWide[Font.FindOrAddUsedWideChar(AText[I])].Glyph;
        lntext := lntext + AddHex4(Cardinal(glyph));
      end
      else
        lntext := lntext + AText[i];
    end;
    lntext := lntext + '>';
    Result := lntext;
  end else
  begin
    AText := StringReplace(AText, ')', '\)', [rfReplaceAll]);
    AText := StringReplace(AText, '(', '\(', [rfReplaceAll]);
    Result := '(' + AText + ')';
  end;
end;

procedure TPDFPageItem.AddPng(APosX, APosY, AWidth, AHeight: Integer; AFileName: string; Alignment: TPDFALIGNMENT = alLeft);
var
  jpg: TJPegImage;
  ms: TMemoryStream;
  ir: TImageRef;
begin
  jpg := PNGtoJPG(AFileName, PDFDocument.ImageQuality);

  ms := TMemoryStream.Create;
  jpg.SaveToStream(ms);

  jpg.Free;

  AddJpeg(APosX, APosY, AWidth, AHeight, ms, '', Alignment);

  ir.ImageFileName := AFileName;
  ir.Image := ms;
  ImagesList.Add(ir);
end;

procedure TPDFPageItem.AddBmp(APosX, APosY, AWidth, AHeight: Integer; AFileName: string; Alignment: TPDFALIGNMENT = alLeft);
var
  jpg: TJPegImage;
  ms: TMemoryStream;
  ir: TImageRef;
begin
  jpg := BMPtoJPG(AFileName, PDFDocument.ImageQuality);

  ms := TMemoryStream.Create;
  jpg.SaveToStream(ms);

  jpg.Free;

  AddJpeg(APosX, APosY, AWidth, AHeight, ms, '', Alignment);

  ir.ImageFileName := AFileName;
  ir.Image := ms;
  ImagesList.Add(ir);
end;

procedure TPDFPageItem.AddJpeg(APosX, APosY, AWidth, AHeight: Integer; AJPEGImage: TMemoryStream; ImgRef: string = ''; Alignment: TPDFALIGNMENT = alLeft; AddRef: Boolean = false);
var
  fPixelWidth, fPixelHeight, BitDepth: Integer;
  res: Boolean;
  ir: TImageRef;
begin
  res := GetJpegSize(AJpegImage,fPixelWidth,fPixelHeight,BitDepth);

  if not res then
    Exit; // JPEG format expected, if not, skip

  if AWidth = 0 then
    AWidth := fPixelWidth;

  if AHeight = 0 then
    AHeight := fPixelHeight;

  if (ImgRef <> '') and AddRef then
  begin
    ir.ImageFileName := ImgRef;
    ir.Image := AJpegImage;
    ImagesList.Add(ir);
  end;

  if AWidth + APosX > PDFDocument.Width + 2 then
  begin
    AddNewLine;
    APosX := PDFDocument.LineXPosition;
    APosY := PDFDocument.LineYPosition;
  end
  else
  begin
    case Alignment of
    alRight:
    begin
      APosX := PDFDocument.Width  - APosX - AWidth - Marges.Right;
    end;
    alCenter:
    begin
      APosX := Round((PDFDocument.Width  -  APosX - AWidth) / 2 );
    end;
  end;

    APosX := APosX + Indenting;
  end;

  FContent := FContent + 'q' + sLineBreak;
  FContent := FContent + inttostr(AWidth)+ ' 0 0 ' + inttostr(AHeight)+ ' ' +inttostr(APosX) +' '  + inttostr(PDFDocument.Height - APosY - AHeight)+' cm' + sLineBreak;
  FContent := FContent + '/Im' + inttostr(ImagesList.Count + 1) + ' Do' + sLineBreak;
  FContent := FContent + 'Q' + sLineBreak;

  PDFDocument.LineXPosition := PDFDocument.LineXPosition + AWidth;
  PDFDocument.LineYPosition := PDFDocument.LineYPosition + AHeight;
end;


procedure TPDFPageItem.AddNewLine;
begin
  PDFDocument.LineYPosition := (PDFDocument.LineYPosition + Round((FontSize)));
  PDFDocument.LineXPosition := Marges.Left;

  if PDFDocument.LineYPosition > PDFDocument.Height - 10 then
  begin
    PDFDocument.Pages.Add;
    PDFDocument.CurrentPage.Marges := Marges;
    PDFDocument.DoSetFooter;
    PDFDocument.DoSetHeader;
  end;
end;

procedure TPDFPageItem.AddJpeg(APosX, APosY: Integer; AWidth, AHeight: Integer; AJPEGFileName: string; Alignment: TPDFALIGNMENT = alLeft);
var
  aJpegFile: TMemoryStream;
  ir: TImageRef;
begin
  aJpegFile := TMemoryStream.Create;
  AJPEGFile.LoadFromFile(AJPEGFileName);

  AddJpeg(APosX, APosY, AWidth, AHeight, ajpegfile, '', Alignment);

  ir.ImageFileName := AJPegFileName;
  ir.Image := aJpegFile;
  ImagesList.Add(ir);
end;

function TPDFPageItem.AddTextLine(APosX, APosY: Integer; AText: string; AFont: TFont; Alignment: TPDFALIGNMENT = alLeft; AutomaticLineBreak: Boolean = True; IsUnicodeText: Boolean=false; AddNewPage: Boolean = True): string;
var
  tf, tmp, stl, udl: string;
  tw,occ, tmpX: Integer;
  Color : LongInt;
  R, G, B : string;
  X,Y: Integer;
  font: TPdfFont;
begin
  if PDFDocument.FindFontIndex(afont.Name)=-1 then
  begin
    Afont.Name := string(PDFDocument.FTrueTypeFonts[PDFDocument.fFontFallBackIndex]);
  end;

  SelectObject(PDFDocument.FDc, AFont.Handle);

  tmpX := APosX;

  // For the moment we set unicode standard to true
  IsUnicodeText:=true;
  IsUnicodeText := SetUnicodeText(IsUnicodeText, AText);

  // Check for bullets
  SetBulletsInText(AFont);

  // Set the Vars
  occ := 1;
  tmp := '';
  X := APosX;
  Y := APosY;

  tw := GetWidthText(AText,AFont);

  Color := ColorToRGB(AFont.Color);
  {$IFDEF DELPHIXE_LVL}
  FormatSettings.DecimalSeparator := '.';
  {$ENDIF}
  {$IFNDEF DELPHIXE_LVL}
  DecimalSeparator := '.';
  {$ENDIF}
  R := Format('%.2f',[GetRValue(Color)/255]);
  G := Format('%.2f',[GetGValue(Color)/255]);
  B := Format('%.2f',[GetBValue(Color)/255]);

  // Bold / Italic / BoldItalic
  stl := SetTextStyles(AFont);

  AFont.Name := SetDefaultFontName(AFont.Name);

  // AFont.Name := StripSpaces(AFont.Name) + stl;

  // Set the Font
  font := PDFDocument.AddFont(AFont.Name,AFont.Style, true);
  tf := SetTextFont(font, AFont, IsUnicodeText);


  // Position Calculations
  PDFDocument.LineYPosition := APosY;
  APosX := SetPosXByAlignment(APosX, X, tw, occ, Alignment);
  APosX := SetPosXByIndent(APosX, Alignment);

  // Underline / StrikeOut
  udl := SetTextLineStyles(R, G, B, APosX, tw, AFont);

  // Make url if neccessairy
  if FUrl <> '' then
  begin
    SetTextUrl(APosX, tw, AFont);
  end;

  tmp := tmp+'BT' + sLineBreak;
  tmp := tmp + '%s %s' +  ' Td' + sLineBreak;
  tmp := tmp + tf + sLineBreak;
  tmp := tmp + R + ' ' + G + ' ' + B + ' rg' + sLineBreak;
  tmp := tmp + '%s Tj'+ sLineBreak;
  tmp := tmp + 'ET' + sLineBreak;

  // Calculate Y with Sub/SuperScript
  PDFDocument.LineYPosition := PDFDocument.LineYPosition - TextRise;

  // Process the text
  tmp := PDFDocument.TextWrap(AText, APosX, PDFDocument.TextWidth, tmp, occ,IsUnicodeText,AFont);

  // Set the Background Color
  if BackgroundColor <> clNone then
    SetTextBackgroundColor(AText, AFont, tw, occ, AposX);

  // Reset Y with Sub/SuperScript
  PDFDocument.LineYPosition := PDFDocument.LineYPosition + TextRise;

  // Store the size for later use
  FFontSize := AFont.Size;

  // X & Y persisting
  if not (AutomaticLineBreak) and (occ <= 1) then
    PDFDocument.LineYPosition := Y
  else
    PDFDocument.LineYPosition := PDFDocument.LineYPosition + VerticalLineSpacing;

  if (fsBold in Afont.Style) OR (fsItalic in Afont.Style) then
  begin
    PDFDocument.LineXPosition := PDFDocument.LineXPosition + Round(GetWidthText(' ', AFont)*0.4);
  end;

  if PDFDocument.LineYPosition > PDFDocument.Height then
  begin
    if AddNewPage then
    begin
      PDFDocument.Pages.Add;
      PDFDocument.CurrentPage.Marges := Marges;
      PDFDocument.DoSetFooter;
      PDFDocument.DoSetHeader;
      PDFDocument.CurrentPage.AddTextLine(tmpX, PDFDocument.LineYPosition + Marges.Top, AText, AFont, Alignment, AutomaticLineBreak, IsUnicodeText);
    end;
  end
  else
  begin
    /// Put it all together
    FContent := FContent + tmp + udl;
  end;

  Result := tmp + udl;
end;

function TPDFPageItem.SetDefaultFontName(AName: string): string;
begin
  AName := StringReplace(AName, 'Bold', '', [rfReplaceAll]);
  AName := StringReplace(AName, 'Italic', '', [rfReplaceAll]);
  AName := StringReplace(AName, 'Oblique', '', [rfReplaceAll]);
  Result := AName;
end;

procedure TPDFPageItem.SetMarges(const Value: TPdfMarges);
begin
  FMarges := Value;
  PDFDocument.LineXPosition := PDFDocument.LineXPosition + FMarges.Left;
end;

procedure TPDFPageItem.SetBulletsInText(AFont: TFont);
var
  font: TFont;
  fn,chr: string;
  Y,X,nd: Integer;
  bs: TPDFBulletStyle;
begin
  if BulletStyle = bsNone then
    Exit;

  nd := Indenting;
  bs := BulletStyle;
  fn := AFont.Name;
  font := PDFDocument.DefaultFont;
  font.Name := 'ArialBold';

  Indenting := 30;
  X := -3;
  Y := 0;

  case BulletStyle of
    bsNone: Indenting := nd;
    bsStar:
    begin
      X := -2;
      Y := PDFDocument.LineYPosition + 2;
      chr := '* ';
    end;
    bsArrow:
    begin
      X := -9;
      Y := PDFDocument.LineYPosition;
      chr := '→  ';
    end;
    bsSquare:
    begin
      Y := PDFDocument.LineYPosition;
      chr := '■  ';
    end;
    bsCheck:
    begin
      Y := PDFDocument.LineYPosition;
      chr := 'ѵ ';
    end;
    bsCircle:
    begin
      Y := PDFDocument.LineYPosition;
      chr := '●  ';
    end;
  end;

  BulletStyle := bsNone;
  AddTextLine(X, Y, chr , font, alLeft, false);
  font.Name := fn;
  AddTextLine(0, PDFDocument.LineYPosition, ' ', font, alLeft, false);
  PDFDocument.LineXPosition := PDFDocument.LineXPosition + 4;
  BulletStyle := bs;
end;

function TPDFPageItem.SetCheckboxInText(X,Y: Integer; AFont: TFont; Checked: Boolean): string;
var
  font: TFont;
  fn,chr: string;
  fs: Integer;
begin
  fn := AFont.Name;
  fs := AFont.Size;
  font := PDFDocument.DefaultFont;
  font.Name := 'Arial';

  Indenting := 0;

  if not Checked then
  begin
    font.Size := 17;
    Y := Y + 1;
    chr := '□ ';
    Result := AddTextLine(X, Y, chr , font, alLeft, false);
  end
  else
  begin
    font.Size := 17;
    Y := Y + 1;
    chr := '□ ';
    Result := AddTextLine(X, Y, chr , font, alLeft, false);
    font.Size := 6;
    Y := Y - 2;
    X := X + 3;
    chr := 'ѵ ';
    Result := Result + AddTextLine(X, Y, chr , font, alLeft, false);
  end;

  font.Name := fn;
  font.Size := fs;
end;

procedure TPDFPageItem.SetTextBackgroundColor(AText: string; AFont: TFont; tw,occ,AposX: Integer);
var
  Color: LongInt;
  R,G,B, tmp: string;
  W, H: Integer;
begin
  tmp := '';

  Color := ColorToRGB(BackgroundColor);
  {$IFDEF DELPHIXE_LVL}
  FormatSettings.DecimalSeparator := '.';
  {$ENDIF}
  {$IFNDEF DELPHIXE_LVL}
  DecimalSeparator := '.';
  {$ENDIF}
  R := Format('%.2f',[GetRValue(Color)/255]);
  G := Format('%.2f',[GetGValue(Color)/255]);
  B := Format('%.2f',[GetBValue(Color)/255]);

  if R + G + B = '1.001.001.00' then
    Exit;

  tmp := tmp + ' ' + R + ' ' + G + ' ' + B + ' rg' + sLineBreak;
  // move the line
  if occ > 1 then
  begin
    W := APosX;
    H := PDFDocument.Height - PDFDocument.LineYPosition + Round(AFont.Size*(occ+1)) ;
  end
  else
  begin
    W := APosX;
    H := PDFDocument.Height - PDFDocument.LineYPosition + Round(AFont.Size * 2.5) ;
  end;

  tmp := tmp + ' ' + IntToStr(W) + ' ' + IntToStr(H) + ' m' + sLineBreak;

  // go right
  if occ > 1 then
  begin
    W := PDFDocument.Width - APosX - Round(Marges.Right*2) - Round(Marges.Left*2);
    H := H;
  end
  else
  begin
    W := APosX + Round(tw * 0.75);
    H := H;
  end;
  tmp := tmp + ' ' + IntToStr(W) + ' ' + IntToStr(H) + ' l' + sLineBreak;

  // go down
  if occ > 1 then
  begin
    W := W;
    H := H - (AFont.Size * (occ+1) ) - 5;
  end
  else
  begin
    W := W;
    H := H - AFont.Size - 5;
  end;
    tmp := tmp + ' ' + IntToStr(W) + ' ' + IntToStr(H) + ' l' + sLineBreak;

  // go left
  W := APosX;
  tmp := tmp + ' ' + IntToStr(W) + ' ' + IntToStr(H) + ' l' + sLineBreak;

  // Fill it
  tmp := tmp + 'f' + sLineBreak + sLineBreak;

  FContent := FContent + tmp;
end;

function TPDFPageItem.SetUnicodeText(IsUnicodeText: Boolean; AText: string): Boolean;
var
  I: Integer;
begin
  if not IsUnicodeText then
  begin
    for I := 1 to Length(AText) do
    begin
      if (Word(AText[I]) > 255) then
        IsUnicodeText := true;
    end;
  end;

  Result := IsUnicodeText;
end;

function TPDFPageItem.SetTextStyles(AFont: TFont): string;
var
  stl: string;
begin
  stl := EmptyStr;

  if fsBold in Afont.Style then
    stl := stl + 'Bold'
  else
    stl := stl + '';

  if fsItalic in Afont.Style then
    stl := stl + 'Italic'
  else
    stl := stl + '';

  Result := stl;
end;

function TPDFPageItem.SetTextLineStyles(R,G,B: string; APosX, tw: Integer; AFont: TFont): string;
var
  udl: string;
begin
  udl := EmptyStr;

  if fsUnderline in AFont.Style then
  begin
    udl := udl + R + ' ' + G + ' ' + B + ' rg' + sLineBreak;
    udl := udl + IntToStr(AposX) + ' ' + IntToStr(PDFDocument.Height - PDFDocument.LineYPosition - 2 + TextRise) + ' m' + sLineBreak;
    udl := udl + IntToStr(AposX + Round(tw*0.75)) + ' ' + IntToStr(PDFDocument.Height - PDFDocument.LineYPosition - 2 + TextRise) + ' l' + sLineBreak;
    udl := udl + 's' + sLineBreak;
  end;

  if fsStrikeOut in AFont.Style then
  begin
    udl := udl + R + ' ' + G + ' ' + B + ' rg' + sLineBreak;
    udl := udl + IntToStr(AposX) + ' ' + IntToStr(PDFDocument.Height - PDFDocument.LineYPosition + TextRise + Round(AFont.Size/4)) + ' m' + sLineBreak;
    udl := udl + IntToStr(AposX + Round(tw*0.75)) + ' ' + IntToStr(PDFDocument.Height - PDFDocument.LineYPosition + TextRise + Round(AFont.Size/4)) + ' l' + sLineBreak;
    udl := udl + 's' + sLineBreak;
  end;

  Result := udl;
end;

procedure TPDFPageItem.SetTextUrl(APosX, tw: Integer; AFont: TFont);
var
  url,L,R,T,B: string;
  RR,GG,BB: string;
  Color: Integer;
begin
  if FUrl = '' then
    Exit;

  {$IFDEF DELPHIXE_LVL}
  FormatSettings.DecimalSeparator := '.';
  {$ENDIF}
  {$IFNDEF DELPHIXE_LVL}
  DecimalSeparator := '.';
  {$ENDIF}

  L := Format('%.2f', [APosX - 2 + 0.00]);
  T := Format('%.2f', [PDFDocument.Height - PDFDocument.LineYPosition - 4 + 0.00]);
  R := Format('%.2f', [APosX + (tw*0.75) + 1.50]);
  B := Format('%.2f', [PDFDocument.Height - PDFDocument.LineYPosition + AFont.Size + 8 + 0.00]);

  Color := ColorToRGB(AFont.Color);
  {$IFDEF DELPHIXE_LVL}
  FormatSettings.DecimalSeparator := '.';
  {$ENDIF}
  {$IFNDEF DELPHIXE_LVL}
  DecimalSeparator := '.';
  {$ENDIF}
  RR := Format('%.2f',[GetRValue(Color)/255]);
  GG := Format('%.2f',[GetGValue(Color)/255]);
  BB := Format('%.2f',[GetBValue(Color)/255]);

  url :=  ' 0 obj' +  sLineBreak +
  '<<' + sLineBreak +
  '/Rect[ ' + L + ' ' + T + ' ' + R + ' ' + B + ']' + sLineBreak +
  '/Subtype' + sLineBreak +
  '/Link' + sLineBreak +
  '/P 3 0 R ' + sLineBreak +
  '/F 4' + sLineBreak +
  '/Rotate 0' + sLineBreak +
  '/BS' + sLineBreak +
  '<<' + sLineBreak +
  '/W 0' + sLineBreak +
  '/S' + sLineBreak +
  '/S' + sLineBreak +
  '>>' + sLineBreak +
  '/C[ ' + RR + ' ' + GG + ' ' + BB + ']' + sLineBreak +
  '/H' + sLineBreak +
  '/N' + sLineBreak +
  '/A ' + sLineBreak +
  '<</Type/Action/S/URI/URI(' + FUrl + ')>>' + sLineBreak +
  '>>' + sLineBreak +
  'endobj' +  sLineBreak ;

  PDFDocument.Annotations.Add(url);
  PDFDocument.ObjectCount := PDFDocument.ObjectCount + 1;
end;

function TPDFPageItem.SetTextFont(font: TpdfFont; AFont: TFont; IsUnicodeText: Boolean): string;
var
  tf, FontName: string;
begin
  tf := EmptyStr;

  if IsUnicodeText then
    FontName := 'FU'+font.Alias
  else
    FontName := 'F'+font.Alias;

  // Correcting Text adjustments
  if AFont.Name <> '' then
    tf := '/' + FontName
  else
    tf := '/F1';

  if AFont.Size <> FONTSIZE then
    tf := tf + ' ' + IntToStr(AFont.Size) + ' Tf'
  else
    tf := tf + ' ' + IntToStr(FONTSIZE) + ' Tf';

  Result := tf;
end;

function TPDFPageItem.SetPosXByAlignment(APosX,X,tw,occ: Integer; Alignment: TPDFALIGNMENT): Integer;
begin
  case Alignment of
    alRight:
    begin
      if occ > 1 then
      begin
        APosX := PDFDocument.Width - APosX - Round((tw*0.8)/occ) - Marges.Right;
      end
      else
      begin
        APosX := PDFDocument.Width  -  X - Round(tw) - Marges.Right;
      end;
    end;
    alCenter:
    begin
      if occ > 1 then
      begin
        APosX := Round((PDFDocument.Width - APosX - Round((tw/occ)*0.8)) / 2);
      end
      else
      begin
        APosX := Round((PDFDocument.Width  -  X - Round(tw*0.8)) / 2 );
      end;
    end;
  end;

  Result := APosX;
end;

function TPDFPageItem.SetPosXByIndent(APosX: Integer; Alignment: TPDFALIGNMENT): Integer;
begin
  case Alignment of
    alLeft:
      APosX := APosX + Indenting;
    alRight:
      APosX := APosX - Indenting - 15;
    alCenter:
      APosX := APosX + Indenting;
  end;

  Result := APosX;
end;

function TPDFPageItem.FindOrAddUsedWideChar(aWideChar: WideChar): Integer;
begin
  result := ord(aWideChar);
  if result<0 then begin
    result := -(result+1); // this WideChar was already existing -> return index
    exit;
  end;
end;

const
  HexChars: array[0..15] of AnsiChar = '0123456789ABCDEF';

function TPDFPageItem.GetWidthText(const AText: String; AFont: TFont) : Integer;
var
  LBmp: TBitmap;
begin
  LBmp := TBitmap.Create;
  try
   LBmp.Canvas.Font := AFont;
   Result := LBmp.Canvas.TextWidth(AText);
  finally
    LBmp.Free;
  end;
end;

function TPDFPageItem.HtmlToColor(s: string; aDefault: TColor): TColor;
begin
  if Copy(s, 1, 1) = '#' then
  begin
    s := '$' + Copy(s, 6, 2) + Copy(s, 4, 2) + Copy(s, 2, 2);
  end
  else
    s := 'clNone';
  try
    Result := StringToColor(s);
  except
    Result := aDefault;
  end;
end;

function TPDFPageItem.HtmlToPdf(s: string; Cell: TPDFTableRowCellItem): string;
var
  su: string;
  FoundTag: Boolean;
begin
  if Pos('&',s) > 0 then
  begin
    repeat
      Foundtag := False;

      if TagReplacestring('&amp;','&&',s) then Foundtag := True;
      if TagReplacestring('&quot;','"',s) then Foundtag := True;

      if TagReplacestring('&sect;','§',s) then Foundtag := True;
      if TagReplacestring('&permil;','®‰',s) then Foundtag := True;
      if TagReplacestring('&reg;','®',s) then Foundtag := True;

      if TagReplacestring('&copy;','©',s) then Foundtag := True;
      if TagReplacestring('&para;','¶',s) then Foundtag := True;

      if TagReplacestring('&trade;','™',s) then Foundtag := True;
      if TagReplacestring('&euro;','€',s) then Foundtag := True;

    until not Foundtag;
  end;

  su := '';
  while Length(s) > 0 do
  begin
    su := su + ConvertHTMLLine(s,True, Cell);
  end;

  Result := su;
end;

function TPDFPageItem.ConvertHTMLLine(var s: string; Calc: Boolean; Cell: TPDFTableRowCellItem): string;
var
  su,Res,TagProp,Prop,Tagp,LineText: string;
  cr: TRect;
  linebreak,imgbreak: Boolean;
  TagPos,SpacePos: Integer;
  WordLen: Integer;
  TagChar: Char;
  LengthFits: Boolean;
  Anchor: Boolean;
  LastAnchor, AnchorText: string;
  IMGSize: TPoint;
  isSup,isSub,isImg: Boolean;
  subh,suph,imgali: Integer;
  ListIndex: Integer;
  Invisible: Boolean;
  FrstBullet: Boolean;
  Pic: TPicture;
  DefFont: TFont;
  html: THTMLRef;
  bmp: TBitmap;
begin
  Anchor := False;
  FrstBullet := False;
  Invisible := False;
  ListIndex := 0;
  suph := 0;
  subh := 0;
  imgali := 0;
  isSup := False;
  isSub := False;
  SpacePos := 0;

  Result := '';
  LineText := '';

  linebreak := false;
  imgbreak := false;
  res := '';

  DefFont := TFont.Create;
  DefFont.Assign(Cell.TextFont);
  DefFont.Color := clBlack;
  DefFont.Size := 8;
  DefFont.Style := [];
  DefFont.Name := Cell.TextFont.Name;

  html.BGColor := clNone;
  while (length(s) > 0) and not linebreak and not imgbreak do
  begin
    isImg := False;
    html.HasImage := False;
    // get next word or till next HTML tag
    TagPos := Pos('<', s);

    if (TagPos > 0) and ((SpacePos > TagPos) or (SpacePos = 0)) then
    begin
      su := Copy(s, 1, TagPos - 1);
    end
    else
    begin
      if SpacePos > 0 then
        su := Copy(s, 1, SpacePos)
      else
        su := s;
    end;

    WordLen := length(su);

    while Pos('&nbsp;', su) > 0 do
    begin
      TagReplaceString('&nbsp;', ' ', su);
    end;

    while Pos('&lt;', su) > 0 do
    begin
      TagReplaceString('&lt;', '<', su);
    end;

    while Pos('&gt;', su) > 0 do
    begin
      TagReplaceString('&gt;', '>', su);
    end;

    if WordLen > 0 then
    begin
      if Invisible then
        Delete(s, 1, WordLen);

      if not Invisible then
      begin
        // draw mode
        if not Calc then
        begin
          if isSup then
            cr.Bottom := cr.Bottom - suph;
          if isSub then
            cr.Bottom := cr.Bottom + subh;

          cr.Bottom := cr.Bottom - imgali;

        end
        else
        begin
          html.IsUrl := Anchor;
          html.Text := su;
          html.FontName := Cell.TextFont.Name;
          html.Size := Cell.TextFont.Size;
          html.HasImage := isImg;

          if Anchor then
          begin
            AnchorText := su;
            html.Color := Cell.UrlColor;
            html.Url := LastAnchor;
          end;

          if (html.Text <> '') or (html.HasImage) then
            Cell.HTML.Add(html);
        end;

        LengthFits := True;
        LineText := LineText + su;

        if LengthFits then
        begin
          res := res + Copy(s, 1, WordLen);
          if not LengthFits and Calc and (LineText <> su) then
            s := '';
          Delete(s, 1, WordLen);
          if length(su) >= WordLen then
          begin
          end
        end
        else
        begin
          linebreak := True;
        end;
      end;
    end;

    TagPos := Pos('<', s);

    if (TagPos = 1) and (length(s) <= 2) then
      s := '';

    if not linebreak and (TagPos = 1) and (length(s) > 2) then
    begin
      if (s[2] = '/') and (length(s) > 3) then
      begin
        case UpCase(s[3]) of
          'A':
            begin
              if Anchor then
              begin
                PDFDocument.CurrentPage.Url := LastAnchor;
                Cell.Text := AnchorText;
                html.Color:= DefFont.Color;

                Anchor := false;
              end;
            end;
          'B':
            begin
              html.FontStyle := html.FontStyle - [fsBold];
            end;
          'S':
            begin
              TagChar := UpCase(s[4]);

              if (TagChar = 'U') then
              begin
                isSup := false;
                isSub := false;
              end;
              html.FontStyle := html.FontStyle + [fsStrikeout];
            end;
          'F':
            begin
              html.FontName := Cell.TextFont.Name;
              html.FontStyle := Cell.TextFont.Style;
              html.Size := Cell.TextFont.Size;
              html.Color := Cell.TextFont.Color;
            end;
          'I':
            begin
              html.FontStyle := html.FontStyle + [fsItalic];
            end;
          'L':
            begin
              linebreak := True;
              PDFDocument.CurrentPage.AddNewLine;
            end;
          'P':
            begin
              linebreak := True;
            end;
          'U':
            begin
              if (s[4] <> '>') and (ListIndex > 0) then
              begin
                FrstBullet := false;
              end
              else
                html.FontStyle := html.FontStyle - [fsUnderline];
            end;
          'R':
            begin

            end;
          'Z':
            Invisible := false;
        end;
      end
      else
      begin
        case UpCase(s[2]) of
          'A':
            begin
              TagProp := Uppercase(Copy(s, 3, Pos('>', s) - 1));
              // <A href="anchor">

              if (VarPos('HREF', TagProp, TagPos) > 0) then
              begin
                TagProp := Copy(s, 3, Pos('>', s) - 1);
                // restore case ie: without upppercase
                Prop := Copy(TagProp, TagPos + 4, length(TagProp));
                Prop := Copy(Prop, Pos('"', Prop) + 1, length(Prop));
                Prop := Copy(Prop, 1, Pos('"', Prop) - 1);
                LastAnchor := Prop;
                Anchor := True;
              end;
            end;
          'B':
            begin
              TagChar := UpCase(s[3]);
              if TagChar = '>' then // <B> tag
              begin
                html.FontStyle := html.FontStyle + [fsBold];
              end
              else if TagChar = 'R' then // <BR> tag
              begin
                linebreak := True;
                PDFDocument.CurrentPage.AddNewLine;
              end
              else
              begin
                if TagChar = 'L' then // <BLINK> tag
                begin
                  // Skip
                end
                else if TagChar = 'O' then // <BODY ... >
                begin
                  res := res + Copy(s, 1, Pos('>', s));
                  TagProp := Uppercase(Copy(s, 6, Pos('>', s) - 1));

                  if (Pos('BACKGROUND', TagProp) > 0) and not Calc then
                  begin
                    Prop := Copy(TagProp, Pos('BACKGROUND', TagProp) + 10,
                      length(TagProp));
                    Prop := Copy(Prop, Pos('"', Prop) + 1, length(Prop));
                    Prop := Copy(Prop, 1, Pos('"', Prop) - 1);
                    if (Pos('://', Prop) > 0) then
                    begin
                    end;
                  end; // end of background

                  if (Pos('BGCOLOR', TagProp) > 0) then
                  begin
                    Prop := Copy(TagProp, Pos('BGCOLOR', TagProp) + 7,
                      length(TagProp));
                    Prop := Copy(Prop, Pos('"', Prop) + 1, length(Prop));
                    Prop := Copy(Prop, 1, Pos('"', Prop) - 1);
                    if not Calc then
                    begin
                      if Pos('CL', Prop) > 0 then;
                      if Pos('#', Prop) > 0 then;
                    end;
                  end;
                end;
              end;
            end;
          'H':
            begin
              case UpCase(s[3]) of
                'R':
                  begin
                    linebreak := True;
                  end;
              end;
            end;
          'I':
            begin
              TagChar := UpCase(s[3]);

              if TagChar = '>' then // <I> tag
                 html.FontStyle := html.FontStyle + [fsItalic]
              else
              if TagChar = 'N' then // <IND> tag
              begin
                TagProp := Copy(s, 3, Pos('>', s) - 1);

                Prop := Copy(TagProp, IPos('x', TagProp) + 2, length(TagProp));
                Prop := Copy(Prop, Pos('"', Prop) + 1, length(Prop));
                Prop := Copy(Prop, 1, Pos('"', Prop) - 1);
              end
              else if TagChar = 'M' then
              begin
                TagProp := Uppercase(Copy(s, 3, Pos('>', s) - 1));
                Prop := Copy(TagProp, Pos('SRC', TagProp) + 4, length(TagProp));
                Prop := Copy(Prop, Pos('"', Prop) + 1, length(Prop));
                Prop := Copy(Prop, 1, Pos('"', Prop) - 1);

                if Pos('WIDTH', TagProp) > 0 then
                begin
                  Tagp := Copy(TagProp, Pos('WIDTH', TagProp) + 6,
                    length(TagProp));
                  Tagp := Copy(Tagp, Pos('"', Tagp) + 1, length(Tagp));
                  Tagp := Copy(Tagp, 1, Pos('"', Tagp) - 1);
                end;

                if Pos('HEIGHT', TagProp) > 0 then
                begin
                  Tagp := Copy(TagProp, IPos('HEIGHT', TagProp) + 7,
                    length(TagProp));
                  Tagp := Copy(Tagp, Pos('"', Tagp) + 1, length(Tagp));
                  Tagp := Copy(Tagp, 1, Pos('"', Tagp) - 1);
                end;

                IMGSize.X := 0;
                IMGSize.Y := 0;

                if not (Pos('http', Prop) > 0) and not (Pos('https', Prop) > 0) then
                begin
                  if Assigned(Cell.Bitmaps)
                  then
                  begin
                    Pic := TPicture.Create;
                    try
                      html.HasImage:= False;

                      OutputDebugString(PWideChar('rootpath: ' +PDFDocument.RootPath));

                      // replace / with \
                      Prop := StringReplace(Prop, '/', '\', [rfReplaceAll]);

                      if FileExists( PDFDocument.RootPath + 'wwwroot' + prop) then
                        pic.LoadFromFile(PDFDocument.RootPath + 'wwwroot' + prop);

                      if Assigned(pic.Graphic) and not pic.Graphic.Empty then
                      begin
                        bmp := TBitmap.Create;
                        bmp.Width := pic.Graphic.Width;
                        bmp.Height := pic.Graphic.Height;
                        bmp.Canvas.Draw(0,0, pic.Graphic);
                        bmp.Transparent := true;
                        Cell.Bitmaps.Add(bmp);
                        Cell.ImageHAlign := haLeft;
                        Cell.ImageVAlign := vaTop;
                        html.HasImage:= true;
                        html.Text := '';

                        html.FontName := Cell.TextFont.Name;
                        html.FontStyle := Cell.TextFont.Style;
                        html.Size := Cell.TextFont.Size;
                        html.Color := Cell.TextFont.Color;

                        cell.HTML.Add(html);
                      end;
                    finally
                      Pic.Free;
                    end;
                  end;
                end;
              end;
            end;
          'L':
            begin
              if not FrstBullet then
                PDFDocument.CurrentPage.AddNewLine
              else
                FrstBullet := false;
            end;
          'U':
            begin
              if s[3] <> '>' then
              begin
                Inc(ListIndex);
                linebreak := True;
                FrstBullet := True;
              end
              else
                html.FontStyle := html.FontStyle + [fsUnderline];
            end;
          'P':
            begin
              if (VarPos('>', s, TagPos) > 0) then
              begin
                TagProp := Uppercase(Copy(s, 3, TagPos - 1));

                if VarPos('ALIGN', TagProp, TagPos) > 0 then
                begin
                  Prop := Copy(TagProp, TagPos + 5, length(TagProp));
                  Prop := Copy(Prop, Pos('"', Prop) + 1, length(Prop));
                  Prop := Copy(Prop, 1, Pos('"', Prop) - 1);
                end;

                if VarPos('INDENT', TagProp, TagPos) > 0 then
                begin
                  Prop := Copy(TagProp, TagPos + 6, length(TagProp));
                  Prop := Copy(Prop, Pos('"', Prop) + 1, length(Prop));
                  Prop := Copy(Prop, 1, Pos('"', Prop) - 1);
                end;
                if VarPos('BGCOLOR', TagProp, TagPos) > 0 then
                begin
                  Prop := Copy(TagProp, TagPos + 5, length(TagProp));
                  Prop := Copy(Prop, Pos('"', Prop) + 1, length(Prop));
                  Prop := Copy(Prop, 1, Pos('"', Prop) - 1);

                  html.BGColor := HtmlToColor(Prop, clNone);
                end;
              end;
            end;
          'F':
            begin
              if (VarPos('>', s, TagPos) > 0) then
              begin
                TagProp := Uppercase(Copy(s, 6, TagPos - 6));

                if (VarPos('FACE', TagProp, TagPos) > 0) then
                begin
                  Prop := Copy(TagProp, TagPos + 4, length(TagProp));
                  Prop := Copy(Prop, Pos('"', Prop) + 1, length(Prop));
                  Prop := Copy(Prop, 1, Pos('"', Prop) - 1);
                  html.FontName := Prop;
                end;

                if (VarPos(' COLOR', TagProp, TagPos) > 0) then
                begin
                  Prop := Copy(TagProp, TagPos + 6, length(TagProp));
                  Prop := Copy(Prop, Pos('"', Prop) + 1, length(Prop));
                  Prop := Copy(Prop, 1, Pos('"', Prop) - 1);

                  if length(Prop) > 0 then
                  begin
                    if Prop[1] = '#' then
                      Cell.TextFont.Color := Hex2Color(Prop)
                    else
                      html.Color := Text2Color(AnsiLowerCase(Prop));
                  end;

                end;

                if (VarPos('BGCOLOR', TagProp, TagPos) > 0) and not Calc
                then
                begin
                  Prop := Copy(TagProp, TagPos + 7, length(TagProp));
                  Prop := Copy(Prop, Pos('"', Prop) + 1, length(Prop));
                  Prop := Copy(Prop, 1, Pos('"', Prop) - 1);
                end;

                if (VarPos('SIZE', TagProp, TagPos) > 0) then
                begin
                  Prop := Copy(TagProp, TagPos + 4, length(TagProp));
                  Prop := Copy(Prop, Pos('=', Prop) + 1, length(Prop));
                  Prop := Copy(Prop, Pos('"', Prop) + 1, length(Prop));

                  case IStrToInt(Prop) of
                    1:
                      html.Size := (8 * 2);
                    2:
                      html.Size := (10 * 2);
                    3:
                      html.Size := (12 * 2);
                    4:
                      html.Size := (14 * 2);
                    5:
                      html.Size := (16 * 2);
                  else
                    html.Size := (IStrToInt(Prop) * 2);
                  end;
                end;
              end;
            end;
          'S':
            begin
              TagChar := UpCase(s[3]);

              if TagChar = '>' then
                html.FontStyle := html.FontStyle + [fsStrikeout]
              else
              begin
                if TagChar <> 'H' then
                begin
                  if IPos('<SUB>', s) = 1 then
                    isSub := True
                  else if IPos('<SUP>', s) = 1 then
                    isSup := True;
                end;
              end;
            end;
          'R':
            begin
              // Skip
            end;
          'Z':
            Invisible := True;
        end;
      end;
      if (VarPos('>', s, TagPos) > 0) and not imgbreak then
      begin
        res := res + Copy(s, 1, TagPos);
        Delete(s, 1, TagPos);
      end
      else
      begin
        if not imgbreak then
          Delete(s, 1, length(s));
      end;
    end;
  end;

  Result := res;
  DefFont.Free;
end;

function TPDFPageItem.IStrToInt(s: string): Integer;
var
  Err,Res: Integer;
begin
  Val(s,Res,Err);
  Result := Res;
end;

function TPDFPageItem.Text2Color(s: string):tcolor;
begin
  Result := clBlack;

  if (s = 'clred') then Result := clred else
  if (s = 'clblack') then Result := clblack else
  if (s = 'clblue') then Result := clblue else
  if (s = 'clgreen') then Result := clgreen else
  if (s = 'claqua') then Result := claqua else
  if (s = 'clyellow') then Result := clyellow else
  if (s = 'clfuchsia') then Result := clfuchsia else
  if (s = 'clwhite') then Result := clwhite else
  if (s = 'cllime') then Result := cllime else
  if (s = 'clsilver') then Result := clsilver else
  if (s = 'clgray') then Result := clgray else
  if (s = 'clolive') then Result := clolive else
  if (s = 'clnavy') then Result := clnavy else
  if (s = 'clpurple') then Result := clpurple else
  if (s = 'clteal') then Result := clteal else
  if (s = 'clmaroon') then Result := clmaroon;

  if Result <> clBlack then Exit;

  if (s = 'clbackground') then Result := clbackground else
  if (s = 'clactivecaption') then Result := clactivecaption else
  if (s = 'clinactivecaption') then Result := clinactivecaption else
  if (s = 'clmenu') then Result := clmenu else
  if (s = 'clwindow') then Result := clwindow else
  if (s = 'clwindowframe') then Result := clwindowframe else
  if (s = 'clmenutext') then Result := clmenutext else
  if (s = 'clwindowtext') then Result := clwindowtext else
  if (s = 'clcaptiontext') then Result := clcaptiontext else
  if (s = 'clactiveborder') then Result := clactiveborder else
  if (s = 'clinactiveborder') then Result := clinactiveborder else
  if (s = 'clappworkspace') then Result := clappworkspace else
  if (s = 'clhighlight') then Result := clhighlight else
  if (s = 'clhighlighttext') then Result := clhighlighttext else
  if (s = 'clbtnface') then Result := clbtnface else
  if (s = 'clbtnshadow') then Result := clbtnshadow else
  if (s = 'clgraytext') then Result := clgraytext else
  if (s = 'clbtntext') then Result := clbtntext else
  if (s = 'clinactivecaptiontext') then Result := clinactivecaptiontext else
  if (s = 'clbtnhighlight') then Result := clbtnhighlight else
  if (s = 'cl3ddkshadow') then Result := clgraytext else
  if (s = 'cl3dlight') then Result := cl3dlight else
  if (s = 'clinfotext') then Result := clinfotext else
  if (s = 'clinfobk') then Result := clinfobk;
end;

function TPDFPageItem.FitText(AText: string; AFont: TFont; AWidth, AHeight: Integer): string;
var
  TW, TH, W, H: Integer;
  TL: Integer;
  R: Single;

begin
    AText := StringReplace(AText, sLineBreak, '', [rfReplaceAll]);
    TW := GetWidthText(AText, AFont);
    TH := AFont.Size;
    W := AWidth;
    H := AHeight;

    if (Ceil(TW/W) * TH) > H then
    begin
      /// To Big!
      TL := Length(AText);
      R := Floor(H / TH);
      W := Floor((W * R)*0.72);
      Result := Copy(AText, 0, Ceil(TL * (W/TW)));
      Result := WrapText(Result, AWidth);
    end
    else
    begin
      Result := AText;
    end;
end;

function TPDFPageItem.HexVal(s: string): Integer;
var
  i,j: Integer;
begin
  if Length(s) < 2 then
  begin
    Result := 0;
    Exit;
  end;

  if s[1] >= 'A' then
    i := ord(s[1]) - ord('A') + 10
  else
    i := ord(s[1]) - ord('0');

  if s[2] >= 'A' then
    j := ord(s[2]) - ord('A') + 10
  else
    j := ord(s[2]) - ord('0');

  Result := i shl 4 + j;
end;

function TPDFPageItem.Hex2Color(s: string): TColor;
var
  r,g,b: Integer;
begin
  r := Hexval(Copy(s,2,2));
  g := Hexval(Copy(s,4,2)) shl 8;
  b := Hexval(Copy(s,6,2)) shl 16;
  Result := TColor(b + g + r);
end;

function TPDFPageItem.VarPos(su,s: string;var Res: Integer): Integer;
begin
  Res := Pos(su,s);
  Result := Res;
end;

function TPDFPageItem.IPos(su,s: string): Integer;
begin
  Result := Pos(UpperCase(su),UpperCase(s));
end;

function TPDFPageItem.TagReplaceString(const Srch,Repl: string;var Dest: string): Boolean;
var
  i: Integer;
begin
  i := IPos(srch,dest);
  if i > 0 then
  begin
    Result := True;
    Delete(Dest,i,Length(Srch));
    Dest := Copy(Dest,1,i-1) + Repl + Copy(Dest,i,Length(Dest));
  end
  else
    Result := False;
end;

constructor TPDFPageItem.Create(Collection: TCollection);
var
  i: Integer;
  A256: array[0..256] of AnsiChar;
  U256: array[0..256] of WideChar;
  M: TPdfMarges;
begin
  inherited;

  M.Top := 15;
  M.Left := 15;
  M.Right := 15;
  M.Bottom := 15;

  FTextRise := 0;
  FContent := ' ';
  FFontSize:= PDFDocument.DefaultFont.Size;
  PDFDocument.SetTextWidth(500);
  BulletStyle := bsNone;
  FBgColor := clNone;
  FIsUrl := False;
  FUrl := '';
  FVLineSpacing := 0;

  PDFDocument.LineYPosition := 20;

  SetLength(fAnsiToWide,256);
  for i := 0 to 255 do
    A256[i] := AnsiChar(i);

  AnsiBufferToUnicode(U256,A256,256);
  move(U256,fAnsiToWide[0],256*2);

  SetLength(fWideToAnsi,65536);
  fillchar(fWideToAnsi[1],65535,ord('?'));
  for i := 1 to 255 do
    if fAnsiToWide[i]<>0 then
      fWideToAnsi[fAnsiToWide[i]] := i;

  FShadingCount := 0;

  FTableItems := TPDFTableItems.Create(Self);
  FImagesList := TList<TImageRef>.Create;
  FShadingList := TList<TGradientPatern>.Create;

end;

function TPDFPageItem.AnsiBufferToUnicode(Dest: PWideChar; Source: PAnsiChar; SourceChars: Cardinal): PWideChar;
var
  c: cardinal;
begin
  // first handle trailing 7 bit ASCII chars, by quad (Sha optimization)
  if SourceChars >= 4 then
  repeat
    c := pCardinal(Source)^;
    if c and $80808080 <> 0 then
      break; // break on first non ASCII quad
    dec(SourceChars,4);
    inc(Source,4);
    pCardinal(Dest)^ := (c shl 8 or (c and $FF)) and $00ff00ff;
    c := c shr 16;
    pCardinal(Dest+2)^ := (c shl 8 or c) and $00ff00ff;
    inc(Dest,4);
  until SourceChars < 4;

  if (SourceChars>0) and (ord(Source^)<128) then
  repeat
    dec(SourceChars);
    Dest^ := WideChar(ord(Source^));
    inc(Source);
    inc(Dest);
  until (SourceChars=0) or (ord(Source^)>=128);

  // rely on the Operating System for all remaining ASCII characters
  if SourceChars = 0 then
    result := Dest
  else
  begin
    {$ifdef ISDELPHIXE} // use cross-platform wrapper for MultiByteToWideChar()
    Result := Dest+UnicodeFromLocaleChars(
      PDFDocument.Pages.Count,MB_PRECOMPOSED,Source,SourceChars,Dest,SourceChars);
    {$else}
    Result := Dest+MultiByteToWideChar(
      PDFDocument.Pages.Count,MB_PRECOMPOSED,Source,SourceChars,Dest,SourceChars);
    {$endif}
  end;

  Result^ := #0;
end;

destructor TPDFPageItem.Destroy;
begin
  FTableItems.Free;
  FImagesList.Free;
  FShadingList.Free;
  inherited;
end;

procedure TPDFPageItem.DrawRectangle( APosX,APosY,APosYEnd,AWidth: Integer; ABorderColor,ABackgroundColor: TColor; APageIndex: Integer; NoBorder: Boolean = False );
var
  P: TPDFPageItem;
  C: string;
  Color : LongInt;
  R, G, B : string;
begin
  APosY := PDFDocument.Height - APosY;
  AposYEnd := PDFDocument.Height - AposYEnd;

  P := PDFDocument.Pages[APageIndex];
  C := P.Content;

  // Draw the background
  Color := ColorToRGB(ABackgroundColor);
  {$IFDEF DELPHIXE_LVL}
  FormatSettings.DecimalSeparator := '.';
  {$ENDIF}
  {$IFNDEF DELPHIXE_LVL}
  DecimalSeparator := '.';
  {$ENDIF}
  R := Format('%.2f',[GetRValue(Color)/255]);
  G := Format('%.2f',[GetGValue(Color)/255]);
  B := Format('%.2f',[GetBValue(Color)/255]);

  C := C + '' +
  R + ' ' + G + ' ' + B + ' rg' + sLineBreak +
  IntToStr(APosX) + ' ' + IntToStr(APosY) + ' m' + sLineBreak +
  IntToStr(APosX) + ' ' + IntToStr(APosYEnd) + ' l' + sLineBreak +
  IntToStr(APosX + AWidth) + ' ' + IntToStr(APosYEnd) + ' l' + sLineBreak +
  IntToStr(APosX + AWidth) + ' ' + IntToStr(APosY) + ' l' + sLineBreak +
  'f' + sLineBreak;

  // Draw the border
  Color := ColorToRGB(ABorderColor);
  {$IFDEF DELPHIXE_LVL}
  FormatSettings.DecimalSeparator := '.';
  {$ENDIF}
  {$IFNDEF DELPHIXE_LVL}
  DecimalSeparator := '.';
  {$ENDIF}
  R := Format('%.2f',[GetRValue(Color)/255]);
  G := Format('%.2f',[GetGValue(Color)/255]);
  B := Format('%.2f',[GetBValue(Color)/255]);

  if not NoBorder then
  begin
    C := C + '' +
    R + ' ' + G + ' ' + B + ' rg' + sLineBreak +
    IntToStr(APosX) + ' ' + IntToStr(APosY) + ' m' + sLineBreak +
    IntToStr(APosX) + ' ' + IntToStr(APosYEnd) + ' l' + sLineBreak +
    'f' + sLineBreak +

    IntToStr(APosX) + ' ' + IntToStr(APosYEnd) + ' m' + sLineBreak +
    IntToStr(APosX + AWidth) + ' ' + IntToStr(APosYEnd) + ' l' + sLineBreak +
    'f' + sLineBreak +

    IntToStr(APosX + AWidth) + ' ' + IntToStr(APosYEnd) + ' m' + sLineBreak +
    IntToStr(APosX + AWidth) + ' ' + IntToStr(APosY) + ' l' + sLineBreak +
    ' f' + sLineBreak +

    IntToStr(APosX + AWidth) + ' ' + IntToStr(APosY) + ' m' + sLineBreak +
    IntToStr(APosX) + ' ' + IntToStr(APosY) + ' l' + sLineBreak +
    'f' + sLineBreak;
  end;

  P.Content := C;
end;

function TPDFPageItem.PDFDocument: TPDFDocument;
begin
  Result := (Collection as TPDFPageItems).Owner as TPDFDocument;
end;

procedure TPDFPageItem.SetTableItems(const Value: TPDFTableItems);
begin
  FTableItems := Value;
end;

//------------------------------------------------------------------------------

{ TPDFTableItems }

function TPDFTableItems.Add: TPDFTableItem;
begin
  Result := TPDFTableItem(inherited Add);
end;

constructor TPDFTableItems.Create(AOwner: TPDFPageItem);
begin
  inherited Create(AOwner,TPDFTableItem);
end;

destructor TPDFTableItems.Destroy;
begin
  inherited;
end;

function TPDFTableItems.GetItem(Index: Integer): TPDFTableItem;
begin
  Result := TPDFTableItem(inherited Items[Index]);
end;

function TPDFTableItems.Insert(Index: Integer): TPDFTableItem;
begin
  Result := TPDFTableItem(inherited Insert(Index));
end;

procedure TPDFTableItems.SetItem(Index: Integer; const Value: TPDFTableItem);
begin
  inherited Items[Index] := Value;
end;

//------------------------------------------------------------------------------

{ TPDFTableItem }

constructor TPDFTableItem.Create(Collection: TCollection);
begin
  inherited;
  FColor := clBlack;
  FColumns := TPDFTableColumnItems.Create(Self);
  FRows := TPDFTableRowItems.Create(Self);
  FX := 0;
  FY := 0;
  FWidth := 150;
end;

destructor TPDFTableItem.Destroy;
begin
  FColumns.Free;
  FRows.Free;
  inherited;
end;

procedure TPDFTableItem.DrawFixedTable;
var
  Cell: TPDFTableRowCellItem;
  C, BG, Tmp, LTemp, Cb, Shading: string;
  CL: LongInt;
  samePage: Boolean;
  R,RR,G,GG,B,BB,BGR,BGG,BGB,SBGG1, SBGR1, SBGB1, SBGG2, SBGR2, SBGB2: string;
  shadeText: string;
  I, II, TII, J, JJ, TJJ, Imgs, PosX, PosY, LY, D, H, DW, DH, OCC, LM: Integer;
  alX,alY,textw, mcw, mch, temp: Integer;
  imgX, imgY: Integer;
  tempfont: TFont;
  pg: TPDFPageItem;
  Rws,Cls: TList<Integer>;
  RCount,CCount: Integer;
  Tw,TH: Integer;
  HReps,VReps: Integer;
  M,Mtemp: TPdfMarges;
  P: TPDFPageItem;
  Pt: TPoint;
  counter: Integer;
  jpg: TJPegImage;
  ms: TMemoryStream;
  ir: TImageRef;
  bmp: TBitmap;
  Shade: TGradientPatern;
  cc,rc,tot: Integer;
  html, html2: THTMLRef;
begin
  P := PDFPage.PDFDocument.CurrentPage;

  C := P.Content;

  /// Text Color
  CL := ColorToRGB(FColor);
  {$IFDEF DELPHIXE_LVL}
  FormatSettings.DecimalSeparator := '.';
  {$ENDIF}
  {$IFNDEF DELPHIXE_LVL}
  DecimalSeparator := '.';
  {$ENDIF}
  R := Format('%.2f',[GetRValue(CL)/255]);
  G := Format('%.2f',[GetGValue(CL)/255]);
  B := Format('%.2f',[GetBValue(CL)/255]);

  PosX := X;
  PosY := Y;

  DW := P.PDFDocument.Width;
  DH := P.PDFDocument.Height;
  LM := P.Marges.Left;

  Rws := TList<Integer>.Create;
  Cls := TList<Integer>.Create;

  shadeText := '';

  alX := 0;
  alY := 0;
  Mtemp := P.Marges;
  MTemp.Top := 0;

  {$REGION 'TABLE CALCULATIONS'}
  /// Calculate full table width
  Tw := 0;
  for I := 0 to Columns.Count - 1 do
  begin
    Tw := Tw + Columns[I].Width;
  end;

  /// Calculate Horizontal page repetitions
  HReps := DW - P.Marges.Left - P.Marges.Right;
  if TW > HReps then
    HReps := Ceil(Tw / (HReps))
  else
    HReps := 1;

  /// Set the Horizontal values
  for I := 0 to Hreps - 1 do
  begin
      Cls.Add(Round(((Columns.Count/Hreps) * (I+1))));
  end;

  /// Calculate full table height
  Th := 0;
  for I := 0 to Rows.Count - 1 do
  begin
    Th := Th + Rows[I].Height;
  end;

  /// Calculate Vertical page repetitions
  VReps := Ceil(Th / (DH - P.Marges.Top - P.Marges.Bottom));

  /// Set the Vertical values
  for I := 0 to VReps - 1 do
  begin
    Rws.Add(Round(((Rows.Count/Vreps) * (I+1))));
  end;
  {$ENDREGION}

  cc := 0;
  tw := 0;
  tot := 0;
  HReps := 0;
  Cls.Clear;
  for I := 0 to Columns.Count - 1 do
  begin
    Tw := Tw + Columns[I].Width;

    if Tw > P.PDFDocument.Width - P.Marges.Left - P.Marges.Right then
    begin
      if Cls.Count > 0 then
        Cls.Add(Cls[Cls.Count - 1] + cc)
      else
        Cls.Add(cc);
      tot := tot + cc;
      cc := 0;
      Tw := 0;
      Inc(HReps);
    end;
    Inc(cc);
  end;
  /// Add remaining columns
  Cls.Add(Columns.Count );
  Inc(Hreps);

  rc := 0;
  th := 0;
  tot := 0;
  VReps := 0;
  Rws.Clear;
  for I := 0 to Rows.Count - 1 do
  begin
    Th := Th + Rows[I].Height;

    if I+1 <= Rows.Count - 1 then
    begin
      if Th + Rows[i].Height > P.PDFDocument.Height - P.Marges.Bottom then
      begin
        if Rws.Count > 0 then
          Rws.Add(Rws[Rws.Count - 1] + rc)
        else
          Rws.Add(rc);
        tot := tot + rc;
        rc := 0;
        Th := 0;
        Inc(VReps);
      end;
    end;
    Inc(rc);
  end;

  // Add remaining rows
  Rws.Add(Rows.Count );
  Inc(VReps);

  // loop loop loop loop
  for J := 0 to VReps - 1 do
  begin
    for I := 0 to HReps - 1 do
    begin
      if (J = 0) and (I = 0) then
      begin
        TII := 0;
        TJJ := 0;
      end
      else
      begin
        if I <> 0 then TII := Cls[I-1] else TII := 0;;
        if J <> 0 then TJJ := Rws[J-1] else TJJ := 0;
      end;

      for JJ := TJJ to Rws[J] - 1 do
      begin
      {$REGION 'Rows'}
        for II := TII to Cls[I] - 1 do
        begin
        {$REGION 'Cols'}
          tempfont := TFont.Create;
          tempfont.Size := 8;
          tempfont.Color := clBlack;
          tempfont.Style := [];
          tempfont.Name := 'Arial';

          Cell := Rows[JJ].FCells[II];
          Cell.Page := p.ID;
          samePage := Cell.Page = Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].Page;

          if Cell.TextFont = nil then
            Cell.TextFont.Assign(p.PDFDocument.DefaultFont);

          {$REGION 'HTML'}
          if Cell.HTMLText <> '' then
          begin
            Cell.Text := P.HtmlToPdf(Cell.HTMLText, Cell);
          end;
          {$ENDREGION}

          {$REGION 'COLOR SETTINGS'}
          /// Cell Border Color
          CL := ColorToRGB(Cell.BorderColor);
          {$IFDEF DELPHIXE_LVL}
          FormatSettings.DecimalSeparator := '.';
          {$ENDIF}
          {$IFNDEF DELPHIXE_LVL}
          DecimalSeparator := '.';
          {$ENDIF}
          RR := Format('%.2f',[GetRValue(CL)/255]);
          GG := Format('%.2f',[GetGValue(CL)/255]);
          BB := Format('%.2f',[GetBValue(CL)/255]);

          /// Cell BackGround Color
          CL := ColorToRGB( Cell.BackgroundColor);
          {$IFDEF DELPHIXE_LVL}
          FormatSettings.DecimalSeparator := '.';
          {$ENDIF}
          {$IFNDEF DELPHIXE_LVL}
          DecimalSeparator := '.';
          {$ENDIF}
          BGR := Format('%.2f',[GetRValue(CL)/255]);
          BGG := Format('%.2f',[GetGValue(CL)/255]);
          BGB := Format('%.2f',[GetBValue(CL)/255]);

          /// Define border color
          if not Cell.IsMerged then
          begin
            C := C + ' ' + RR + ' ' + GG + ' ' + BB + ' ' + ' rg' + sLineBreak;
          end
          else
          begin
            CL := ColorToRGB( Rows[Cell.BaseCell.Y].Cells[Cell.BaseCell.X].BackgroundColor);
            {$IFDEF DELPHIXE_LVL}
            FormatSettings.DecimalSeparator := '.';
            {$ENDIF}
            {$IFNDEF DELPHIXE_LVL}
            DecimalSeparator := '.';
            {$ENDIF}
            BGR := Format('%.2f',[GetRValue(CL)/255]);
            BGG := Format('%.2f',[GetGValue(CL)/255]);
            BGB := Format('%.2f',[GetBValue(CL)/255]);
            C := C + ' ' + BGR + ' ' + BGG + ' ' + BGB + ' ' + ' rg' + sLineBreak;
          end;
          {$ENDREGION}

          BG:= BGR + ' ' + BGG + ' ' + BGB + ' rg ' + sLineBreak;

          {$REGION 'GRADIENTS'}
          shadeText := '';
          if (Cell.BackgroundColorFrom <> clNone) and (Cell.BackgroundColorTo <> clNone) and(cell.BackgroundColor <> TColor($FFFFFF)) or cell.IsMerged then
          begin
            shade.ColorFrom := Cell.BackgroundColorFrom;
            shade.ColorTo := Cell.BackgroundColorTo;
            shade.ColorMirrorFrom := Cell.BackgroundMirrorColorFrom;
            shade.ColorMirrorTo := Cell.BackgroundMirrorColorTo;
            shade.Orientation := Cell.BackgroundOrientation;

            if Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].BackgroundColorTo <> clNone then
            begin
              if not Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].BackgroundOrientation then
//              if true then
              begin
              {$REGION 'HORIZONTAL'}
                shade.X1 := alX;
                shade.X2 := alX + Columns[II].Width;
                Shade.Y1 := 0;
                shade.Y2 := 0;
                if (Cell.IsMerged) then
                begin
                  shadeText := '0';
                  for cc := II to II + Cell.CellSpan.X  do
                  begin
                    shade.X2 := shade.X2 + Columns[cc].Width + 5;
                    shadeText := IntToStr(StrToInt(shadeText) + Columns[cc].Width);
                  end;
                  for cc := JJ to JJ + Cell.CellSpan.Y do
                  begin
                    shade.Y2 := shade.Y2 + Rows[cc].Height;
                  end;


                  if not samePage then
                  begin
                    shade.X1 := Columns[II].Width - alX;
                    shade.X2 := alX - Columns[II].Width + 15;
                    Shade.Y1 := 0;
                    shade.Y2 := 0;
                    shade.ColorFrom := Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].BackgroundColorFrom;
                    shade.ColorTo := Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].BackgroundColorTo;
                    shade.ColorMirrorFrom := Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].BackgroundMirrorColorFrom;
                    shade.ColorMirrorTo := Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].BackgroundMirrorColorTo;
                    shade.Orientation := Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].BackgroundOrientation;

                    for cc := II to II + (Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].CellSpan.X - Cell.CellSpan.X)   do
                    begin
                      shade.X1 := shade.X1 - Columns[cc].Width;
                      shade.X2 := shade.X2 - Columns[cc].Width + 15;
                    end;
                  end;
                end;
              end
              {$ENDREGION}
              else
              begin
              {$REGION 'VERTICAL'}
                Shade.Y1 := p.PDFDocument.Height - alY + Rows[JJ].Height - 10;
                shade.Y2 := p.PDFDocument.Height - alY - 10;
                shade.X1 := 0;
                shade.X2 := 0;
                if Cell.IsMerged then
                begin

                  for cc := JJ to JJ + Cell.CellSpan.Y - 1 do
                  begin
                    shade.Y2 := shade.Y2 + Rows[JJ].Height;
                  end;

                  if not samePage then
                  begin
                    Shade.Y1 := p.PDFDocument.Height - alY + Rows[JJ].Height - 10;
                    shade.Y2 := p.PDFDocument.Height - alY - 10;
                    shade.X1 := 0;
                    shade.X2 := 0;
                    shade.ColorFrom := Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].BackgroundColorFrom;
                    shade.ColorTo := Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].BackgroundColorTo;
                    shade.ColorMirrorFrom := Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].BackgroundMirrorColorFrom;
                    shade.ColorMirrorTo := Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].BackgroundMirrorColorTo;
                    shade.Orientation := Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].BackgroundOrientation;

                    for cc := JJ to JJ + Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].CellSpan.Y do
                    begin
                      shade.Y2 := shade.Y2 + Rows[cc].Height;
                    end;
                  end;
                end;
              end;


              P.FShadingList.Add(shade);
              shadeText := '/Pattern cs /LGradient' + IntToStr(P.ShadingCount) + ' scn ';

              if Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X] = Cell then
                Cell.GradientRef := shadeText
              else
              begin
                if samePage then
                begin
                  if (Cell.BaseCell.Y = 0) and (Cell.BaseCell.X = 0) then
                    Cell.GradientRef := shadeText
                  else
                    Cell.GradientRef := Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].GradientRef;
                end
                else
                begin
                  cell.GradientRef := shadeText;
                  Rows[Cell.BaseCell.Y].FCells[Cell.BaseCell.X].GradientRef := Cell.GradientRef;
                end;
              end;

              BG := BG + Cell.GradientRef + sLineBreak;

              if ((Cell.GradientRef <> '') and (samepage)) then
                P.FShadingCount := P.FShadingCount + 1;
              end
          {$ENDREGION}
          end;
          {$ENDREGION}

          {$REGION 'INSTANTIATING VARIABLES'}
          // calculate text stuff
          if II = 0 then
            P.PDFDocument.Width := Round(Columns[II].FWidth - 10)
          else
            P.PDFDocument.Width := P.PDFDocument.Width + Round(Columns[II].FWidth);

          P.PDFDocument.TextWidth := P.PDFDocument.Width  + P.Marges.Right + P.Marges.Left;

          LY := P.PDFDocument.Height - PosY + Round(Cell.TextFont.Size*0.75) + 5;

          M := P.Marges;
          M.Left := PosX + Columns[II].TextFont.Size - 5;
          P.Marges := M;

          alX := PosX + Columns[II].TextFont.Size - 5;
          textw := P.GetWidthText(Cell.Text,Cell.TextFont);
          {$ENDREGION}

          {$REGION 'ALIGNMENTS'}
          /// Include text alignment
          alY := LY;
          case Cell.HAlign of
            taCenter:
            begin
              if Cell.IsMerged then
              begin
                if (Cell.BaseCell.X = JJ) and (Cell.BaseCell.Y = II) then
                begin
                  mcw := 0;

                  /// Calculate the merged cells width
                  for counter := Cell.BaseCell.X to Cell.BaseCell.X + Cell.CellSpan.X   do
                  begin
                    mcw := mcw + Columns[counter].Width;
                    P.PDFDocument.TextWidth := P.PDFDocument.TextWidth + Round(Columns[counter].FWidth);
                  end;

                  /// Place the first cells text in the horizontal middle
                  alx := posX + Round(mcw/2) - Round(textw/2) + 5;

                  case Cell.VAlign of
                    vtaCenter:
                    begin
                      mch := 0;

                      for counter := Cell.BaseCell.Y to Cell.BaseCell.Y + Cell.CellSpan.Y do
                      begin
                        mch := mch + Rows[counter].Height;
                      end;

                      alY := LY + Round(mch/2) - 10;
                    end;
                    vtaBottom:
                    begin

                    end;
                  end;
                end
                else
                begin
                  Cell.Text := '';
                end;
              end
              else
              begin
                alx := posX + Columns[II].Width - Round(Columns[II].Width/2) - Round((textw/2)) + 5;
              end;
            end;
            taRightJustify:
            begin
              alX := posX + Columns[II].Width - textw + Round(textw*0.16) ;
            end;
          end;

          case Cell.VAlign of
            vtaTop: alY := alY - Round(Rows[JJ].Height / 2) + Round(Cell.TextFont.Size/2) + 5; //if (II = 1) and (JJ = 4) then showmessage(alY.ToString);
            vtaCenter: alY := alY - Round(Cell.TextFont.Size/2) + 5;
            vtaBottom:
            begin
              alY := alY + Round(Rows[JJ].Height / 2) - 5 - Round(Cell.TextFont.Size * (p.GetWidthText(Cell.Text, Cell.TextFont)/Columns[II].Width)) ;
            end;
          end;

          if not Cell.IsMerged then
            alY := alY + Round(Rows[JJ].Height / 2) - 10;

//          if fsBold in Cell.TextFont.Style then
//            alX := alX - 5;

          {$ENDREGION}

          {$REGION 'URLS'}
          if Cell.Url <> '' then
          begin
            P.Url := Cell.Url;
            CL := Cell.TextFont.Color;
            Cell.TextFont.Color := Cell.UrlColor;
          end;
          {$ENDREGION}


          {$REGION 'IMAGES'}
          for Imgs := Cell.Bitmaps.Count - 1 downto 0 do
          begin
            jpg := TJPEGImage.Create;
            bmp := TBitmap.Create;
            bmp.Width := Cell.Bitmaps.Items[Imgs].Width;
            bmp.Height := Cell.Bitmaps.Items[Imgs].height;
            bmp.Canvas.Brush.Color := Cell.BackgroundColor;
            bmp.Canvas.Brush.Style := bsSolid;
            bmp.Canvas.FillRect(Rect(0,0, bmp.Width, bmp.Height));
            bmp.Canvas.Draw(0,0, Cell.Bitmaps.Items[Imgs]);
            jpg.Assign(bmp);
            bmp.Free;

            ms := TMemoryStream.Create;
            jpg.SaveToStream(ms);
            ms.Position := 0;

            P.Content := C;

            imgX := PosX + 3;
            imgY := LY - 8;
            case Cell.ImageHAlign of
              haLeft: ;
              haRight:
              begin
                p.PDFDocument.Width := p.PDFDocument.Width + 20;
                imgX := posX + Columns[II].Width - 20;
              end;
              haCenter:
              begin
//                imgX := textw + posX + 15 - Round(Columns[II].Width/2);
                imgX := posX + Round(Columns[II].Width/2) - 10;
              end;
              haBeforeText:
              begin
                imgX := alX;
                alX := alX + bmp.Width + 2;
              end;
              haAfterText:
              begin
                imgX := posX + textw +2 ;// + posX - 12;
//                alX := alX + bmp.Width + 2;
              end;
              haFull: imgX := alX;
            end;

            case Cell.ImageVAlign of
              vaTop:
              begin
                imgY := imgY - 3;
              end;
              vaBottom:
              begin
//               imgY := imgY + Round(Cell.TextFont.Size/2) - 2 ;
                imgY := imgY + Rows[JJ].Height - bmp.Height - 3;
              end;
              vaCenter:
              begin
                imgY := imgY + Rows[JJ].Height - Round(Rows[JJ].Height/2) - 11;
              end;
              vaUnderText:
              begin
                imgY := alY + Cell.TextFont.Size - 3;
              end;
              vaAboveText:
              begin
                alY := alY + bmp.Height + Cell.TextFont.Size + 3;
                imgY := imgY - 2*Cell.TextFont.Size;

//                if alY < LY + Rows[JJ].Height then
//                  alY := -1;
              end;
              vaFull:;
            end;

            for cc := 0 to Cell.HTML.Count - 1 do
            begin
              if (Cell.HTML[cc].HasImage) and (Cell.HTML[cc].ImgIdx = imgs) then
              begin
                if cc <> 0 then
                  imgX := cell.HTML[cc-1].X + Round(p.GetWidthText(cell.HTML[cc-1].Text, cell.TextFont)) + 3;
              end;
            end;

            P.AddJpeg(imgX, imgY, bmp.Width, bmp.Height, ms, '1', alLeft);

            C := P.Content;

            jpg.Free;

            ir.Image := ms;
            P.ImagesList.Add(ir);
            if Cell.Bitmaps.Count > 1 then
              alX := alX - bmp.Width;
          end;
          {$ENDREGION}

          /// ------------------- Add the text -------------------
          if Cell.HTMLText <> '' then
          begin
          {$REGION 'HTML'}
            /// If it's some html text
            Tmp := '';
            Cell.Text := '';
            cc := 0;

            for html in Cell.HTML do
            begin
              if html.IsUrl then
              begin
                Cell.Url := html.Url;
                P.Url := html.Url;
              end
              else
                P.Url := '';

              if (html.HasImage) then
              begin
                alx := alx + cell.Bitmaps[html.ImgIdx].Width;
              end;

              if (html.Text <> '') then
              begin
                if cc <> 0 then
                begin
                  if Assigned(tempfont) then
                    tempfont.Free;

                  tempfont := TFont.Create;
                  tempfont.Name := Cell.HTML[cc-1].FontName;
                  tempfont.Size := Cell.HTML[cc-1].Size;
                  tempfont.Style := Cell.HTML[cc-1].FontStyle;
                  tempfont.Color := Cell.HTML[cc-1].Color;

                  alX := alX + Round(p.GetWidthText(Cell.HTML[cc-1].Text, tempfont) * 0.75);

                  if (html.Text = ' ') and (fsBold in html.FontStyle) then
                    alX := alX + 2;

                  if (Pos(' ', html.Text) = 1) and (fsBold in html.FontStyle) then
                    alx := alX + 2;

                  if (Cell.HTML[cc-1].HasImage) then
                  begin
                    if Cell.HTML.Count > 2 then
                    begin
                      if Cell.Bitmaps.Count > 1 then
                        alX := alX + Cell.Bitmaps[Cell.HTML[cc-1].ImgIdx].Width - 12
                      else
                        alX := alX + Cell.Bitmaps[Cell.HTML[cc-1].ImgIdx].Width + 10;
                    end;
                  end;
                end;
              end;

              html2 := html;
              html2.X := alX;
              html2.Y := alY;
              Cell.HTML[cc] := html2;

              if (html.Text <> '') then
              begin
                tempfont.Size:= html.Size;
                tempfont.Color := html.Color;
                tempfont.Name := html.FontName;
                tempfont.Style := html.FontStyle;
                P.BackgroundColor := html.BGColor;
            temp := p.PDFDocument.TextWidth;
            p.PDFDocument.TextWidth := PosX + Columns[II].Width - 5;
                Tmp := Tmp + P.AddTextLine(alX, alY + 3, html.Text, tempfont, alLeft, False, True, False);
                P.BackgroundColor := clNone;
            p.PDFDocument.TextWidth := temp;
              end;

              Inc(cc);
            end;
          {$ENDREGION}
          end
          else
          begin
          {$REGION 'TEXT'}
            /// Regular text
            temp := p.PDFDocument.TextWidth;
            p.PDFDocument.TextWidth := PosX + Columns[II].Width - 5;

            LTemp := '';
            if P.PDFDocument.TextOccurences(sLineBreak, Cell.Text) > 1 then
              alY := alY - Round(cell.TextFont.Size*1.5);
            while Pos(sLineBreak, Cell.Text) > 0 do
            begin
              LTemp := LTemp + P.AddTextLine(alX, alY, Copy(Cell.Text, 0, Pos(sLineBreak, Cell.Text)-1), Cell.TextFont, alLeft, True, True, False);
              alY := alY + Round(cell.TextFont.Size*1.5);
              Cell.Text := StringReplace(Cell.Text, Copy(Cell.Text, 0, Pos(sLineBreak, Cell.Text)-1)+sLineBreak, '', []);
            end;

            cb := '';
            if Cell.IsCheckbox then
            begin
              if Cell.HAlign = taRightJustify then alX := alX - 5;
              if Cell.Text <> '' then alX := alX + 15 else alx := alX - 15;

              cb := P.SetCheckboxInText(alX - Round(textw/2) + 10, alY, Cell.TextFont, Cell.Checked);

              case Cell.HAlign of
                taLeftJustify: ;
                taRightJustify: alX := alX - 5;
                taCenter: alX := alX + 10;
              end;
            end;

            Tmp := LTemp + cb + P.AddTextLine(alX, alY, Cell.Text, Cell.TextFont, alLeft, True, True, False);
//            tmp := tmp + ' 1 0 0 rg' + sLineBreak +
//                   inttostr(p.PDFDocument.TextWidth) + ' 0 m' + sLineBreak +
//                   inttostr(p.PDFDocument.TextWidth + 5) + ' 0 l' + sLineBreak +
//                   inttostr(p.PDFDocument.TextWidth + 5) + ' 780 l' + sLineBreak +
//                   'f';
            p.PDFDocument.TextWidth := temp;
          {$ENDREGION}
          end;
          /// ------------------- text added -------------------
          if Cell.Url <> '' then
            Cell.TextFont.Color := CL;

          {$REGION 'MERGED CELLS'}
          if Cell.IsMerged then
          begin
            case Cell.HAlign of
              taCenter:
              begin
                //P.PDFDocument.TextWidth := temp;
              end;
              taLeftJustify:
              begin
                Pt := Cell.BaseCell;
                if (II <> Pt.X) or (JJ <> Pt.Y) then Tmp := '';
              end;
              taRightJustify:
              begin
                Pt := Cell.BaseCell;
                if (II <> Pt.X + Cell.CellSpan.X) or (JJ <> Pt.Y )  then Tmp := '';
              end;
            end;
          end;
          {$ENDREGION}

          D := Rows[JJ].FHeight;

          {$REGION 'PAINTING CELLS'}
          C := C + ' ' + RR + ' ' + GG + ' ' + BB + ' RG  0 0 m  0 0 l  S'+sLineBreak;
          // Move to the wanted position
          if not Cell.IsMerged then
          begin
            C := C + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY - D) + ' m' + sLineBreak;
          end;

          BG := BG + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY - D) + ' m' + sLineBreak;

          // Draw the foot horizontal line
          if not Cell.IsMerged then
          begin
            C := C + ' ' + IntToStr(PosX + Columns[II].Width) + ' ' + IntToStr(PosY - D) + ' l' + sLineBreak;
            C := C + ' s' + sLineBreak;
          end;
          // Same for BackGround
          BG := BG + ' ' + IntToStr(PosX + Columns[II].Width) + ' ' + IntToStr(PosY - D) + ' l' + sLineBreak;

          // Move to the wanted position
          if not Cell.IsMerged then C := C + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY) + ' m' + sLineBreak;

          // Draw the vertical line
          if not Cell.IsMerged then
          begin
            C := C + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY - D) + ' l' + sLineBreak;
            C := C + ' s' + sLineBreak;
          end;
          BG := BG + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY - D) + ' l' + sLineBreak;

          // Move back
          if not Cell.IsMerged then C := C + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY ) + ' m' + sLineBreak;
          BG := BG + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY) + ' l' + sLineBreak;

          // Draw the text
          C := C + Tmp;

          // Draw the head horizontal line
          if not Cell.IsMerged then
          begin
            C := C + ' ' + IntToStr(PosX + Columns[II].FWidth) + ' ' + IntToStr(PosY) + ' l' + sLineBreak;
            C := C + ' s' + sLineBreak;
          end;
          BG := BG + ' ' + IntToStr(PosX + Columns[II].FWidth) + ' ' + IntToStr(PosY) + ' l' + sLineBreak;

          PosX := PosX + Columns[II].FWidth;

          // Move Forward
          if not Cell.IsMerged then C := C + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY) + ' m' + sLineBreak;

          // Draw the vertical line
          if not Cell.IsMerged then
          begin
            C := C + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY - D  ) + ' l' + sLineBreak;
            C := C + ' s' + sLineBreak;
          end;
          BG := BG + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY - D  ) + ' l' + sLineBreak;
          BG := BG + ' f' + sLineBreak;
          {$ENDREGION}

          C := BG + C;

          if II =  Cls[I] - 1 then
          begin
            PosX := X;
            PosY := PosY - D;
          end;

          if PosY < 0 then
          begin
            P.Content := C;
            P.PDFDocument.Pages.Add;
            P := P.PDFDocument.CurrentPage;
            P.Marges := Mtemp;
            P.PDFDocument.DoSetFooter;
            P.PDFDocument.DoSetHeader;
            PosY := Y;
            C := P.Content;
          end;

          if Assigned(tempfont) then
            tempfont.Free;
        {$ENDREGION}
        end;
      {$ENDREGION}
      end;

      P.Content := C;
      P.PDFDocument.Pages.Add;
      P := P.PDFDocument.CurrentPage;
      P.Marges := Mtemp;
      P.PDFDocument.DoSetFooter;
      P.PDFDocument.DoSetHeader;
      PosY := Y;
      PosX := X;
      C := P.Content;
    end; //HReps
  end; //VReps

  M.Left := LM;
  P.Marges := M;

  P.Content := C;

  P.PDFDocument.Width := DW;

  Rws.Free;
  Cls.Free;
  P.PDFDocument.CurrentPage.Free;
end;


procedure TPDFTableItem.DrawTable;
var
  C, Tmp: string;
  CL: LongInt;
  R,G,B: string;
  I, J, PosX, PosY, LY, D, H, DW, OCC, LM: Integer;
  M: TPdfMarges;
  P: TPDFPageItem;
begin
  P := PDFPage.PDFDocument.CurrentPage;
  C := P.Content;
  CL := ColorToRGB(FColor);
  {$IFDEF DELPHIXE_LVL}
  FormatSettings.DecimalSeparator := '.';
  {$ENDIF}
  {$IFNDEF DELPHIXE_LVL}
  DecimalSeparator := '.';
  {$ENDIF}
  R := Format('%.2f',[GetRValue(CL)/255]);
  G := Format('%.2f',[GetGValue(CL)/255]);
  B := Format('%.2f',[GetBValue(CL)/255]);
  PosX := X;
  PosY := Y;
  DW := P.PDFDocument.Width;
  LM := P.Marges.Left;

  for J := 0 to Rows.Count - 1 do
  begin
    for I := 0 to Columns.Count - 1 do
    begin

      C := C + ' ' + R + ' ' + G + ' ' + B + ' ' + ' rg' + sLineBreak;

      // calculate text stuff
      if I = 0 then
        P.PDFDocument.Width := Round(Columns[I].FWidth - 10)
      else
        P.PDFDocument.Width := P.PDFDocument.Width + Round(Columns[I].FWidth) ;

      P.PDFDocument.TextWidth := P.PDFDocument.Width ;

      LY := P.PDFDocument.Height - PosY + Round(Rows[J].Cells[I].TextFont.Size*0.75) + 5;

      M := P.Marges;
      M.Left := PosX + Columns[I].TextFont.Size - 5;
      P.Marges := M;

      Tmp := P.AddTextLine(PosX + Columns[I].TextFont.Size - 5, LY, Rows[J].Cells[I].Text, Rows[J].Cells[I].TextFont, Rows[J].Cells[I].Alignment, True, True, False);
      OCC := P.PDFDocument.TextOccurences(' Td' + sLineBreak, Tmp);

      H := OCC * (Rows[J].Cells[I].TextFont.Size) + 10;
      D := H;

      // Move to the wanted position
      C := C + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY) + ' m' + sLineBreak;

      // Draw the vertical line
      C := C + ' ' + R + ' ' + G + ' ' + B + ' ' + ' rg' + sLineBreak;
      C := C + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY - D - Rows[J].Cells[I].TextFont.Size ) + ' l' + sLineBreak;
      C := C + ' f' + sLineBreak;

      // Move back
      C := C + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY ) + ' m' + sLineBreak;

      // Draw the text
      C := C + Tmp;

      // Draw the head horizontal line
      C := C + ' ' + R + ' ' + G + ' ' + B + ' ' + ' rg' + sLineBreak;
      C := C + ' ' + IntToStr(PosX + Columns[I].FWidth) + ' ' + IntToStr(PosY) + ' l' + sLineBreak;
      C := C + ' f' + sLineBreak;

      PosX := PosX + Columns[I].FWidth;

      // Move Forward
      C := C + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY) + ' m' + sLineBreak;

      // Draw the vertical line
      C := C + ' ' + R + ' ' + G + ' ' + B + ' ' + ' rg' + sLineBreak;
      C := C + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY - D - Rows[J].Cells[I].TextFont.Size ) + ' l' + sLineBreak;
      C := C + ' f' + sLineBreak;

      if I = columns.Count - 1 then
      begin
        PosX := X;
        PosY := PosY - D - Rows[J].Cells[I].TextFont.Size - 10;
      end;

      if PosY < 0 then
      begin
        P.Content := C;
        P.PDFDocument.Pages.Add;
        P := P.PDFDocument.CurrentPage;
        P.Marges := M;
        P.PDFDocument.DoSetFooter;
        P.PDFDocument.DoSetHeader;
        PosY := Y;
        C := P.Content;
      end;
    end;
  end;

  // draw last lines
  for I := 0 to Columns.Count - 1 do
  begin
      // Move to the wanted position
      C := C + ' ' + IntToStr(PosX) + ' ' + IntToStr(PosY - 6) + ' m' + sLineBreak;

      // Draw the foot horizontal line
      C := C + ' ' + R + ' ' + G + ' ' + B + ' rg' + sLineBreak;
      C := C + ' ' + IntToStr(PosX + Columns[I].Width) + ' ' + IntToStr(PosY - 6) + ' l' + sLineBreak;
      C := C + ' f' + sLineBreak;

      PosX := PosX + Columns[I].Width;
  end;

  M.Left := LM;
  P.Marges := M;

  P.Content := C;

  P.PDFDocument.Width := DW;
end;

function TPDFTableItem.PDFPage: TPDFPageItem;
begin
  Result := (Collection as TPDFTableItems).Owner as TPDFPageItem;
end;

procedure TPDFTableItem.SetRows(const Value: TPDFTableRowItems);
begin
  FRows := Value;
end;

procedure TPDFTableItem.SetColumns(const Value: TPDFTableColumnItems);
begin
  FColumns := Value;
end;

//------------------------------------------------------------------------------

{ TPDFTableColumnItems }

function TPDFTableColumnItems.Add: TPDFTableColumnItem;
begin
  Result := TPDFTableColumnItem(inherited Add);
end;

constructor TPDFTableColumnItems.Create(AOwner: TPDFTableItem);
begin
  inherited Create(AOwner,TPDFTableColumnItem);
end;

destructor TPDFTableColumnItems.Destroy;
begin
  inherited;
end;

function TPDFTableColumnItems.GetItem(Index: Integer): TPDFTableColumnItem;
begin
  Result := TPDFTableColumnItem(inherited Items[Index]);
end;

function TPDFTableColumnItems.Insert(Index: Integer): TPDFTableColumnItem;
begin
  Result := TPDFTableColumnItem(inherited Insert(Index));
end;

procedure TPDFTableColumnItems.SetItem(Index: Integer; const Value: TPDFTableColumnItem);
begin
  inherited Items[Index] := Value;
end;

//------------------------------------------------------------------------------

{ TPDFTableColumnItem }

constructor TPDFTableColumnItem.Create(Collection: TCollection);
begin
  inherited;
  FTextFont := TFont.Create;
  FTextFont.Color := clBlack;
  FTextFont.Size := FONTSIZE;
  FTextFont.Name := 'Helvetica';
end;

destructor TPDFTableColumnItem.Destroy;
begin
  FTextFont.Free;
  inherited;
end;

procedure TPDFTableColumnItem.SetTextFont(const Value: TFont);
begin
  FTextFont.Assign(Value);
end;

//------------------------------------------------------------------------------

{ TPDFTableRowItems }

function TPDFTableRowItems.Add: TPDFTableRowItem;
begin
  Result := TPDFTableRowItem(inherited Add);
end;

constructor TPDFTableRowItems.Create(AOwner: TPDFTableItem);
begin
  inherited Create(AOwner,TPDFTableRowItem);
end;

destructor TPDFTableRowItems.Destroy;
begin
  inherited;
end;

function TPDFTableRowItems.GetItem(Index: Integer): TPDFTableRowItem;
begin
  Result := TPDFTableRowItem(inherited Items[Index]);
end;

function TPDFTableRowItems.Insert(Index: Integer): TPDFTableRowItem;
begin
  Result := TPDFTableRowItem(inherited Insert(Index));
end;

procedure TPDFTableRowItems.SetItem(Index: Integer; const Value: TPDFTableRowItem);
begin
  inherited Items[Index] := Value;
end;

//------------------------------------------------------------------------------

{ TPDFTableRowItem }

constructor TPDFTableRowItem.Create(Collection: TCollection);
begin
  inherited;
  Cells := TPDFTableRowCellItems.Create(Self);
end;

destructor TPDFTableRowItem.Destroy;
begin
  FCells.Free;
  inherited;
end;

procedure TPDFTableRowItem.SetCells(const Value: TPDFTableRowCellItems);
begin
  FCells := Value;
end;

//------------------------------------------------------------------------------

{ TPDFTableRowCellItems }

function TPDFTableRowCellItems.Add: TPDFTableRowCellItem;
begin
  Result := TPDFTableRowCellItem(inherited Add);
end;

constructor TPDFTableRowCellItems.Create(AOwner: TPDFTableRowItem);
begin
  inherited Create(AOwner,TPDFTableRowCellItem);
end;

destructor TPDFTableRowCellItems.Destroy;
begin
  inherited;
end;

function TPDFTableRowCellItems.GetItem(Index: Integer): TPDFTableRowCellItem;
begin
  Result := TPDFTableRowCellItem(inherited Items[Index]);
end;

function TPDFTableRowCellItems.Insert(Index: Integer): TPDFTableRowCellItem;
begin
  Result := TPDFTableRowCellItem(inherited Insert(Index));
end;

procedure TPDFTableRowCellItems.SetItem(Index: Integer; const Value: TPDFTableRowCellItem);
begin
  inherited Items[Index] := Value;
end;

//------------------------------------------------------------------------------

{ TPDFTableRowCellItem }

constructor TPDFTableRowCellItem.Create(Collection: TCollection);
begin
  inherited;
  FFont := TFont.Create;
  FFont.Color := clBlack;
  FUrlColor := clBlack;
  FFont.Size := FONTSIZE;
  FFont.Name := 'Helvetica';
  FAlignment := alLeft;
  FBitmaps := TObjectList<TBitmap>.Create;
  FBackgroundColor := clNone;
  FBackgroundColorTo := clNone;
  FBackgroundColorFrom := clNone;
  FBackgroundMirrorColorTo := clNone;
  FBackgroundMirrorColorFrom := clNone;
  FHTML := TList<THTMLRef>.Create;
  FUrlColor := clBlack;
end;

destructor TPDFTableRowCellItem.Destroy;
begin
  FFont.Free;
  FBitmaps.Free;
  FHTML.Free;
  inherited;
end;

//------------------------------------------------------------------------------

{ TPdfDictionaryWrapper }

function TPdfDictionaryWrapper.GetHasData: Boolean;
begin
  Result := (FData = nil);
end;

procedure TPdfDictionaryWrapper.SetData(AData: TObject);
begin
  FData := AData;
end;

//------------------------------------------------------------------------------

{ TPdfXrefEntry }

constructor TPdfXrefEntry.Create(AValue: TObject);
begin
  FByteOffset := -1;
  FObjectStreamIndex := -1;
  if AValue<>nil then begin
    FEntryType := 'n';
    FValue := AValue;
  end else
    FEntryType := 'f';
end;

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


//------------------------------------------------------------------------------

{ TPdfXref }

const
  PDF_MAX_GENERATION_NUM = 65535;
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;

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): TObject;
begin
  if cardinal(ObjectID)<cardinal(FXrefEntries.Count) then
    Result := TPdfXrefEntry(FXrefEntries.List[ObjectID]).Value
  else
    Result := nil;
end;

//------------------------------------------------------------------------------

{ TPdfFont }

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

procedure TPdfFont.AddUsedUnicodeChar(aChar: WideChar);
var
  I: Integer;
begin
  if Assigned(Self) then
  begin
    for I := 0 to Length(fWinUnicodeUsed)-1 do
    begin
      if aChar = FWinUnicodeUsed[I] then
        Exit;
    end;
    SetLength(fWinUnicodeUsed, Length(fWinUnicodeUsed) + 1);
    fWinUnicodeUsed[Length(fWinUnicodeUsed) - 1] := aChar;
  end;
end;

function TPdfDocument.GetDCWithFont(TTF: TPdfFont): HDC;
begin
  if not Assigned(Self) then
    Result := 0
  else
  begin
    if FSelectedDCFontOld <> 0 then // prevent resource leak
      SelectObject(FDC,fSelectedDCFontOld);
    FSelectedDCFontOld := SelectObject(FDC,TTF.fHGDI);
    Result := fDC;
  end;
end;

constructor TPdfFont.Create(Parent: TPDFDocument; const AName: string);
begin
  inherited Create;

  FEmbedFont:=true;
  FDocucment := Parent;
  FName := AName;
  FData := TPdfDictionaryWrapper.Create;

  FSubType := 'Type0';
  Encoding := 'Identity-H';

//  FFixedWidth := AWinAnsiFont.fFixedWidth;
//  FDefaultWidth := AWinAnsiFont.fDefaultWidth;
//  get TrueType glyphs info

  if Assigned(Parent) then
    TPdfTTF.Create(Self).Free; // all the magic in one line :)
end;

function TPdfFont.GetTTFXData(Doc: TPDFDocument): ansistring;
var
  used: TWordDynArray;
  I: integer;
  ttfSize: cardinal;
  TTF: PDFString;
  SubSetData: PAnsiChar;
  SubSetMem: cardinal;
  SubSetSize: cardinal;
begin
  if  EmbedFont 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) :)

      SetLength(used, length(FWinUnicodeUsed));
      { for I := 0 to Length(FUsedWide)-1 do begin
        //Used:=FUsedWide[I].Glyph;
        if FUsedWide[I].Glyph<l then
        l:=FUsedWide[I].Glyph;
        if FUsedWide[I].Glyph>h then
        h:=FUsedWide[I].Glyph;
        end; }

      for I := 0 to length(FWinUnicodeUsed) - 1 do
        used[I] := word(FWinUnicodeUsed[I]);
      TArray.Sort<word>(used);
      // FUsedWide[i].Glyph;
      Doc.GetDCWithFont(Self);
      ttfSize := GetFontData(Doc.FDc, 0, 0, nil, 0);
      SetLength(TTF, ttfSize);
      GetFontData(Doc.FDc, 0, 0, pointer(TTF), ttfSize);
      if CreateFontPackage(pointer(TTF), ttfSize, SubSetData, SubSetMem,
        SubSetSize, TTFCFP_FLAGS_SUBSET, 0, TTFMFP_SUBSET, 0,
        TTFCFP_MS_PLATFORMID, TTFCFP_UNICODE_CHAR_SET, pointer(used),
        length(used), @lpfnAllocate, @lpfnReAllocate, @lpfnFree, nil) = 0 then
      begin
        // subset was created successfully -> save to PDF file
        SetString(TTF, SubSetData, SubSetSize);
        Result:=TTF;
        FreeMem(SubSetData);
      end;
    end;
  end;
end;

destructor TPdfFont.Destroy;
begin
  Dispose(FOTM);
  FData.Free;
  inherited;
end;

function TPdfFont.GetAnsiCharWidth(const AText: PDFString; APos: Integer): Integer;
begin
  Result := 0;
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;

function TPdfFont.FindOrAddUsedWideChar(aWideChar: WideChar): Integer;
var
  i: Integer;
begin
  (*
  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
    Move(fUsedWide[result],fUsedWide[result+1],(n-result)*4);
  // create associated Unicode Font if necessary
  // update fUsedWide[result] for current glyph
  *)

  i := FUsedWideChar.IndexOf(ord(aWideChar));
  Exit(I);

  if i < 0 then // if this glyph doesn't exist in this font -> set to zero
    i := 0
  else
    i := FUsedWide[i].int;

  FUsedWide[result].int := i; // update Width and Glyph
end;

//------------------------------------------------------------------------------

{ TPdfTTF }

constructor TPdfTTF.Create(aUnicodeTTF: TPdfFont);
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
  inherited Create;

  // FEmbedFont:=true;

  p := GetTTFData(aUnicodeTTF.FDocucment.FDc, 'cmap', fcmap);

  if not Assigned(p) 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
          off := offset
        else if platformSpecificID = TTFCFP_UNICODE_CHAR_SET then
        begin
          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.FDocucment.FDc, 'head', fhead);
  if head = nil then
    Exit;

  p := GetTTFData(aUnicodeTTF.FDocucment.FDc, 'hmtx', fhmtx);
  if p = nil then
    Exit;

  hhea := GetTTFData(aUnicodeTTF.FDocucment.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 GetBit(head^.unitsPerEm, I) then
    begin
      fUnitsPerEmShr := I;
      break;
    end;

  if fUnitsPerEmShr <> 0 then
  begin
    w := (cardinal(fhmtx[0]) * 1000) shr fUnitsPerEmShr;
    if aUnicodeTTF.FFixedWidth 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;

{ TPDFHeader }

procedure TPDFHeader.Assign(Source: TPersistent);
begin
  if (Source is TPDFHeader) then
  begin
    FPageNumberFont.Assign((Source as TPDFHeader).PageNumberFont);
    FPageNumberHAlign := (Source as TPDFHeader).PageNumberHAlign;
    FPageNumberVAlign := (Source as TPDFHeader).PageNumberVAlign;
    FPageNumberVisible := (Source as TPDFHeader).PageNumberVisible;
    FText := (Source as TPDFHeader).Text;
    FTextFont.Assign((Source as TPDFHeader).TextFont);
    FTextHAlign := (Source as TPDFHeader).TextHAlign;
    FTextVAlign := (Source as TPDFHeader).TextVAlign;
  end;
end;

constructor TPDFHeader.Create;
begin
  inherited;
  FPageNumberVisible := False;
  FTextFOnt := TFont.Create;
  FPageNumberFont := TFont.Create;
end;

destructor TPDFHeader.Destroy;
begin
  FTextFont.Free;
  FPageNumberFont.Free;
  inherited;
end;

procedure TPDFHeader.SetPageNumberFont(const Value: TFont);
begin
  FPageNumberFont.Assign(Value);
end;

procedure TPDFHeader.SetTextFont(const Value: TFont);
begin
  FTextFont.Assign(Value);
end;

{ TPDFMetaData }

procedure TPDFMetaData.Assign(Source: TPersistent);
begin
  if (Source is TPDFMetaData) then
  begin
    FProducer := (Source as TPDFMetaData).Producer;
    FCreateDate := (Source as TPDFMetaData).CreateDate;
    FCreatorTool := (Source as TPDFMetaData).CreatorTool;
    FCreator := (Source as TPDFMetaData).Creator;
    FCompany := (Source as TPDFMetaData).Company;
    FTitle := (Source as TPDFMetaData).Title;
  end;
end;

constructor TPDFMetaData.Create;
begin
  inherited;
  FCompany := 'TMSSoftware';
  FCreateDate := DateTimeToStr(Now);
  FCreator := 'TMSSoftware';
  FCreatorTool := 'TMSAdvPdfLib';
  FProducer := 'TMSSoftware';
  FTitle := 'MyPdf';
end;

destructor TPDFMetaData.Destroy;
begin
  inherited;
end;

function TPDFDocument.TextType(s:string; AllowHTML: Boolean =  true): TTextType;
var
  i: integer;
  ch: char;
begin
  Result := ttText;
  s := s + ' ';

  if Length(s) > 1 then
  begin
    if s[1] = '=' then
      Result := ttFormula
    else
    begin
      if (s[1] = '|') and (s[2] = '\') then
      begin
        Result := ttUnicode;

        { unicode formula detection }
        if (Length(s) > 4) then
          if (ord(s[4]) = 61) and (ord(s[5]) = 0) then
             Result := ttFormula;

        Exit;
      end;

      if (s[1] = '{') and (s[2] = '\') then
      begin
        Result := ttRTF;
        Exit;
      end;

      if AllowHTML then
      begin
        for i := 1 to Length(s) - 1 do
        begin
          if (s[i] = '<') then
          begin
            ch := Upcase(s[i + 1]);
            if (ch = '/') or (ch = 'P') or (ch = 'I') or (ch = 'B') or (ch = 'C') then
            begin
              Result := ttHTML;
              Break;
            end;
          end;
        end;
      end;
    end;

    if Result = ttText then
    begin
//      if IsURL(s) then
        if (Pos('://',s) > 0) or (Pos('mailto:',s) > 0) then
          Result := ttURL;
    end;
  end;
end;

end.
