unit QExport4PDF;

interface

{$I QExport4VerCtrl.inc}

uses
  {$IFDEF VCL16}
    System.Classes,
    System.SysUtils,
    Data.DB,
    System.Variants,
    Winapi.Windows,
    Vcl.Graphics,
  {$ELSE}
    Classes,
    SysUtils,
    DB,
    {$IFDEF VCL6}
      Variants,
    {$ENDIF}
    Windows,
    Graphics,
  {$ENDIF}
  QExport4, QExport4Types;

type

  TPDFFontName = (poHelvetica, poHelveticaBold, poHelveticaOblique,
    poHelveticaBoldOblique, poCourier, poCourierBold, poCourierOblique,
    poCourierBoldOblique, poTimesRoman, poTimesBold, poTimesItalic,
    poTimesBoldItalic, poSymbol, poZapfDingbats);

  TPDFFontEncoding = (poStandardEncoding, poWinAnsiEncoding,
    poMacRomanEncoding, poPDFDocEncoding);

  TPDFBox = class;

  TPDFFont = class(TPersistent)
  private
    FFontName: string;
    FFontEncoding: TPDFFontEncoding;
    FUserFont: TFont;
    FWidths: array of integer;
    FUseUserFont: Boolean;

    FBaseFont: TPDFFontName;
    FFontSize: integer;
    FFontColor: TColor;
    FCharset: TFontCharset;
    procedure SetFont(const Value: TFont);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property FontName: string read FFontName write FFontName;
    function GetWidth(Numb: Integer): Integer;
    function ReturnFontLength: Integer;
    procedure CalcFontWidth;
  published
    property FontEncoding: TPDFFontEncoding read FFontEncoding
      write FFontEncoding default poWinAnsiEncoding;
    property UserFont: TFont read FUserFont write SetFont;

    property BaseFont: TPDFFontName read FBaseFont write FBaseFont
      default poHelvetica;
    property FontSize: integer read FFontSize write FFontSize default 10;
    property FontColor: TColor read FFontColor write FFontColor
      default clBlack;
    property UseUserFont: Boolean read FUseUserFont write FUseUserFont
      default false;
    property Charset: TFontCharset read FCharset write FCharset;
  end;

  TPDFDocument = class(TComponent)
  private
    FPDFFile: TStream;
    FPageContents: TStringList;
    FStreamBegin: integer;
    FObjOffsets: TStringList;
    FFonts: TStringList;
    FObjNumber: integer;
    FFont: TPDFFont;
    FLineWidth: double;
    FLineSpacing: double;
    FLineColor: TColor;
    FFillColor: TColor;

    FMediaBox: TPDFBox;
    FTrimBox: TPDFBox;

    function AddObj: integer;
    procedure WriteStr2PDF(const Source: QEString);
    procedure WriteBOF;
    //procedure WriteInfo;
    function WriteCatalog(PagesNum, OutLinesNum: integer): integer;
    function WriteOutLines: integer;
    function WriteResources : integer;
    function WritePages(FontsObj: integer): integer;
    function WriteXref: integer;
    procedure WriteTrailer(CatalogNum: integer; XrefOffset: integer);
    procedure WriteEof;
    procedure SetFont(Value: TPDFFont);
    function GetMediaBox: TPDFBox;
    function GetTrimBox: TPDFBox;
    procedure SetMediaBox(const Value: TPDFBox);
    procedure SetTrimBox(const Value: TPDFBox);
    function GetEncodingStr(const ABaseEncoding: string; ACharset: TFontCharset): string;
  public
    //constructor Create(AOwner: TComponent; Stream: TStream);
    constructor CreateWithStream(AOwner: TComponent; Stream: TStream);
    destructor Destroy; override;
    procedure BeginDoc;
    procedure EndDoc;
    procedure AddFont(NewFont: TPDFFont);
    procedure NewPage;
    procedure EndPage;
    procedure StringOut(x, y: integer; const Str: QEString; Color: TColor);
    procedure TextOut(x, y: integer; const Text: TStrings);
    procedure Line(x1, y1, x2, y2: double; Color: TColor);
    procedure FillRect(x1, y1, x2, y2: double; Color: TColor);
    procedure SetTextFont(Value: TPDFFont);
    function ChangeFillColor(Color: TColor): TColor;
    function ChangeLineColor(Color: TColor): TColor;
  published
    property ObjNumber: integer read FObjNumber;
    property Font: TPDFFont read FFont write SetFont;
    property LineWidth: double read FLineWidth write FLineWidth;
    property LineSpacing: double read FLineSpacing write FLineSpacing;
    property LineColor: TColor read FLineColor;
    property FillColor: TColor read FFillColor;

    property MediaBox: TPDFBox read GetMediaBox write SetMediaBox;
    property TrimBox: TPDFBox read GetTrimBox write SetTrimBox;
  end;

  TQPDFWriter = class(TQExportWriter)
  private
    FPDFDocument: TPDFDocument;
  public
    constructor Create(AOwner: TQExport4; AStream: TStream); override;
    destructor Destroy; override;
  published
    property PDFDocument: TPDFDocument read FPDFDocument;
  end;

  TPDFBox = class(TPersistent)
  private
    FLeft, FBottom, FRight, FTop: integer;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Left: integer read FLeft write FLeft;
    property Bottom: integer read FBottom write FBottom;
    property Right: integer read FRight write FRight;
    property Top: integer read FTop write FTop;
  end;

  TQExportPDFPageOptions = class(TPersistent)
  private
    FUnits: TQExportUnits;
    FFormat: TQExportPageFormat;
    FWidth: integer;
    FHeight: integer;
    FOrientation: TQExportPageOrientation;
    FMarginLeft: integer;
    FMarginRight: integer;
    FMarginTop: integer;
    FMarginBottom: integer;

    FMediaBox: TPDFBox;
    FTrimBox: TPDFBox;

    procedure SetFormat(const Value: TQExportPageFormat);
    function IsWidth: boolean;
    function GetWidth: double;
    procedure SetWidth(const Value: double);
    function IsHeight: boolean;
    function GetHeight: double;
    procedure SetHeight(const Value: double);
    procedure SetOrientation(const Value: TQExportPageOrientation);
    function GetMarginLeft: double;
    procedure SetMarginLeft(const Value: double);
    function GetMarginRight: double;
    procedure SetMarginRight(const Value: double);
    function GetMarginTop: double;
    procedure SetMarginTop(const Value: double);
    function GetMarginBottom: double;
    procedure SetMarginBottom(const Value: double);
    function GetMediaBox: TPDFBox;
    function GetTrimBox: TPDFBox;
  protected
    property MediaBox: TPDFBox read GetMediaBox;
    property TrimBox: TPDFBox read GetTrimBox;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    // Порядок важен - загружается в Менеджерах в таком порядке
    property Units: TQExportUnits read FUnits write FUnits default unInch;
    property Width: double read GetWidth write SetWidth stored IsWidth;
    property Height: double read GetHeight write SetHeight stored IsHeight;
    property Format: TQExportPageFormat read FFormat write SetFormat default pfA4;
    // До сюда
    property Orientation: TQExportPageOrientation read FOrientation
      write SetOrientation default poPortrait;
    property MarginLeft: double read GetMarginLeft write SetMarginLeft;
    property MarginRight: double read GetMarginRight write SetMarginRight;
    property MarginTop: double read GetMarginTop write SetMarginTop;
    property MarginBottom: double read GetMarginBottom write SetMarginBottom;
  end;

  TPDFOptions = class(TPersistent)
  private
    FHeaderFont: TPDFFont;
    FCaptionFont: TPDFFont;
    FDataFont: TPDFFont;
    FFooterFont: TPDFFont;

    FPageOptions: TQExportPDFPageOptions;

    FRowSpacing: double;
    FColSpacing: double;
    FGridLineWidth: integer;
    FGridLineColor: TColor;

    function IsRowSpacing: boolean;
    function IsColSpacing: boolean;
    procedure SetHeaderFont(const Value: TPDFFont);
    procedure SetCaptionFont(const Value: TPDFFont);
    procedure SetDataFont(const Value: TPDFFont);
    procedure SetFooterFont(const Value: TPDFFont);
    procedure SetPageOptions(const Value: TQExportPDFPageOptions);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property PageOptions: TQExportPDFPageOptions read FPageOptions
      write SetPageOptions;

    property HeaderFont: TPDFFont read FHeaderFont write SetHeaderFont;
    property CaptionFont: TPDFFont read FCaptionFont write SetCaptionFont;
    property DataFont: TPDFFont read FDataFont write SetDataFont;
    property FooterFont: TPDFFont read FFooterFont write SetFooterFont;

    property RowSpacing: double read FRowSpacing write FRowSpacing
      stored IsRowSpacing;
    property ColSpacing: double read FColSpacing write FColSpacing
      stored IsColSpacing;
    property GridLineWidth: integer read FGridLineWidth write FGridLineWidth
      default 1;
    property GridLineColor: TColor read FGridLineColor write FGridLineColor
      default clBlack;
  end;

  TBreakStringCriteria = (bscNone, bscWidth, bscData);

  TQExport4PDF = class(TQExport4FormatText)
  private
    FOptions: TPDFOptions;
    CurY : integer;
    TableBeginY: integer;
    //ColXs: array of integer;
    ColXs: TList;
    FBreakString: TBreakStringCriteria;
    procedure SetOptions(const Value: TPDFOptions);
    procedure PlotVertGridLines(Top: integer; Bottom: integer);
  protected
    procedure BeginExport; override;
    procedure WriteCaptionRow; override;
    procedure WriteDataRow; override;
    procedure WriteHeader;
    procedure WriteFooter;
    procedure EndExport; override;
    function GetWriter: TQPDFWriter;
    function GetWriterClass: TQExportWriterClass; override;
    function GetSpecialCharacters: TSpecialCharacters; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function NormalString(const S: QEString): QEString; override;
    //procedure Abort; override;
  published
    property BreakString: TBreakStringCriteria read FBreakString
      write FBreakString default bscWidth;
    property Options: TPDFOptions read FOptions write SetOptions;
    property ColumnsWidth;
    property ColumnsAlign;
    property OnGetCellParams;
  end;

implementation

uses
  {$IFDEF VCL16}
    System.Math,
    System.StrUtils,
  {$ELSE}
    Math,
    {$IFDEF VCL6}
      StrUtils,
    {$ENDIF}
  {$ENDIF}
  {$IFDEF VCL17}
    System.UITypes,
  {$ENDIF}
  QExport4Common;

var
  OldDecimalSeparator: Char;

const
  QER_FontAlreadyExist = 'Font %s already exists';

  stPDFBof = '%PDF-1.3'#$0D;

  stPDFInfo = '%d 0 obj'#$0D+
              '<< /Producer (%s)'#$0D+
              '/Author (%s)'#$0D+
              '/CreationDate (%s)'#$0D+
              '/Creator (%s)'#$0D+
              '/Keywords (%s)'#$0D+
              '/Subject (%s)'#$0D+
              '/Title (%s)'#$0D+
              '/ModDate (%s)'#$0D+
              '>>'#$0D+
              'endobj'#$0D;


  stPDFCatalog = '%d 0 obj'#$0D+
                  '<< /Type /Catalog '#$0D+
                  '/Pages %d 0 R '#$0D+
                  '/Outlines %d 0 R '#$0D+
                  '>>'#$0D+
                  'endobj'#$0D;

  stPDFOutLines = '%d 0 obj'#$0D+
                   '<< /Type /Outlines'#$0D+
                   '/Count 0'#$0D+
                   '>>'#$0D+
                   'endobj'#$0D;

  stPDFPages = '%d 0 obj'#$0D+
                '<< /Type /Pages'#$0D+
                '/Count %d'#$0D+
                '/Kids [%s]'#$0D+
                '>>'#$0D+
                'endobj'#$0D;

  stPDFFont = '%d 0 obj'#$0D+
              '<< /Type /Font'#$0D+
              '/Subtype /Type1'#$0D+
              '/Name /%s'#$0D+
              '/BaseFont /%s'#$0D+
              '/Encoding %s'#$0D+
              '/FirstChar 0'#$0D+
              '/LastChar 255'#$0D+
              '>>'#$0D+
              'endobj'#$0D;

  stPDFUserFont = '%d 0 obj'#$0D+
              '<< /Type /Font'#$0D+
              '/Subtype /Type1'#$0D+
              '/Name /%s'#$0D+
              '/BaseFont /%s'#$0D+
              '/Encoding %s'#$0D+
              '/FirstChar 0'#$0D+
              '/LastChar 255'#$0D+
              '/Widths [%s]'#$0D+
              '/FontDescriptor <</Type /FontDescriptor /Flags 32 /FontBBox [0 0 0 0]>>'#$0D+
              '>>'#$0D+
              'endobj'#$0D;

  stPDFResources = '%d 0 obj'#$0D+
                   '<< /Font <<%s >> /ProcSet [ /PDF /Text ] >>'#$0D+
                   'endobj'#$0D;

  stPDFPage = '%d 0 obj'#$0D+
               '<< /Type /Page'#$0D+
               '/Parent %d 0 R'#$0D+
               '/Resources %d 0 R'#$0D+
               '/MediaBox [%d %d %d %d]'#$0D+
               '/TrimBox [%d %d %d %d]'#$0D+
               '/Contents %s'#$0D+
               '>>'#$0D+
               'endobj'#$0D;

  stPDFStreamHeader  = '%d 0 obj'#$0D+
                       '<< /Length %d 0 R >>'#$0D+
                       'stream'#$0D;

  stPDFStreamFooter = 'endstream'#$0D+
                      'endobj'#$0D;

  stPDFText = 'BT'#$0D+
                    '/%s %d Tf'#$0D+
                    '%d %d Td (%s) Tj'#$0D+
                    'ET'#$0D;

  stPDFSetFillColor = '%f %f %f rg'#$0D;

  stPDFSetLineColor = '%f %f %f RG'#$0D;


  stPDFLine = '%.1f %.1f m '#$0D+
              '%.1f %.1f l '#$0D+
              '%.1f w '#$0D+
              'S'#$0D;

  stPDFRect = '%.1f %.1f %.1f %.1f re %s'#$0D;


  stPDFStreamLength = '%d 0 obj'#$0D+
                      '%d '#$0D+
                      'endobj'#$0D;

  stPDFXRefHeader = 'xref'#$0D+
                     '0 %d'#$0D+
                     '0000000000 65535 f '#$0D;

  stPDFXRefBody = '%10.10d 00000 n '#$0D;

  stPDFTrailer = 'trailer'#$0D+
                  '<< /Size %d'#$0D+
                  '/Root %d 0 R'#$0D+
                  '>>'#$0D+
                  'startxref'#$0D+
                  '%d'#$0D;

  stPDFEof = '%%EOF';

  PDFFontStringName: array [1..14] of string = ('Helvetica','Helvetica-Bold',
    'Helvetica-Oblique','Helvetica-BoldOblique', 'Courier', 'Courier-Bold',
    'Courier-Oblique', 'Courier-BoldOblique', 'Times-Roman', 'Times-Bold',
    'Times-Italic', 'Times-BoldItalic', 'Symbol', 'ZapfDingbats');

  PDFEncodingStringName: array [1..4] of string = ('StandardEncoding',
    'WinAnsiEncoding', 'MacRomanEncoding', 'PDFDocEncoding');

  FontBaseWidthsTNR: array[1..256] of integer = (
    663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663,
    663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663,
    663, 250, 333, 408, 500, 500, 833, 778, 333, 333, 333, 500, 564, 250, 333,
    250, 278, 500, 500, 500, 500, 500, 500, 500, 500, 500, 500, 278, 278, 564,
    564, 564, 444, 921, 722, 667, 667, 722, 611, 556, 722, 722, 333, 389, 722,
    611, 889, 722, 722, 556, 722, 667, 556, 611, 722, 722, 944, 722, 722, 611,
    333, 278, 333, 469, 500, 333, 444, 500, 444, 500, 444, 333, 500, 500, 278,
    278, 500, 278, 778, 500, 500, 500, 500, 333, 389, 278, 500, 500, 722, 500,
    500, 444, 480, 200, 480, 541, 663, 663, 663, 663, 663, 663, 663, 663, 663,
    663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663,
    663, 663, 663, 663, 663, 663, 663, 663, 663, 300, 333, 500, 500, 167, 500,
    500, 500, 500, 180, 444, 500, 333, 333, 556, 556, 663, 500, 500, 500, 250,
    663, 453, 350, 333, 444, 444, 500, 100, 100, 663, 444, 663, 333, 333, 333,
    333, 333, 333, 333, 333, 663, 333, 333, 663, 333, 333, 333, 100, 663, 663,
    663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 889,
    663, 276, 663, 663, 663, 663, 611, 722, 889, 310, 663, 663, 663, 663, 663,
    667, 663, 663, 663, 278, 663, 663, 278, 500, 722, 500, 663, 663, 663, 663);

  FontBaseWidthsZapf: array[1..256] of integer = (
    741, 741, 741, 741, 741, 741, 741, 741, 741, 741, 741, 741, 741, 741, 741,
    741, 741, 741, 741, 741, 741, 741, 741, 741, 741, 741, 741, 741, 741, 741,
    741, 741, 278, 974, 961, 974, 980, 719, 789, 790, 791, 690, 960, 939, 549, 855,
    911, 933, 911, 945, 974, 755, 846, 762, 761, 571, 677, 763, 760, 759, 754,
    494, 552, 537, 577, 692, 786, 788, 788, 790, 793, 794, 816, 823, 789, 841,
    823, 833, 816, 831, 923, 744, 723, 749, 790, 792, 695, 776, 768, 792, 759,
    707, 708, 682, 701, 826, 815, 789, 789, 707, 687, 696, 689, 786, 787, 713,
    791, 785, 791, 873, 761, 762, 762, 759, 759, 892, 892, 788, 784, 438, 138,
    277, 415, 392, 392, 668, 668, 741, 390, 390, 317, 317, 276, 276, 509, 509,
    410, 410, 234, 234, 334, 334, 741, 741, 741, 741, 741, 741, 741, 741, 741,
    741, 741, 741, 741, 741, 741, 741, 741, 741, 550, 732, 544, 544, 910, 667,
    760, 760, 776, 595, 694, 626, 788, 788, 788, 788, 788, 788, 788, 788, 788,
    788, 788, 788, 788, 788, 788, 788, 788, 788, 788, 788, 788, 788, 788, 788,
    788, 788, 788, 788, 788, 788, 788, 788, 788, 788, 788, 788, 788, 788, 788,
    788, 894, 838, 101, 458, 748, 924, 748, 918, 927, 928, 928, 834, 873, 828,
    924, 924, 917, 930, 931, 463, 883, 836, 836, 867, 867, 696, 696, 874, 741,
    874, 760, 946, 771, 865, 771, 888, 967, 888, 831, 873, 927, 970, 918, 741);

  FontBaseWidthsCourier: array[1..256] of integer = (
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600, 600,
    600, 600);

  FontBaseWidthsHelvetica: array[1..256] of integer =(
    663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663,
    663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663,
    663, 278, 278, 355, 556, 556, 889, 667, 222, 333, 333, 389, 584, 278, 333,
    278, 278, 556, 556, 556, 556, 556, 556, 556, 556, 556, 556, 278, 278, 584,
    584, 584, 556, 101, 667, 667, 722, 722, 667, 611, 778, 722, 278, 500, 667,
    556, 833, 722, 778, 667, 778, 722, 667, 611, 722, 667, 944, 667, 667, 611,
    278, 278, 278, 469, 556, 222, 556, 556, 500, 556, 556, 278, 556, 556, 222,
    222, 500, 222, 833, 556, 556, 556, 556, 333, 500, 278, 556, 500, 722, 500,
    500, 500, 334, 260, 334, 584, 663, 663, 663, 663, 663, 663, 663, 663, 663,
    663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663,
    663, 663, 663, 663, 663, 663, 663, 663, 663, 400, 333, 556, 556, 167, 556,
    556, 556, 556, 191, 333, 556, 333, 333, 500, 500, 663, 556, 556, 556, 278,
    663, 537, 350, 222, 333, 333, 556, 100, 100, 663, 611, 663, 333, 333, 333,
    333, 333, 333, 333, 333, 663, 333, 333, 663, 333, 333, 333, 100, 663, 663,
    663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 663, 100,
    663, 370, 663, 663, 663, 663, 556, 778, 100, 365, 663, 663, 663, 663, 663,
    889, 663, 663, 663, 278, 663, 663, 222, 611, 944, 611, 663, 663, 663, 663);

function GetStringWidth(const str: string; CFont: TPDFFont): integer;
var
  DC: HDC;
  i, FSize: Integer;
  f: integer;
  LocFont: TFont;
begin
  LocFont := TFont.Create;
  LocFont.Assign(CFont.UserFont);
  DC := CreateCompatibleDC(0);
  SelectObject(DC, LocFont.Handle);
  f := 0;
  for i := 1 to Length(str) do
  begin
    if not GetCharWidth(DC, Ord(str[i]), Ord(str[i]), FSize) then
      FSize := 1000;
    f := f + FSize;
  end;
  DeleteDC(DC);
  LocFont.Free;
  Result := f;
end;

function GetNCharWidth(c: double; CFont: TPDFFont): integer;
var
  i, s: integer;
begin
  s := 0;
  for i := 0 to CFont.ReturnFontLength - 1 do
    s := s + CFont.GetWidth(i);
  Result := Trunc(c * s / CFont.ReturnFontLength{256}{Length(FontBaseWidths)});
end;

function GetStringWidthBase(const str: string; size, FNum: Integer): Integer;
var
  i: integer;
  f: double;
begin
  f := 0;
  if (FNum >= 0) and (FNum <= 3) then
    for i := 1 to Length(str) do
    begin
      if str[i] <> #0 then
        f := f + Floor(size * (FontBaseWidthsHelvetica[Ord(str[i]) + 1] / 1000));
    end;
  if (FNum >= 4) and (FNum <= 7) then
    for i := 1 to Length(str) do
      if str[i] <> #0 then
        f := f + Trunc(size * FontBaseWidthsCourier[Ord(str[i]) + 1] / 1000);
  if (FNum >= 8) and (FNum <= 12) then
    for i := 1 to Length(str) do
      if str[i] <> #0 then
        f := f + Trunc(size * FontBaseWidthsTNR[Ord(str[i]) + 1] / 1000);
  if FNum = 13 then
    for i := 1 to Length(str) do
      if str[i] <> #0 then
        f := f + Trunc(size * FontBaseWidthsZapf[Ord(str[i]) + 1] / 1000);
  Result := Trunc(f);
end;

function GetNCharWidthBase(c: double; size: integer; FNum: integer): integer;
var
  i, s: integer;
begin
  s := 0;
  if (FNum >= 0) and (FNum <= 3) then
    for i := 1 to High(FontBaseWidthsHelvetica) do
      s := s + FontBaseWidthsHelvetica[i];
  if (FNum >= 4) and (FNum <= 7) then
    for i := 1 to High(FontBaseWidthsCourier) do
      s := s + FontBaseWidthsCourier[i];
  if (FNum >= 8) and (FNum <= 12) then
    for i := 1 to High(FontBaseWidthsTNR) do
      s := s + FontBaseWidthsTNR[i];
  if FNum = 13 then
    for i := 1 to High(FontBaseWidthsZapf) do
      s := s + FontBaseWidthsZapf[i];
  Result := Trunc(c * size * s / 256 / 1000);
end;

{ TPDFFont }
constructor TPDFFont.Create;
begin
  inherited;
  FFontName := EmptyStr;
  SetLength(FWidths, 256);
  FFontEncoding := poWinAnsiEncoding;
  FUserFont := TFont.Create;
  FUserFont.Name := 'Arial';
  FUserFont.Size := 10;
  FUseUserFont := false;
  FBaseFont := poHelvetica;
  FFontSize := 10;
  FFontColor := clBlack;
  CalcFontWidth;
end;

procedure TPDFFont.Assign(Source: TPersistent);
begin
  if Source is TPDFFont then
  begin
    FBaseFont := (Source as TPDFFont).BaseFont;
    FFontSize := (Source as TPDFFont).FontSize;
    FFontName := (Source as TPDFFont).FontName;
    FFontColor := (Source as TPDFFont).FontColor;
    FFontEncoding := (Source as TPDFFont).FontEncoding;
    FUseUserFont := (Source as TPDFFont).UseUserFont;
    FUserFont.Assign((Source as TPDFFont).UserFont);
    CalcFontWidth;
    Exit;
  end;
  inherited;
end;

procedure TPDFFont.SetFont(const Value: TFont);
begin
  FUserFont.Assign(Value);
  CalcFontWidth;
end;

procedure TPDFFont.CalcFontWidth;
var
  DC: HDC;
  i, FSize: Integer;
  LocFont: TFont;
begin
  LocFont := TFont.Create;
  LocFont.Assign(UserFont);
  DC := CreateCompatibleDC(0);
  SelectObject(DC, LocFont.Handle);
  for i := 0 to Length(FWidths) - 1 do
  begin
    if not GetCharWidth(DC, i, i, FSize) then
      FSize := 0;
    FWidths[i] := FSize;
  end;
  DeleteDC(DC);
  LocFont.Free;
end;

function TPDFFont.GetWidth(Numb: Integer): Integer;
begin
  Result := FWidths[Numb];
end;

function TPDFFont.ReturnFontLength: Integer;
begin
  Result := Length(FWidths);
end;

destructor TPDFFont.Destroy;
begin
  SetLength(FWidths, 0);
  FUserFont.Free;
  inherited;
end;

{ TPDFDocument }
constructor TPDFDocument.CreateWithStream(AOwner: TComponent; Stream: TStream);
begin
  inherited Create(AOwner);
  FPDFFile := Stream;
  FPageContents := TStringList.Create;
  FObjOffsets := TStringList.Create;
  FFonts := TStringList.Create;
  FFont := TPDFFont.Create;
  FLineWidth := 1;
  FLineSpacing := 1;
  FLineColor := RGB(0, 0, 0);
  FFillColor := RGB(0, 0, 0);
  OldDecimalSeparator := {$IFDEF VCL17}FormatSettings.{$ENDIF}DecimalSeparator;
  {$IFDEF VCL17}FormatSettings.{$ENDIF}DecimalSeparator:='.';
  FMediaBox := TPDFBox.Create;
  FMediaBox.Left := 0;
  FMediaBox.Bottom := 0;
  FMediaBox.Right := 612;
  FMediaBox.Top := 792;
  FTrimBox := TPDFBox.Create;
  FTrimBox.Left := 50;
  FTrimBox.Bottom := 50;
  FTrimBox.Right := 562;
  FTrimBox.Top := 742;
end;

destructor TPDFDocument.Destroy;
begin
  FPageContents.Free;
  FObjOffsets.Free;
  FFonts.Free;
  FFont.Free;
  FMediaBox.Free;
  FTrimBox.Free;
  {$IFDEF VCL17}FormatSettings.{$ENDIF}DecimalSeparator := OldDecimalSeparator;
  inherited;
end;

function TPDFDocument.AddObj: integer;
begin
  Inc(FObjNumber);
  FObjOffsets.AddObject('', TObject(FPDFFile.Size));
  Result := FObjNumber;
end;

procedure TPDFDocument.WriteStr2PDF(const Source: QEString);
begin
  FPDFFile.Seek(0, soFromEnd);
  FPDFFile.WriteBuffer( AnsiString(Source)[1], Length(Source));
end;

procedure TPDFDocument.WriteBOF;
begin
  WriteStr2PDF(stPDFBof);
end;

function TPDFDocument.WriteCatalog(PagesNum, OutLinesNum: integer): integer;
begin
  Result := AddObj;
  WriteStr2PDF(Format(stPDFCatalog, [Result, PagesNum, OutLinesNum]));
end;

function TPDFDocument.WriteOutLines: integer;
begin
  Result := AddObj;
  WriteStr2PDF(Format(stPDFOutLines, [Result]));
end;

function TPDFDocument.WritePages(FontsObj: integer): integer;
var
  i, ObjNum: integer;
  Kids: AnsiString;
begin
  // calc Kids
  Kids := QEGetEmptyStr;
  for i := 0 to FPageContents.Count - 1 do
    Kids := Kids + AnsiString(Format('%d 0 R ',[FObjNumber + 2 + i]));
  //Pages
  Result := AddObj;
  WriteStr2PDF(Format(stPDFPages, [Result, FPageContents.Count, Kids]));
  //Kids pages
  for i := 0 to FPageContents.Count - 1 do begin
    ObjNum := AddObj;
    WriteStr2PDF(Format(stPDFPage, [ObjNum, Result, FontsObj,
      FMediaBox.Left, FMediaBox.Bottom, FMediaBox.Right, FMediaBox.Top,
      FTrimBox.Left, FTrimBox.Bottom, FTrimBox.Right, FTrimBox.Top,
      AnsiString(FPageContents.Strings[i]) ]));
  end;
end;

function TPDFDocument.WriteResources: integer;
var
  i, j, fn : integer;
  FontsText: string;
  wbuf, wbasebuf: string;

  function NormalName(const s: String): String;
  var
    p: Integer;
  begin
    p := 1;
    Result := s;
    while p > 0 do
    begin
      p := PosEx(' ', Result, p);
      if p > 0 then
        Delete(Result, p, 1);
    end;
  end;

  function AddStyles(const s: String; CFont: TFont): String;
  begin
    Result := s;
    if (fsBold in CFont.Style) and (fsItalic in CFont.Style) then
      Result := Result + ',BoldItalic'
    else
    begin
      if fsBold in CFont.Style then
        Result := Result + ',Bold';
      if fsItalic in CFont.Style then
        Result := Result + ',Italic';
    end;
  end;

begin
  FontsText := '';
  wbuf := '';
  wbasebuf := '';
    //

  for i := 0 to FFonts.Count - 1 do
  begin
    with FFonts.Objects[i] as TPDFFont do begin
      fn := AddObj;
      if UseUserFont then
      begin
        //Section fo true type fonts
        wbuf := '';
        for j := 0 to ReturnFontLength - 1 do
          wbuf := wbuf + IntToStr(Trunc(GetWidth(j) * 1000 / UserFont.Size)) + ' ';
        WriteStr2PDF(Format(stPDFUserFont, [fn, FontName,
          AddStyles(NormalName(UserFont.Name), UserFont),
            GetEncodingStr(PDFEncodingStringName[Ord(FontEncoding) + 1],
              UserFont.Charset), wbuf]));
      end
      else
      begin
        //Section for base 14 Type1 fonts
        WriteStr2PDF(Format(stPDFFont, [fn, FontName,
          PDFFontStringName[Ord(BaseFont) + 1],
            GetEncodingStr(PDFEncodingStringName[Ord(FontEncoding) + 1],
              Charset)]));
      end;
      FontsText := FontsText + Format('/%s %d 0 R ', [FontName, fn]);
    end;
  end;
    //  //write res
  Result := AddObj;
  WriteStr2PDF(Format(stPDFResources, [Result, FontsText]));
end;

function TPDFDocument.WriteXref: integer;
var
  i: integer;
begin
  Result := FPDFFile.Position;
  WriteStr2PDF(Format(stPDFXRefHeader, [ObjNumber + 1]));
  for i := 0 to FObjOffsets.Count - 1 do
    WriteStr2PDF(Format(stPDFXRefBody, [integer(FObjOffsets.Objects[i])]));
end;

procedure TPDFDocument.WriteTrailer(CatalogNum: integer; XrefOffset: integer);
begin
  WriteStr2PDF(Format(stPDFTrailer, [ObjNumber + 1, CatalogNum, XrefOffset]));
end;

procedure TPDFDocument.WriteEof;
begin
  WriteStr2PDF(stPDFEof);
end;

procedure TPDFDocument.BeginDoc;
begin
  FPageContents.Clear;
  FObjOffsets.Clear;
  FObjNumber := 0;
  FFonts.Clear;
  FLineWidth := 1;
  FLineSpacing := 1;
  FLineColor := RGB(0, 0, 0);
  FFillColor := RGB(0, 0, 0);
  WriteBOF;
  //WriteInfo;
end;

procedure TPDFDocument.EndPage;
var
  Size: integer;
begin
  if FPageContents.Count > 0 then
  begin
    //calc stream length
    Size := FPDFFile.Position - FStreamBegin;
    //write stream end
    WriteStr2PDF(stPDFStreamFooter);
    //write stream length
    WriteStr2PDF(Format(stPDFStreamLength, [AddObj, Size]));
  end;
end;

procedure TPDFDocument.NewPage;
var
  ObjNum: integer;
begin
  EndPage;
  ObjNum := AddObj;
  FPageContents.Add(Format('%d 0 R', [ObjNum]));
  //write stream header
  WriteStr2PDF(Format(stPDFStreamHeader, [ObjNum, ObjNum + 1]));
  FStreamBegin := FPDFFile.Position;
end;

procedure TPDFDocument.AddFont(NewFont: TPDFFont);
begin
  if FFonts.IndexOf(NewFont.FontName) = -1
    then FFonts.AddObject(NewFont.FontName, NewFont)
    else raise Exception.CreateFmt(QER_FontAlreadyExist, [NewFont.FontName]);
end;

procedure TPDFDocument.SetFont(Value: TPDFFont);
begin
  FFont.Assign(Value);
end;

procedure TPDFDocument.StringOut(x, y: integer; const Str: QEString;
  Color: TColor);
var
  OldColor: TColor;
begin
  OldColor := clBlack;
  if Color <> FFillColor then OldColor := ChangeFillColor(Color);
  if FFont.UseUserFont then
    WriteStr2PDF(Format(stPDFText, [FFont.FontName, FFont.UserFont.Size, x, y, Str]))
  else
    WriteStr2PDF(Format(stPDFText, [FFont.FontName, FFont.FontSize, x, y, Str]));
  if Color <> FFillColor then ChangeFillColor(OldColor);
end;

procedure TPDFDocument.SetTextFont(Value: TPDFFont);
begin
  SetFont(Value);
end;

procedure TPDFDocument.TextOut(x, y: integer; const Text: TStrings);
var
  i: integer;
begin
  for i := 0 to Text.Count - 1 do
    if FFont.UseUserFont then
      StringOut(x, y - Trunc(i * FLineSpacing * FFont.UserFont.Size), Text.Strings[i],
        FFillColor)
    else
      StringOut(x, y - Trunc(i * FLineSpacing * FFont.FontSize), Text.Strings[i],
        FFillColor);
end;

procedure TPDFDocument.Line(x1, y1, x2, y2: double; Color: TColor);
var
  OldColor: TColor;
begin
  OldColor := clBlack;
  if Color <> FLineColor then OldColor := ChangeLineColor(Color);
  WriteStr2PDF(Format(stPDFLine, [x1, y1, x2, y2, FLineWidth]));
  if Color <> FLineColor then ChangeLineColor(OldColor);
end;

function TPDFDocument.ChangeLineColor(Color: TColor): TColor;
var
  Red, Green, Blue: byte;
begin
  Result := FLineColor;
  Red := Byte(Color);
  Green := Byte(Color shr 8);
  Blue := Byte(Color shr 16);
  WriteStr2PDF(Format(stPDFSetLineColor, [Red / $FF, Green / $FF, Blue / $FF]));
  FLineColor := Color;
end;

procedure TPDFDocument.FillRect(x1, y1, x2, y2: double; Color: TColor);
var
  OldFillColor: TColor;
begin
  OldFillColor := clBlack;
  if Color <> FFillColor then OldFillColor := ChangeFillColor(Color);
  WriteStr2PDF(Format(stPDFRect,[x1, y1, x2, y2, 'f']));
  if Color <> FFillColor then ChangeFillColor(OldFillColor);
end;

function TPDFDocument.ChangeFillColor(Color: TColor): TColor;
var
  Red, Green, Blue: byte;
begin
  Result := FFillColor;
  Red := Byte(Color);
  Green := Byte(Color shr 8);
  Blue := Byte(Color shr 16);
  WriteStr2PDF(Format(stPDFSetFillColor, [Red / $FF, Green / $FF, Blue / $FF]));
  FFillColor := Color;
end;

procedure TPDFDocument.EndDoc;
var
  OutLinesNum, ResourcesNum, PagesNum, CatalogNum: integer;
  XrefOffest: integer;
begin
  EndPage;
  OutLinesNum := WriteOutLines;
  ResourcesNum := WriteResources;
  PagesNum := WritePages(ResourcesNum);
  CatalogNum := WriteCatalog(PagesNum, OutLinesNum);
  XrefOffest := WriteXref;
  WriteTrailer(CatalogNum, XrefOffest);
  WriteEof;
end;

function TPDFDocument.GetEncodingStr(const ABaseEncoding: string;
  ACharset: TFontCharset): string;
begin
  case ACharset of
    ANSI_CHARSET, DEFAULT_CHARSET:
      Result := Format(' /%s', [ABaseEncoding]);
    RUSSIAN_CHARSET:
      Result := '<</Type/Encoding /BaseEncoding /' + ABaseEncoding +
        '/Differences [129 /afii10052/quotesinglbase/afii10100/quotedblbase' +
        '/ellipsis/dagger/daggerdbl/Euro/perthousand/afii10058/guilsinglleft' +
        '/afii10059/afii10061/afii10060/afii10145/afii10099/quoteleft' +
        '/quoteright/quotedblleft/quotedblright/bullet/endash/emdash/space' +
        '/trademark/afii10106/guilsinglright/afii10107/afii10109/afii10108' +
        '/afii10193/space/afii10062/afii10110/afii10057/currency/afii10050' +
        '/brokenbar/section/afii10023/copyright/afii10053/guillemotleft' +
        '/logicalnot/hyphen/registered/afii10056/degree/plusminus/afii10055' +
        '/afii10103/afii10098/mu/paragraph/periodcentered/afii10071' +
        '/afii61352/afii10101/guillemotright/afii10105/afii10054/afii10102' +
        '/afii10104/afii10017/afii10018/afii10019/afii10020/afii10021' +
        '/afii10022/afii10024/afii10025/afii10026/afii10027/afii10028' +
        '/afii10029/afii10030/afii10031/afii10032/afii10033/afii10034' +
        '/afii10035/afii10036/afii10037/afii10038/afii10039/afii10040' +
        '/afii10041/afii10042/afii10043/afii10044/afii10045/afii10046' +
        '/afii10047/afii10048/afii10049/afii10065/afii10066/afii10067' +
        '/afii10068/afii10069/afii10070/afii10072/afii10073/afii10074' +
        '/afii10075/afii10076/afii10077/afii10078/afii10079/afii10080' +
        '/afii10081/afii10082/afii10083/afii10084/afii10085/afii10086' +
        '/afii10087/afii10088/afii10089/afii10090/afii10091/afii10092' +
        '/afii10093/afii10094/afii10095/afii10096/afii10097/space]';
    EASTEUROPE_CHARSET:
      Result := '<</Type/Encoding /BaseEncoding /' + ABaseEncoding +
        '/Differences [128 /Euro 140 /Sacute /Tcaron /Zcaron /Zacute 156 ' +
        '/sacute /tcaron /zcaron /zacute 161 /caron /breve /Lslash 165 ' +
        '/Aogonek 170 /Scedilla 175 /Zdotaccent 178 /ogonek /lslash 185 ' +
        '/aogonek /scedilla 188 /Lcaron /hungarumlaut /lcaron /zdotaccent ' +
        '/Racute 195 /Abreve 197 /Lacute /Cacute 200 /Ccaron 202 /Eogonek 204 ' +
        '/Ecaron 207 /Dcaron /Dslash 209 /Nacute /Ncaron /Oacute 213 ' +
        '/Ohungarumlaut 216 /Rcaron /Uring 219 /Uhungarumlaut 222 ' +
        '/Tcedilla 224 /racute 227 /abreve 229 /lacute /cacute /ccedilla ' +
        '/ccaron 234 /eogonek 236 /ecaron 239 /dcaron /dmacron /nacute ' +
        '/ncaron 245 /ohungarumlaut 248 /rcaron /uring 251 ' +
        '/uhungarumlaut 254 /tcedilla /dotaccent]';
    VIETNAMESE_CHARSET:
      Result := '<</Type /Encoding /BaseEncoding /' + ABaseEncoding +
        '/Differences [128 /Euro 130 /quotesinglbase /florin /quotedblbase ' +
        '/ellipsis /dagger /daggerdbl /circumflex /perthousand 139 ' +
        '/guilsinglleft /OE 145 /quoteleft /quoteright /quotedblleft ' +
        '/quotedblright /bullet /endash /emdash /tilde /trademark 155 ' +
        '/guilsinglright /oe 159 /Ydieresis /space /exclamdown /cent ' +
        '/sterling /currency /yen /brokenbar /section /dieresis /copyright ' +
        '/ordfeminine /guillemotleft /logicalnot /hyphen /registered ' +
        '/macron /degree /plusminus /twosuperior /threesuperior /acute /mu ' +
        '/paragraph /periodcentered /cedilla /onesuperior /ordmasculine ' +
        '/guillemotright /onequarter /onehalf /threequarters /questiondown ' +
        '/Agrave /Aacute /Acircumflex /Abreve /Adieresis /Aring /AE ' +
        '/Ccedilla /Egrave /Eacute /Ecircumflex /Edieresis /gravetonecmb ' +
        '/Iacute /Icircumflex /Idieresis /Dcroat /Ntilde /hookabovecomb ' +
        '/Oacute /Ocircumflex /Ohorn /Odieresis /multiply /Oslash /Ugrave ' +
        '/Uacute /Ucircumflex /Udieresis /Uhorn /tildecomb /germandbls ' +
        '/agrave /aacute /acircumflex /abreve /adieresis /aring /ae ' +
        '/ccedilla /egrave /eacute /ecircumflex /edieresis /acutetonecmb ' +
        '/iacute /icircumflex /idieresis /dcroat /ntilde /dotbelowcomb ' +
        '/oacute /ocircumflex /ohorn /odieresis /divide /oslash /ugrave ' +
        '/uacute /ucircumflex /udieresis /uhorn /dong /ydieresis]';
    THAI_CHARSET:
      Result := '<</Type /Encoding /BaseEncoding /' + ABaseEncoding +
        '/Differences [128 /Euro 133 /ellipsis 145 /quoteleft /quoteright ' +
        '/quotedblleft /quotedblright /bullet /endash /emdash 160 /space ' +
        '/kokaithai /khokhaithai /khokhuatthai /khokhwaithai /khokhonthai ' +
        '/khorakhangthai /ngonguthai /chochanthai /chochingthai /chochangthai ' +
        '/sosothai /chochoethai /yoyingthai /dochadathai /topatakthai ' +
        '/thothanthai /thonangmonthothai /thophuthaothai /nonenthai ' +
        '/dodekthai /totaothai /thothungthai /thothahanthai /thothongthai ' +
        '/nonuthai /bobaimaithai /poplathai /phophungthai /fofathai ' +
        '/phophanthai /fofanthai /phosamphaothai /momathai /yoyakthai ' +
        '/roruathai /ruthai /lolingthai /luthai /wowaenthai /sosalathai ' +
        '/sorusithai /sosuathai /hohipthai /lochulathai /oangthai ' +
        '/honokhukthai /paiyannoithai /saraathai /maihanakatthai /saraaathai ' +
        '/saraamthai /saraithai /saraiithai /sarauethai /saraueethai ' +
        '/sarauthai /sarauuthai /phinthuthai 223 /bahtthai /saraethai ' +
        '/saraaethai /saraothai /saraaimaimuanthai /saraaimaimalaithai ' +
        '/lakkhangyaothai /maiyamokthai /maitaikhuthai /maiekthai ' +
        '/maithothai /maitrithai /maichattawathai /thanthakhatthai ' +
        '/nikhahitthai /yamakkanthai /fongmanthai /zerothai /onethai ' +
        '/twothai /threethai /fourthai /fivethai /sixthai /seventhai ' +
        '/eightthai /ninethai /angkhankhuthai /khomutthai]';
    GREEK_CHARSET:
      Result := '<</Type/Encoding /BaseEncoding /' + ABaseEncoding +
        '/Differences [ 128 /Euro 160 /quoteleft/quoteright 175 /afii00208' +
        ' 180 /tonos/dieresistonos/Alphatonos' +
        ' 184 /Epsilontonos/Etatonos/Iotatonos' +
        ' 188 /Omicrontonos 190 /Upsilontonos' +
        '/Omegatonos/iotadieresistonos/Alpha/Beta/Gamma/Delta/Epsilon/Zeta' +
        '/Eta/Theta/Iota/Kappa/Lambda/Mu/Nu/Xi/Omicron/Pi/Rho 211 /Sigma/Tau' +
        '/Upsilon/Phi/Chi/Psi/Omega/Iotadieresis/Upsilondieresis/alphatonos' +
        '/epsilontonos/etatonos/iotatonos/upsilondieresistonos/alpha/beta' +
        '/gamma/delta/epsilon/zeta/eta/theta/iota/kappa/lambda/mu/nu/xi' +
        '/omicron/pi/rho/sigma1/sigma/tau/upsilon/phi/chi/psi/omega' +
        '/iotadieresis/upsilondieresis/omicrontonos/upsilontonos/omegatonos ]';
    TURKISH_CHARSET:
      Result := '<</Type/Encoding /BaseEncoding /' + ABaseEncoding +
        '/Differences [ 128 /Euro 130 /quotesinglbase/florin/quotedblbase' +
        '/ellipsis/dagger /daggerdbl/circumflex/perthousand/Scaron' +
        '/guilsinglleft/OE 145 /quoteleft/quoteright/quotedblleft' +
        '/quotedblright /bullet/endash/emdash/tilde/trademark/scaron' +
        '/guilsinglright/oe 159 /Ydieresis 208 /Gbreve 221 /Idotaccent' +
        '/Scedilla 240 /gbreve 253 /dotlessi/scedilla]';
    HEBREW_CHARSET:
      Result := '<</Type/Encoding /BaseEncoding /' + ABaseEncoding +
        '/Differences [ 128 /Euro 130 /quotesinglbase/florin/quotedblbase' +
        '/ellipsis /dagger/daggerdbl/circumflex/perthousand 139 ' +
        '/guilsinglleft 145 /quoteleft/quoteright/quotedblleft/quotedblright ' +
        '/bullet/endash/emdash/tilde/trademark 155 /perthousand 164 ' +
        '/afii57636 170 /multiply 186 /divide 192 /afii57799/afii57801 ' +
        '/afii57800/afii57802/afii57793 /afii57794/afii57795/afii57798' +
        '/afii57797/afii57806 203 /afii57796/afii57807/afii57839/afii57645' +
        '/afii57841/afii57842/afii57804/afii57803/afii57658/afii57716' +
        '/afii57717/afii57718 224 /afii57664/afii57665/afii57666/afii57667' +
        '/afii57668/afii57669/afii57670/afii57671/afii57672/afii57673' +
        '/afii57674/afii57675/afii57676/afii57677/afii57678/afii57679' +
        '/afii57680/afii57681/afii57682/afii57683/afii57684/afii57685' +
        '/afii57686/afii57687/afii57688/afii57689/afii57690 253 /afii299' +
        '/afii300]';
    ARABIC_CHARSET:
      Result := '<</Type/Encoding /BaseEncoding /' + ABaseEncoding +
        '/Differences [ 128 /Euro/afii57506/quotesinglbase/florin' +
        '/quotedblbase/ellipsis/dagger/daggerdbl/circumflex/perthousand' +
        '/afii57511/guilsinglleft/OE/afii57507/afii57508 144 /afii57509' +
        '/quoteleft/quoteright/quotedblleft/quotedblright/bullet/endash' +
        '/emdash 153 /trademark/afii57513/guilsinglright/oe/afii61664' +
        '/afii301/afii57514 161 /afii57388 186 /afii57403 191 /afii57407' +
        ' 193 /afii57409/afii57410/afii57411/afii57412/afii57413/afii57414' +
        '/afii57415/afii57416/afii57417/afii57418/afii57419/afii57420' +
        '/afii57421/afii57422/afii57423/afii57424/afii57425/afii57426' +
        '/afii57427/afii57428/afii57429/afii57430 216 /afii57431/afii57432' +
        '/afii57433/afii57434/afii57440/afii57441/afii57442/afii57443' +
        '/afii57444 227 /afii57445/afii57446/afii57470/afii57448/afii57449' +
        '/afii57450 240 /afii57451/afii57452/afii57453/afii57454/afii57455' +
        '/afii57456 248 /afii57457 250 /afii57458 253 /afii299/afii300' +
        '/afii57519]';
    BALTIC_CHARSET:
      Result := '<</Type/Encoding /BaseEncoding /' + ABaseEncoding +
        '/Differences [ 128 /Euro /space /quotesinglbase /space ' +
        '/quotedblbase /ellipsis /dagger /daggerdbl /space /perthousand ' +
        '/space /guilsinglleft /space /dieresis /caron /cedilla /space ' +
        '/quoteleft /quoteright /quotedblleft /quotedblright /bullet /endash ' +
        '/emdash /space /trademark /space /guilsinglright /space /macron ' +
        '/ogonek /space 170 /Rcommaaccent 175 /AE 184 /oslash 186 ' +
        '/rcommaaccent 191 /ae /Aogonek /Iogonek /Amacron /Cacute 198 ' +
        '/Eogonek  /Emacron /Ccaron 202 /Zacute /Edotaccent /Gcommaaccent ' +
        '/Kcommaaccent /Imacron /Lcommaaccent /Scaron /Nacute /Ncommaaccent ' +
        '/trademark /Omacron 216 /Uogonek /Lslash /Sacute /Umacron 221 ' +
        '/Zdotaccent /Zcaron 224 /aogonek /iogonek /amacron /cacute 230 ' +
        '/eogonek /emacron /ccaron 234 /zacute /edotaccent /gcommaaccent ' +
        '/kcommaaccent /imacron /lcommaaccent /scaron /nacute /ncommaaccent ' +
        ' 244 /omacron 248 /uogonek /lslash /OE /umacron 253 /zdotaccent ' +
        '/zcaron /dotaccent ]';
    else
      Result := Format(' /%s', [ABaseEncoding]);
  end;
end;

function TPDFDocument.GetMediaBox: TPDFBox;
begin
  Result := FMediaBox;
end;

function TPDFDocument.GetTrimBox: TPDFBox;
begin
  Result := FTrimBox;
end;

procedure TPDFDocument.SetMediaBox(const Value: TPDFBox);
begin
  FMediaBox.Assign(Value);
end;

procedure TPDFDocument.SetTrimBox(const Value: TPDFBox);
begin
  FTrimBox.Assign(Value);
end;

{ TQPDFWriter }
constructor TQPDFWriter.Create(AOwner: TQExport4; AStream: TStream);
begin
  inherited;
  FPDFDocument := TPDFDocument.CreateWithStream(nil, AStream);
end;

destructor TQPDFWriter.Destroy;
begin
  FPDFDocument.Free;
  inherited;
end;

{ TPDFBox }
procedure TPDFBox.Assign(Source: TPersistent);
begin
  if Source is TPDFBox then begin
    FLeft := (Source as TPDFBox).Left;
    FBottom := (Source as TPDFBox).Bottom;
    FRight := (Source as TPDFBox).Right;
    FTop := (Source as TPDFBox).Top;
    Exit;
  end;
  inherited;
end;

{ TPDFOptions }
constructor TPDFOptions.Create;
begin
  inherited;
  FHeaderFont := TPDFFont.Create;
  FHeaderFont.FontName := 'HeaderFont';
  FCaptionFont := TPDFFont.Create;
  FCaptionFont.FontName := 'CaptionFont';
  FDataFont := TPDFFont.Create;
  FDataFont.FontName := 'DataFont';
  FFooterFont := TPDFFont.Create;
  FFooterFont.FontName := 'FooterFont';

  FPageOptions := TQExportPDFPageOptions.Create;

  FRowSpacing := 1;
  FColSpacing := 3;
  FGridLineWidth := 1;
  FGridLineColor := clBlack;
end;

destructor TPDFOptions.Destroy;
begin
  FPageOptions.Free;
  FHeaderFont.Free;
  FCaptionFont.Free;
  FDataFont.Free;
  FFooterFont.Free;
  inherited;
end;

procedure TPDFOptions.Assign(Source: TPersistent);
begin
 if Source is TPDFOptions then
 begin
   SetHeaderFont(TPDFOptions(Source).HeaderFont);
   SetCaptionFont(TPDFOptions(Source).CaptionFont);
   SetDataFont(TPDFOptions(Source).DataFont);
   SetFooterFont(TPDFOptions(Source).FooterFont);

   FPageOptions.Assign(TPDFOptions(Source).PageOptions);

   FRowSpacing := (Source as TPDFOptions).RowSpacing;
   FColSpacing := (Source as TPDFOptions).ColSpacing;
   FGridLineWidth := (Source as TPDFOptions).GridLineWidth;
   FGridLineColor := (Source as TPDFOptions).GridLineColor;
   Exit;
 end;
 inherited;
end;

procedure TPDFOptions.SetDataFont(const Value: TPDFFont);
begin
  FDataFont.Assign(Value);
end;

procedure TPDFOptions.SetHeaderFont(const Value: TPDFFont);
begin
  FHeaderFont.Assign(Value);
end;

procedure TPDFOptions.SetFooterFont(const Value: TPDFFont);
begin
  FFooterFont.Assign(Value);
end;

procedure TPDFOptions.SetCaptionFont(const Value: TPDFFont);
begin
  FCaptionFont.Assign(Value);
end;

function TPDFOptions.IsColSpacing: boolean;
begin
  Result := FColSpacing <> 3;
end;

function TPDFOptions.IsRowSpacing: boolean;
begin
  Result := FRowSpacing <> 1;
end;

procedure TPDFOptions.SetPageOptions(const Value: TQExportPDFPageOptions);
begin
  FPageOptions.Assign(Value);
end;

{ TQExport4PDF }

constructor TQExport4PDF.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOptions := TPdfOptions.Create;
  ColXs := TList.Create;
  //SetLength(ColXs, 0);
  FBreakString := bscWidth;
end;

destructor TQExport4PDF.Destroy;
begin
  FOptions.Free;
  ColXs.Free;
  //SetLength(ColXs, 0);
  inherited;
end;

procedure TQExport4PDF.SetOptions(const Value: TPDFOptions);
begin
  FOptions.Assign(Value);
end;

function TQExport4PDF.GetWriter: TQPDFWriter;
begin
  Result := TQPDFWriter(inherited GetWriter);
end;

function TQExport4PDF.GetWriterClass: TQExportWriterClass;
begin
  Result := TQPDFWriter;
end;

procedure TQExport4PDF.BeginExport;
var
  i: integer;
begin
  inherited;
  {$IFDEF VCL17}FormatSettings.{$ENDIF}DecimalSeparator := '.';  
  FOptions.HeaderFont.CalcFontWidth;
  FOptions.FooterFont.CalcFontWidth;
  FOptions.CaptionFont.CalcFontWidth;
  FOptions.DataFont.CalcFontWidth;
  CurY := FOptions.PageOptions.TrimBox.Top;
  TableBeginY := CurY;
  ColXs.Clear;
  ColXs.Add(Pointer(FOptions.PageOptions.TrimBox.Left));
  for i := 0 to Columns.Count - 1 do
    if FOptions.DataFont.UseUserFont then
      ColXs.Add(Pointer(Integer(ColXs[ColXs.Count - 1]) + GetNCharWidth(Columns[i].Width + FOptions.ColSpacing,
        FOptions.DataFont)))
    else
      ColXs.Add(Pointer(Integer(ColXs[ColXs.Count - 1]) + GetNCharWidthBase(Columns[i].Width + FOptions.ColSpacing,
        FOptions.DataFont.FontSize, Integer(FOptions.DataFont.BaseFont))));
//  SetLength(ColXs, Columns.Count + 1);
//  ColXs[0] := Options.TrimBox.Left;
//  for i := 0 to Columns.Count -1 do
//    ColXs[i+1] := ColXs[i] + GetNCharWidth(Columns[i].Width +
//      Options.ColumnSpacing, Options.DefaultFont.FontSize);
  GetWriter.PDFDocument.MediaBox.Assign(FOptions.PageOptions.MediaBox);
  GetWriter.PDFDocument.TrimBox.Assign(FOptions.PageOptions.TrimBox);
  GetWriter.PDFDocument.BeginDoc;
  GetWriter.PDFDocument.NewPage;
  GetWriter.PDFDocument.LineWidth := FOptions.GridLineWidth;
  GetWriter.PDFDocument.LineSpacing := FOptions.RowSpacing;
  GetWriter.PDFDocument.ChangeLineColor(FOptions.GridLineColor);
  WriteHeader;
  GetWriter.PDFDocument.AddFont(FOptions.DataFont);
  GetWriter.PDFDocument.AddFont(FOptions.CaptionFont);
  GetWriter.PDFDocument.AddFont(FOptions.HeaderFont);
  GetWriter.PDFDocument.AddFont(FOptions.FooterFont);
end;

procedure TQExport4PDF.WriteDataRow;
const
  DefBackColor = clWhite;

  function GetLinesCount(const AColIndex: Integer;
    const AFieldValue: String): Integer;
  var
    ColWidthForTextOut,
    I, RealStringWidth: Integer;
  begin
    if BreakString = bscData then
    begin
      Result := 1;
      for I := 1 to Length(AFieldValue) - 1 do
        if AFieldValue[I] = #10 then
          Inc(Result);
    end else begin
      if Options.DataFont.UseUserFont then
      begin
        ColWidthForTextOut := Integer(ColXs[AColIndex + 1]) - Integer(ColXs[AColIndex]) -
          GetNCharWidth(Options.ColSpacing, Options.DataFont);
        RealStringWidth := GetStringWidth(AFieldValue, Options.DataFont);
      end
      else begin
        ColWidthForTextOut := Integer(ColXs[AColIndex + 1]) - Integer(ColXs[AColIndex]) -
          GetNCharWidthBase(Options.ColSpacing, Options.DataFont.FontSize,
            Integer(Options.DataFont.BaseFont));
        RealStringWidth :=
          GetStringWidthBase(AFieldValue, Options.DataFont.FontSize,
            Integer(Options.DataFont.BaseFont));
      end;
      Result := Ceil(RealStringWidth / ColWidthForTextOut);
    end;
  end;

  function GetMaxLinesCount: Integer;
  var
    I: Integer;
  begin
    Result := 1;
    for I := 0 to ExportRow.Count - 1 do
      Result := Max(Result,
        GetLinesCount(I, GetExportedValue(ExportRow[I])));
  end;

  function NeedNewPage(const APosY: Integer;
    BreakString: TBreakStringCriteria): Boolean;
  var
    BreakCount: Integer;
  begin
    if Options.DataFont.UseUserFont then
      Result := APosY - Trunc(Options.DataFont.UserFont.Size * (1 +
        Options.RowSpacing))  < Options.PageOptions.TrimBox.Bottom
    else
      Result := APosY - Trunc(Options.DataFont.FontSize * (1 +
        Options.RowSpacing))  < Options.PageOptions.TrimBox.Bottom;

    if (BreakString <> bscNone) and not Result then
    begin
      BreakCount := GetMaxLinesCount;
      if Options.DataFont.UseUserFont then
        Result := APosY - Trunc(Options.DataFont.UserFont.Size * (1 +
          Options.RowSpacing)) * BreakCount < Options.PageOptions.TrimBox.Bottom
      else
        Result := APosY - Trunc(Options.DataFont.FontSize * (1 +
          Options.RowSpacing)) * BreakCount < Options.PageOptions.TrimBox.Bottom;
    end;
  end;

  procedure AddNewPage(var APosY: Integer);
  begin
    //add vert lines
    PlotVertGridLines(TableBeginY, APosY);
    APosY := Options.PageOptions.TrimBox.Top;
    TableBeginY := APosY;
    GetWriter.PDFDocument.NewPage;
    if Options.DataFont.UseUserFont then
      GetWriter.PDFDocument.ChangeFillColor(Options.DataFont.UserFont.Color)
    else
      GetWriter.PDFDocument.ChangeFillColor(Options.DataFont.FontColor);
    GetWriter.PDFDocument.ChangeLineColor(Options.GridLineColor);
    GetWriter.PDFDocument.Line(Integer(ColXs[0]), APosY,
      Integer(ColXs[ColXs.Count - 1]), APosY, Options.GridLineColor);
  end;

  function GetNewPosY(const APosY: Integer): Integer;
  begin
    if Options.DataFont.UseUserFont then
      Result := APosY - Trunc(Options.DataFont.UserFont.Size * (1 +
        Options.RowSpacing / 2))
    else
      Result := APosY - Trunc(Options.DataFont.FontSize * (1 +
        Options.RowSpacing / 2));
  end;

  function GetTextLeftPos(const AFieldValue: String; AColIndex: Integer;
    const AAlign: TQExportColAlign): Integer;
  begin
    if Options.DataFont.UseUserFont then
      Result := Integer(ColXs[AColIndex]) + GetNCharWidth(
        Options.ColSpacing / 2, Options.DataFont)
    else
      Result := Integer(ColXs[AColIndex]) + GetNCharWidthBase(
        Options.ColSpacing / 2, Options.DataFont.FontSize,
        Integer(Options.DataFont.BaseFont));
    case AAlign of
    ecaCenter:
      begin
        if Options.DataFont.UseUserFont then
          Result := Result + Ceil((Integer(ColXs[AColIndex + 1]) -
            Integer(ColXs[AColIndex]) -
            GetStringWidth(AFieldValue, Options.DataFont) -
            GetNCharWidth(Options.ColSpacing * 1.5, Options.DataFont)) / 2)
        else
          Result := Result + Ceil((Integer(ColXs[AColIndex + 1]) -
            Integer(ColXs[AColIndex]) -
            GetStringWidthBase(AFieldValue, Options.DataFont.FontSize,
            Integer(Options.DataFont.BaseFont)) -
            GetNCharWidthBase(Options.ColSpacing * 1.5, Options.DataFont.FontSize,
            Integer(Options.DataFont.BaseFont))) / 2);
      end;
    ecaRight:
      begin
        if Options.DataFont.UseUserFont then
          Result := Integer(ColXs[AColIndex + 1]) - GetNCharWidth(
            Options.ColSpacing, Options.DataFont) -
            GetStringWidth(AFieldValue, Options.DataFont)
        else
          Result := Integer(ColXs[AColIndex + 1]) - GetNCharWidthBase(
            Options.ColSpacing, Options.DataFont.FontSize,
            Integer(Options.DataFont.BaseFont)) -
            GetStringWidthBase(AFieldValue, Options.DataFont.FontSize,
            Integer(Options.DataFont.BaseFont));
      end;
    end;
  end;

  procedure FillCellRect(const AColIndex, ALinesCount, APosY: Integer;
    const ABackColor: TColor);
  begin
    if ABackColor <> DefBackColor then
    begin
      if Options.DataFont.UseUserFont then
        GetWriter.PDFDocument.FillRect(Integer(ColXs[AColIndex]), APosY -
          Options.DataFont.UserFont.Size * Options.RowSpacing / 2,
          Integer(ColXs[AColIndex + 1]) - Integer(ColXs[AColIndex]),
          (Options.DataFont.UserFont.Size * (1 + Options.RowSpacing) -
          Options.GridLineWidth / 2) * ALinesCount, ABackColor)
      else
        GetWriter.PDFDocument.FillRect(Integer(ColXs[AColIndex]), APosY -
          Options.DataFont.FontSize * Options.RowSpacing / 2,
          Integer(ColXs[AColIndex + 1]) - Integer(ColXs[AColIndex]),
          (Options.DataFont.FontSize * (1 + Options.RowSpacing) -
          Options.GridLineWidth / 2) * ALinesCount, ABackColor);
    end;
  end;

  procedure WriteHorLine(var APosY: Integer);
  begin
    if Options.DataFont.UseUserFont then
      APosY := APosY - Trunc(Options.DataFont.UserFont.Size * Options.RowSpacing /2)
    else
      APosY := APosY - Trunc(Options.DataFont.FontSize * Options.RowSpacing /2);
    GetWriter.PDFDocument.Line(Integer(ColXs[0]), APosY,
      Integer(ColXs[ColXs.Count - 1]), APosY, Options.GridLineColor);
  end;

  procedure WriteCellValue(const AFieldValue: QEString; const ALinesCount,
    AColIndex: Integer; const AAlign: TQExportColAlign;
    const ATextColor: TColor; var APosY: Integer);
  var
    I,
    BreakedValueLength,
    TextLeft: Integer;
    BreakedValue,
    TempFieldValue: QEString;
  begin
    if ALinesCount > 1 then
    begin
      BreakedValueLength := Length(AFieldValue) div ALinesCount;
      TempFieldValue := AFieldValue;

      for I := 1 to ALinesCount do
      begin
        if BreakString = bscData then
        begin
          BreakedValueLength := Pos(#13, TempFieldValue);
          if BreakedValueLength = 0 then
            BreakedValueLength := Pos(#10, TempFieldValue);
        end else
          if I = ALinesCount then
            BreakedValueLength := Length(TempFieldValue);

        BreakedValue := Copy(TempFieldValue, 1, BreakedValueLength);
        Delete(TempFieldValue, 1, BreakedValueLength);

        TextLeft := GetTextLeftPos(BreakedValue, AColIndex, AAlign);
        GetWriter.PDFDocument.StringOut(TextLeft, APosY,
          BreakedValue, ATextColor);

        if I < ALinesCount then
          APosY := GetNewPosY(APosY);
      end
    end
    else
    begin
      TextLeft := GetTextLeftPos(AFieldValue, AColIndex, AAlign);
      GetWriter.PDFDocument.StringOut(TextLeft, APosY, AFieldValue,
        ATextColor);
    end;
  end;
var
  ColIndex,
  LinesCount,
  MaxLinesCount,
  NewPosY, TempPosY: Integer;
  FieldValue: QEString;
  CurrAlign: TQExportColAlign;
  CurrFont: TFont;
  CurrBackColor: TColor;
begin
  {$IFDEF VCL17}FormatSettings.{$ENDIF}DecimalSeparator := '.';
  GetWriter.PDFDocument.SetTextFont(Options.FDataFont);
  if NeedNewPage(CurY, BreakString) then
    AddNewPage(CurY);
  CurY := GetNewPosY(CurY);
  NewPosY := CurY;
  if BreakString = bscNone then
    MaxLinesCount := 1
  else
    MaxLinesCount := GetMaxLinesCount;

  for ColIndex := 0 to ExportRow.Count - 1 do
  begin
    FieldValue := GetExportedValue(ExportRow[ColIndex]);
    try
      CurrFont := TFont.Create;
      if Options.DataFont.UseUserFont then
        CurrFont.Color := Options.DataFont.UserFont.Color
      else
        CurrFont.Color := Options.DataFont.FontColor;
      CurrAlign := Columns[ColIndex].ColAlign;
      CurrBackColor := DefBackColor;
      GetCellParams(RecordCounter, ColIndex, FieldValue, CurrAlign, CurrFont,
        CurrBackColor);
      if BreakString = bscNone then
        LinesCount := 1
      else
        LinesCount := GetLinesCount(ColIndex, FieldValue);

      FillCellRect(ColIndex, MaxLinesCount, CurY, CurrBackColor);
      TempPosY := CurY;
      WriteCellValue(FieldValue, LinesCount, ColIndex, CurrAlign,
          CurrFont.Color, TempPosY);
      NewPosY := Min(TempPosY, NewPosY);
    finally
      FreeAndNil(CurrFont);
    end;
  end;
  CurY := Min(NewPosY, CurY);
  WriteHorLine(CurY);
end;

procedure TQExport4PDF.EndExport;
begin
  {$IFDEF VCL17}FormatSettings.{$ENDIF}DecimalSeparator := '.';
  if CurY <> Options.PageOptions.TrimBox.Top then
    PlotVertGridLines(TableBeginY, CurY);
  WriteFooter;
  GetWriter.PDFDocument.EndPage;
  GetWriter.PDFDocument.EndDoc;
  inherited;
end;

procedure TQExport4PDF.WriteCaptionRow;
var
  i, j: integer;
  add, delta: integer;
begin
  {$IFDEF VCL17}FormatSettings.{$ENDIF}DecimalSeparator := '.';
  GetWriter.PDFDocument.SetTextFont(Options.CaptionFont);
  for i := 0 to Columns.Count - 1 do
  begin
    if FOptions.CaptionFont.UseUserFont then
    begin
      add := GetNCharWidth(Length(inherited GetColCaption(i))
        + FOptions.ColSpacing * 2, FOptions.CaptionFont);
      if Integer(ColXs[i + 1]) < (Integer(ColXs[i]) + add) then
      begin
        delta := Integer(ColXs[i]) + add - Integer(ColXs[i + 1]);
        for j := i + 1 to ColXs.Count - 1 do
          ColXs[j] := Pointer(Integer(ColXs[j]) + delta);
      end;
    end
    else
    begin
      add := GetNCharWidthBase(Length(inherited GetColCaption(i)) + FOptions.ColSpacing * 2,
        FOptions.CaptionFont.FontSize, Integer(Options.CaptionFont.BaseFont));
      if Integer(ColXs[i + 1]) < (Integer(ColXs[i]) + add) then
      begin
        delta := Integer(ColXs[i]) + add - Integer(ColXs[i + 1]);
        for j := i + 1 to ColXs.Count - 1 do
          ColXs[j] := Pointer(Integer(ColXs[j]) + delta);
      end;
    end;
  end;

  GetWriter.PDFDocument.Line(Integer(ColXs[0]), CurY,
    Integer(ColXs[ColXs.Count - 1]), CurY, Options.GridLineColor);

  if Options.CaptionFont.UseUserFont then
    CurY := CurY - Trunc(Options.CaptionFont.UserFont.Size *
      (1 + Options.RowSpacing / 2))
  else
    CurY := CurY - Trunc(Options.CaptionFont.FontSize *
      (1 + Options.RowSpacing / 2));

  for i := 0 to Columns.Count - 1 do
  begin
    if Options.CaptionFont.UseUserFont then
      GetWriter.PDFDocument.StringOut(Integer(ColXs[i]) + GetNCharWidth(
        Options.ColSpacing / 2, Options.CaptionFont), CurY,
        inherited GetColCaption(i), Options.CaptionFont.UserFont.Color)
    else
      GetWriter.PDFDocument.StringOut(Integer(ColXs[i]) + GetNCharWidthBase(
        Options.ColSpacing / 2, Options.CaptionFont.FontSize, Integer(Options.CaptionFont.BaseFont)), CurY,
        inherited GetColCaption(i), Options.CaptionFont.FontColor);
  end;
  if Options.CaptionFont.UseUserFont then
    CurY := CurY - Trunc(Options.CaptionFont.UserFont.Size * Options.RowSpacing / 2)
  else
    CurY := CurY - Trunc(Options.CaptionFont.FontSize * Options.RowSpacing / 2);
  GetWriter.PDFDocument.Line(Integer(ColXs[0]), CurY,
    Integer(ColXs[ColXs.Count - 1]), CurY, Options.GridLineColor);
end;

procedure TQExport4PDF.WriteHeader;
var i: integer;
begin
   {$IFDEF VCL17}FormatSettings.{$ENDIF}DecimalSeparator := '.';
   if Header.Count > 0 then begin
     GetWriter.PDFDocument.SetTextFont(Options.HeaderFont);
     for i := 0 to Header.Count - 1 do begin
       if Options.HeaderFont.UseUserFont then
         CurY := CurY - Trunc(Options.HeaderFont.UserFont.Size *
           (1 + Options.RowSpacing / 2))
       else
         CurY := CurY - Trunc(Options.HeaderFont.FontSize *
           (1 + Options.RowSpacing / 2));
       if CurY < Options.PageOptions.TrimBox.Bottom then begin
         GetWriter.PDFDocument.NewPage;
         if Options.HeaderFont.UseUserFont then
           GetWriter.PDFDocument.ChangeFillColor(Options.HeaderFont.UserFont.Color)
         else
           GetWriter.PDFDocument.ChangeFillColor(Options.HeaderFont.FontColor);
         GetWriter.PDFDocument.ChangeLineColor(Options.GridLineColor);
         if Options.HeaderFont.UseUserFont then
           CurY := Options.PageOptions.TrimBox.Top - Trunc(Options.HeaderFont.UserFont.Size *
             (1 + Options.RowSpacing / 2))
         else
           CurY := Options.PageOptions.TrimBox.Top - Trunc(Options.HeaderFont.FontSize *
             (1 + Options.RowSpacing / 2));
       end;
       if Options.HeaderFont.UseUserFont then
         GetWriter.PDFDocument.StringOut(Options.PageOptions.TrimBox.Left, CurY,
           NormalString(Header[i]), Options.HeaderFont.UserFont.Color)
       else
         GetWriter.PDFDocument.StringOut(Options.PageOptions.TrimBox.Left, CurY,
           NormalString(Header[i]), Options.HeaderFont.FontColor);
     end;
     if Options.HeaderFont.UseUserFont then
       CurY := CurY - Trunc(Options.HeaderFont.UserFont.Size *
         Options.RowSpacing / 2)
     else
       CurY := CurY - Trunc(Options.HeaderFont.FontSize *
         Options.RowSpacing / 2);
   end;
   TableBeginY := CurY;
end;

procedure TQExport4PDF.WriteFooter;
var
  i: integer;
begin
   {$IFDEF VCL17}FormatSettings.{$ENDIF}DecimalSeparator := '.';
   if Footer.Count > 0 then begin
     GetWriter.PDFDocument.SetTextFont(Options.FooterFont);
     for i := 0 to Footer.Count - 1 do
     begin
       if Options.FooterFont.UseUserFont then
         CurY := CurY - Trunc(Options.FooterFont.UserFont.Size *
           (1 + Options.RowSpacing / 2))
       else
         CurY := CurY - Trunc(Options.FooterFont.FontSize *
           (1 + Options.RowSpacing / 2));
       if CurY < Options.PageOptions.TrimBox.Bottom then
       begin
         GetWriter.PDFDocument.NewPage;
         if Options.FooterFont.UseUserFont then
           CurY := Options.PageOptions.TrimBox.Top - Trunc(Options.FooterFont.UserFont.Size *
             (1 + Options.RowSpacing / 2))
         else
           CurY := Options.PageOptions.TrimBox.Top - Trunc(Options.FooterFont.FontSize *
             (1 + Options.RowSpacing / 2));
       end;
       if Options.FooterFont.UseUserFont then
         GetWriter.PDFDocument.StringOut(Options.PageOptions.TrimBox.Left, CurY,
           NormalString(Footer[i]), Options.FooterFont.UserFont.Color)
       else
         GetWriter.PDFDocument.StringOut(Options.PageOptions.TrimBox.Left, CurY,
           NormalString(Footer[i]), Options.FooterFont.FontColor);
     end;
   end;
end;

procedure TQExport4PDF.PlotVertGridLines(Top: integer; Bottom: integer);
var
  i: integer;
begin
  for i := 0 to Columns.Count do
    GetWriter.PDFDocument.Line(Integer(ColXs[i]), Top +
      Options.GridLineWidth / 2, Integer(ColXs[i]), Bottom -
      Options.GridLineWidth / 2, Options.GridLineColor);
end;

function TQExport4PDF.NormalString(const S: QEString): QEString;
var
  p, i: Integer;
const
  SearchSym: array [0..2] of QEString = ('\', '(', ')');
  ReplSym: array [0..2] of QEString = ('\\', '\(', '\)');
begin
  Result := S;
  for i := 0 to Length(SearchSym) - 1 do
  begin
    p := 1;
    while p > 0 do
    begin
      p := PosEx(SearchSym[i], Result, p);
      if p > 0 then
      begin
        Delete(Result, p, 1);
        Insert(ReplSym[i], Result, p);
        Inc(p, 2);
      end;
    end;
  end;
end;

function TQExport4PDF.GetSpecialCharacters: TSpecialCharacters;
begin
  Result := ['\'];
end;


{ TQExportPDFPageOptions }

constructor TQExportPDFPageOptions.Create;
begin
  inherited;
  FMediaBox := TPDFBox.Create;
  FTrimBox := TPDFBox.Create;
  FUnits := unInch;
  FOrientation := poPortrait;
  MarginLeft := 1.18;
  MarginBottom := 0.79;
  MarginRight := 0.59;
  MarginTop := 0.79;
  Format := pfA4;
end;

destructor TQExportPDFPageOptions.Destroy;
begin
  FMediaBox.Free;
  FTrimBox.Free;
  inherited;
end;

procedure TQExportPDFPageOptions.Assign(Source: TPersistent);
begin
  if Source is TQExportPDFPageOptions then begin
    FUnits := TQExportPDFPageOptions(Source).FUnits;
    FFormat := TQExportPDFPageOptions(Source).FFormat;
    FWidth := TQExportPDFPageOptions(Source).FWidth;
    FHeight := TQExportPDFPageOptions(Source).FHeight;
    FOrientation := TQExportPDFPageOptions(Source).FOrientation;
    FMarginLeft := TQExportPDFPageOptions(Source).FMarginLeft;
    FMarginRight := TQExportPDFPageOptions(Source).FMarginRight;
    FMarginTop := TQExportPDFPageOptions(Source).FMarginTop;
    FMarginBottom := TQExportPDFPageOptions(Source).FMarginBottom;
    Exit;
  end;
  inherited;
end;

procedure TQExportPDFPageOptions.SetFormat(const Value: TQExportPageFormat);
begin
  if FFormat <> Value then begin
    FFormat := Value;
    if FFormat <> pfUser then begin
      FWidth := InchToDot(GetPageFormatInchWidth(FFormat));
      FHeight := InchToDot(GetPageFormatInchHeight(FFormat));
    end;
  end;
end;

function TQExportPDFPageOptions.IsWidth: boolean;
begin
  Result := FFormat = pfUser;
end;

function TQExportPDFPageOptions.GetWidth: double;
begin
  Result := Dot2Units(FUnits, FWidth);
end;

procedure TQExportPDFPageOptions.SetWidth(const Value: double);
begin
  FWidth := Units2Dot(FUnits, Value);
  FFormat := pfUser;
end;

function TQExportPDFPageOptions.IsHeight: boolean;
begin
  Result := FFormat = pfUser;
end;

function TQExportPDFPageOptions.GetHeight: double;
begin
  Result := Dot2Units(FUnits, FHeight);
end;

procedure TQExportPDFPageOptions.SetHeight(const Value: double);
begin
  FHeight := Units2Dot(FUnits, Value);
  FFormat := pfUser;
end;

procedure TQExportPDFPageOptions.SetOrientation(const Value: TQExportPageOrientation);
var
  Sz: TSize;
  Rect: TRect;
begin
  if FOrientation <> Value then begin
    FOrientation := Value;

    Sz.cx := FWidth;
    Sz.cy := FHeight;
    FWidth := Sz.cy;
    FHeight := Sz.cx;

    Rect.Left := FMarginLeft;
    Rect.Right := FMarginRight;
    Rect.Top := FMarginTop;
    Rect.Bottom := FMarginBottom;

    if FOrientation = poLandscape then begin
      FMarginLeft := Rect.Bottom;
      FMarginRight := Rect.Top;
      FMarginTop := Rect.Left;
      FMarginBottom := Rect.Right;
    end
    else begin
      FMarginLeft := Rect.Top;
      FMarginRight := Rect.Bottom;
      FMarginTop := Rect.Right;
      FMarginBottom := Rect.Left;
    end;
  end;
end;

function TQExportPDFPageOptions.GetMarginLeft: double;
begin
  Result := Dot2Units(FUnits, FMarginLeft);
end;

procedure TQExportPDFPageOptions.SetMarginLeft(const Value: double);
begin
  FMarginLeft := Units2Dot(FUnits, Value);
end;

function TQExportPDFPageOptions.GetMarginRight: double;
begin
  Result := Dot2Units(FUnits, FMarginRight);
end;

procedure TQExportPDFPageOptions.SetMarginRight(const Value: double);
begin
  FMarginRight := Units2Dot(FUnits, Value);
end;

function TQExportPDFPageOptions.GetMarginTop: double;
begin
  Result := Dot2Units(FUnits, FMarginTop);
end;

procedure TQExportPDFPageOptions.SetMarginTop(const Value: double);
begin
  FMarginTop := Units2Dot(FUnits, Value);
end;

function TQExportPDFPageOptions.GetMarginBottom: double;
begin
  Result := Dot2Units(FUnits, FMarginBottom);
end;

procedure TQExportPDFPageOptions.SetMarginBottom(const Value: double);
begin
  FMarginBottom := Units2Dot(FUnits, Value);
end;

function TQExportPDFPageOptions.GetMediaBox: TPDFBox;
begin
  Result := FMediaBox;
  FMediaBox.Left := 0;
  FMediaBox.Bottom := 0;
  FMediaBox.Right := FWidth - 1;
  FMediaBox.Top := FHeight - 1;
end;

function TQExportPDFPageOptions.GetTrimBox: TPDFBox;
begin
  Result := FTrimBox;
  FTrimBox.Left := FMarginLeft;
  FTrimBox.Bottom := FMarginBottom;
  FTrimBox.Right := FWidth - FMarginRight - 1;
  FTrimBox.Top := FHeight - FMarginTop - 1;
end;

end.
