<commit_before>{
    << Impressions >>  U_Pdf.pas

    Copyright (C) 2010 - JM.Levecque - <<EMAIL>>

   This library is a free software coming as a add-on to fpGUI toolkit
   See the copyright included in the fpGUI distribution for details about redistribution

   This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

    Description:
      This unit produces the pdf file
}

unit U_Pdf;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  fpg_main, fpg_base;

type
  TPdfObjet = class(TObject)
    private
    protected
    public
      constructor Create; virtual;
      destructor Destroy; override;
    end;

  TPdfBoolean = class(TPdfObjet)
    private
      FValue: Boolean;
    protected
      procedure WriteBoolean(const AFlux: TStream);
    public
      constructor CreateBoolean(const AValue: Boolean);
      destructor Destroy; override;
    end;

  TPdfInteger = class(TPdfObjet)
    private
      FValue: Integer;
    protected
      procedure WriteInteger(const AFlux: TStream);
      procedure IncrementeInteger;
      property Value: Integer read FValue write FValue;
    public
      constructor CreateInteger(const AValue: Integer);
      destructor Destroy; override;
    end;

  TPdfReference = class(TPdfObjet)
    private
      FValue: Integer;
    protected
      procedure WriteReference(const AFlux: TStream);
    public
      constructor CreateReference(const AValue: Integer);
      destructor Destroy; override;
    end;

  TPdfName = class(TPdfObjet)
    private
      FValue: string;
    protected
      procedure WriteName(const AFlux: TStream);
    public
      constructor CreateName(const AValue: string);
      destructor Destroy; override;
    end;

  TPdfString = class(TPdfObjet)
    private
      FValue: string;
    protected
      procedure WriteString(const AFlux: TStream);
    public
      constructor CreateString(const AValue: string);
      destructor Destroy; override;
    end;

  TPdfArray = class(TPdfObjet)
    private
      FArray: TList;
    protected
      procedure WriteArray(const AFlux: TStream);
      procedure AddItem(const AValue: TPdfObjet);
    public
      constructor CreateArray;
      destructor Destroy; override;
    end;

  TPdfStream = class(TPdfObjet)
    private
      FStream: TList;
    protected
      procedure WriteStream(const AFlux: TStream);
      procedure AddItem(const AValue: TPdfObjet);
    public
      constructor CreateStream;
      destructor Destroy; override;
    end;

  TPdfFonte = class(TPdfObjet)
    private
      FTxtFont: Integer;
      FTxtSize: string;
    protected
      procedure WriteFonte(const AFlux: TStream);
    public
      constructor CreateFonte(const AFont: Integer; const ASize: string);
      destructor Destroy; override;
    end;

  TPdfText = class(TPdfObjet)
    private
      FTxtPosX: Single;
      FTxtPosY: Single;
      FTxtText: TPdfString;
    protected
      procedure WriteText(const AFlux: TStream);
    public
      constructor CreateText(const APosX,APosY: Single; const AText: string);
      destructor Destroy; override;
    end;

  TPdfLigne = class(TPdfObjet)
    private
      FEpais: Single;
      FStaX: Single;
      FStaY: Single;
      FEndX: Single;
      FEndY: Single;
    protected
      procedure WriteLigne(const AFlux: TStream);
    public
      constructor CreateLigne(const AEpais,AStaX,AStaY,AEndX,AEndY: Single);
      destructor Destroy; override;
    end;

  TPdfRectangle = class(TPdfObjet)
    private
      FEpais: Single;
      FRecX: Single;
      FRecY: Single;
      FRecW: Single;
      FRecH: Single;
      FFill: Boolean;
      FStroke: Boolean;
    protected
      procedure WriteRectangle(const AFlux: TStream);
    public
      constructor CreateRectangle(const AEpais,APosX,APosY,AWidth,AHeight: Single; const AFill,AStroke: Boolean);
      destructor Destroy; override;
    end;

  TRefPos= record
    X: Single;
    Y: Single;
    end;

  T_Points = array of TRefPos;

  TPdfSurface = class(TPdfObjet)
    private
      FPoints: T_Points;
    protected
      procedure WriteSurface(const AFlux: TStream);
    public
      constructor CreateSurface(const APoints: T_Points);
      destructor Destroy; override;
    end;

  TPdfImage = class(TPdfObjet)
    private
      FNumber: Integer;
      FLeft: Single;
      FBottom: Single;
      FWidth: Integer;
      FHeight: Integer;
    protected
      function WriteImageStream(const ANumber: Integer; AFlux: TStream): Int64;
      procedure WriteImage(const AFlux: TStream);
    public
      constructor CreateImage(const ALeft,ABottom: Single; AWidth,AHeight,ANumber: Integer);
      destructor Destroy; override;
    end;

  TPdfLineStyle = class(TPdfObjet)
    private
      FDash: TfpgLineStyle;
      FPhase: Integer;
    protected
      procedure WriteLineStyle(const AFlux: TStream);
    public
      constructor CreateLineStyle(ADash: TfpgLineStyle; APhase: Integer);
      destructor Destroy; override;
    end;

  TPdfColor = class(TPdfObjet)
    private
      FRed: string;
      FGreen: string;
      FBlue: string;
      FStroke: Boolean;
    protected
      procedure WriteColor(const AFlux: TStream);
    public
      constructor CreateColor(const AStroke: Boolean; Couleur: LongInt);
      destructor Destroy; override;
    end;

  TPdfDicElement = class(TObject)
    private
      FKey: TPdfName;
      FValue: TPdfObjet;
    protected
      procedure WriteDicElement(const AFlux: TStream);
    public
      constructor CreateDicElement(const AKey: string; const AValue: TPdfObjet);
      destructor Destroy; override;
    end;

  TPdfDictionary = class(TPdfObjet)
    private
      FElement: TList; // list of TPdfDicElement
    protected
      procedure AddElement(const AKey: string; const AValue: TPdfObjet);
      function ElementParCle(const AValue: string): Integer;
      procedure WriteDictionary(const AObjet: Integer; const AFlux: TStream);
    public
      constructor CreateDictionary;
      destructor Destroy; override;
    end;

  TPdfXRef = class(TObject)
    private
      FOffset: Integer;
      FObjet: TPdfDictionary;
      FStream: TPdfStream;
    protected
      procedure WriteXRef(const AFlux: TStream);
    public
      constructor CreateXRef;
      destructor Destroy; override;
      property Offset: Integer read FOffset write FOffset;
    end;

  TPdfDocument = class(TObject)
    private
      FXRefObjets: TList; // list of TPdfXRef
    protected
      function ElementParNom(const AValue: string): Integer;
      procedure WriteXRefTable(const AFlux: TStream);
      procedure WriteObjet(const AObjet: Integer; const AFlux: TStream);
      procedure CreateRefTable;
      procedure CreateTrailer;
      function CreateCatalog: Integer;
      procedure CreateInfo;
      procedure CreatePreferences;
      function CreatePages(Parent: Integer): Integer;
      function CreatePage(Parent,Haut,Larg,PageNum: Integer): Integer;
      function CreateOutlines: Integer;
      function CreateOutline(Parent,SectNo,PageNo: Integer; SectTitre: string): Integer;
      procedure CreateFont(NomFonte: string; NumFonte: Integer);
      procedure CreateImage(ImgWidth,ImgHeight,NumImg: Integer);
      function CreateContents: Integer;
      procedure CreateStream(NumeroPage,PageNum: Integer);
    public
      constructor CreateDocument;
      destructor Destroy; override;
      procedure WriteDocument(const AFlux: TStream);
    end;

const
  CRLF= #13#10;
  PDF_VERSION= '%PDF-1.3';
  PDF_FILE_END= '%%EOF';
  PDF_MAX_GEN_NUM= 65535;
  PDF_UNICODE_HEADER = 'FEFF001B%s001B';
  PDF_LANG_STRING = 'fr';

var
  Document: TPdfDocument;
  OldDecSeparator: Char;
  Outline: Boolean;

implementation

uses
  U_Report, U_Command;

var
  Trailer: TPdfDictionary;
  CurrentColor: string;
  CurrentWidth: string;
  Catalogue: Integer;

// utility functions

function InsertEscape(const AValue: string): string;
var
  Chaine: string;
begin
Result:= '';
Chaine:= AValue;
while Pos('\',Chaine)> 0 do
  begin
  Result:= Result+Copy(Chaine,1,Pred(Pos('\',Chaine)))+'\\';
  Chaine:= Copy(Chaine,Succ(Pos('\',Chaine)),Length(Chaine)-Pos('\',Chaine));
  end;
Chaine:= Result+Chaine;
Result:= '';
while Pos('(',Chaine)> 0 do
  begin
  Result:= Result+Copy(Chaine,1,Pred(Pos('(',Chaine)))+'\(';
  Chaine:= Copy(Chaine,Succ(Pos('(',Chaine)),Length(Chaine)-Pos('(',Chaine));
  end;
Chaine:= Result+Chaine;
Result:= '';
while Pos(')',Chaine)> 0 do
  begin
  Result:= Result+Copy(Chaine,1,Pred(Pos(')',Chaine)))+'\)';
  Chaine:= Copy(Chaine,Succ(Pos(')',Chaine)),Length(Chaine)-Pos(')',Chaine));
  end;
Result:= Result+Chaine;
end;

procedure WriteChaine(const Valeur: string; AFlux: TStream);
begin
AFlux.Write(PChar(Valeur)^,Length(Valeur));
end;

function IntToChaine(const Valeur: Integer; const Long: Integer): string;
var
  Chaine: string;
  Cpt: Integer;
begin
Result:= '';
Chaine:= IntToStr(Valeur);
if Length(Chaine)< Long
then
  for Cpt:= Succ(Length(Chaine)) to Long do
    Result:= Result+'0';
Result:= Result+Chaine;
end;

function DateToPdfDate(const ADate: TDateTime): string;
begin
Result:= FormatDateTime('"D:"yyyymmddhhnnss',ADate);
end;

function ExtractBaseFontName(const AValue: string): string;
var
  FontName,Chaine1,Chaine2: string;
begin
FontName:= Uppercase(AValue[1])+Copy(AValue,2,Pos('-',AValue)-2);
if Pos(':',AValue)> 0
then
  begin
  Chaine1:= Copy(AValue,Succ(Pos(':',AValue)),Length(AValue)-Pos(':',AValue));
  Chaine1:= Uppercase(Chaine1[1])+Copy(Chaine1,2,Pred(Length(Chaine1)));
  if Pos(':',Chaine1)> 0
  then
    begin
    Chaine2:= Copy(Chaine1,Succ(Pos(':',Chaine1)),Length(Chaine1)-Pos(':',Chaine1));
    Chaine2:= Uppercase(Chaine2[1])+Copy(Chaine2,2,Pred(Length(Chaine2)));
    if (FontName= 'Helvetica') or (FontName= 'Courier')
    then
      if Chaine2= 'Italic'
      then
        Chaine2:= 'Oblique';
    Chaine1:= Copy(Chaine1,1,Pred(Pos(':',Chaine1)));
    Chaine1:= Uppercase(Chaine1[1])+Copy(Chaine1,2,Pred(Length(Chaine1)));
    if (FontName= 'Helvetica') or (FontName= 'Courier')
    then
      if Chaine1= 'Italic'
      then
        Chaine1:= 'Oblique';
    Chaine1:= Chaine1+Chaine2;
    end
  else
    if (FontName= 'Helvetica') or (FontName= 'Courier')
    then
      if Chaine1= 'Italic'
      then
        Chaine1:= 'Oblique';
  Chaine1:= '-'+Chaine1;
  end;
Result:= FontName+Chaine1;
end;

// object methods

constructor TPdfObjet.Create;
begin
  // to be implemented by descendents
end;

destructor TPdfObjet.Destroy;
begin
inherited;
end;

procedure TPdfBoolean.WriteBoolean(const AFlux: TStream);
begin
if FValue
then
  WriteChaine('true',AFlux)
else
  WriteChaine('false',AFlux);
end;

constructor TPdfBoolean.CreateBoolean(const AValue: Boolean);
begin
inherited Create;
FValue:= AValue;
end;

destructor TPdfBoolean.Destroy;
begin
inherited;
end;

procedure TPdfInteger.WriteInteger(const AFlux: TStream);
begin
WriteChaine(IntToStr(FValue), AFlux);
end;

procedure TPdfInteger.IncrementeInteger;
begin
FValue:= FValue+1;
end;

constructor TPdfInteger.CreateInteger(const AValue: Integer);
begin
inherited Create;
FValue:= AValue;
end;

destructor TPdfInteger.Destroy;
begin
inherited;
end;

procedure TPdfReference.WriteReference(const AFlux: TStream);
begin
WriteChaine(IntToStr(FValue)+' 0 R',AFlux);
end;

constructor TPdfReference.CreateReference(const AValue: Integer);
begin
inherited Create;
FValue:= AValue;
end;

destructor TPdfReference.Destroy;
begin
inherited;
end;

procedure TPdfName.WriteName(const AFlux: TStream);
begin
if FValue<> ''
then
  WriteChaine('/'+FValue,AFlux);
end;

constructor TPdfName.CreateName(const AValue: string);
begin
inherited Create;
FValue:= AValue;
end;

destructor TPdfName.Destroy;
begin
inherited;
end;

procedure TPdfString.WriteString(const AFlux: TStream);
begin
WriteChaine('('+Utf8ToAnsi(FValue)+')',AFlux);
end;

constructor TPdfString.CreateString(const AValue: string);
begin
inherited Create;
FValue:= AValue;
if (Pos('(',FValue)> 0) or (Pos(')',FValue)> 0) or (Pos('\',FValue)> 0)
then
  FValue:= InsertEscape(FValue);
end;

destructor TPdfString.Destroy;
begin
inherited;
end;

procedure TPdfArray.WriteArray(const AFlux: TStream);
var
  Cpt: Integer;
begin
WriteChaine('[',AFlux);
for Cpt:= 0 to Pred(FArray.Count) do
  begin
  if Cpt> 0
  then
    WriteChaine(' ',AFlux);
  if TPdfObjet(FArray[Cpt]) is TPdfInteger
  then
    TPdfInteger(FArray[Cpt]).WriteInteger(AFlux);
  if TPdfObjet(FArray[Cpt]) is TPdfReference
  then
    TPdfReference(FArray[Cpt]).WriteReference(AFlux);
  if TPdfObjet(FArray[Cpt]) is TPdfName
  then
    TPdfName(FArray[Cpt]).WriteName(AFlux);
  end;
WriteChaine(']',AFlux);
end;

procedure TPdfArray.AddItem(const AValue: TPdfObjet);
begin
FArray.Add(AValue);
end;

constructor TPdfArray.CreateArray;
begin
inherited Create;
FArray:= TList.Create;
end;

destructor TPdfArray.Destroy;
var
  Cpt: Integer;
begin
if FArray.Count> 0
then
  for Cpt:= 0 to Pred(FArray.Count) do
    if TPdfObjet(FArray[Cpt]) is TPdfInteger
    then
      TPdfInteger(FArray[Cpt]).Free
    else
      if TPdfObjet(FArray[Cpt]) is TPdfReference
      then
        TPdfReference(FArray[Cpt]).Free
      else
        if TPdfObjet(FArray[Cpt]) is TPdfName
        then
          TPdfName(FArray[Cpt]).Free;
FArray.Free;
inherited;
end;

procedure TPdfStream.WriteStream(const AFlux: TStream);
var
  Cpt: Integer;
begin
for Cpt:= 0 to Pred(FStream.Count) do
  begin
  if TPdfObjet(FStream[Cpt]) is TPdfFonte
  then
    TPdfFonte(FStream[Cpt]).WriteFonte(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfColor
  then
    TPdfColor(FStream[Cpt]).WriteColor(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfText
  then
    TPdfText(FStream[Cpt]).WriteText(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfRectangle
  then
    TPdfRectangle(FStream[Cpt]).WriteRectangle(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfLigne
  then
    TPdfLigne(FStream[Cpt]).WriteLigne(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfLineStyle
  then
    TPdfLineStyle(FStream[Cpt]).WriteLineStyle(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfSurface
  then
    TPdfSurface(FStream[Cpt]).WriteSurface(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfImage
  then
    TPdfImage(FStream[Cpt]).WriteImage(AFlux);
  end;
end;

procedure TPdfStream.AddItem(const AValue: TPdfObjet);
begin
FStream.Add(AValue);
end;

constructor TPdfStream.CreateStream;
begin
inherited Create;
FStream:= TList.Create;
end;

destructor TPdfStream.Destroy;
var
  Cpt: Integer;
begin
if FStream.Count> 0
then
  for Cpt:= 0 to Pred(FStream.Count) do
    if TPdfObjet(FStream[Cpt]) is TPdfFonte
    then
      TPdfFonte(FStream[Cpt]).Free
    else
      if TPdfObjet(FStream[Cpt]) is TPdfColor
      then
        TPdfColor(FStream[Cpt]).Free
      else
        if TPdfObjet(FStream[Cpt]) is TPdfText
        then
          TPdfText(FStream[Cpt]).Free
        else
          if TPdfObjet(FStream[Cpt]) is TPdfRectangle
          then
            TPdfRectangle(FStream[Cpt]).Free
          else
            if TPdfObjet(FStream[Cpt]) is TPdfLigne
            then
              TPdfLigne(FStream[Cpt]).Free
            else
              if TPdfObjet(FStream[Cpt]) is TPdfLineStyle
              then
                TPdfLineStyle(FStream[Cpt]).Free
              else
                if TPdfObjet(FStream[Cpt]) is TPdfSurface
                then
                  TPdfSurface(FStream[Cpt]).Free
                else
                  if TPdfObjet(FStream[Cpt]) is TPdfImage
                  then
                    TPdfImage(FStream[Cpt]).Free;
FStream.Free;
inherited;
end;

procedure TPdfFonte.WriteFonte(const AFlux: TStream);
begin
WriteChaine('/F'+IntToStr(FTxtFont)+' '+FTxtSize+' Tf'+CRLF,AFlux);
end;

constructor TPdfFonte.CreateFonte(const AFont: Integer; const ASize: string);
begin
inherited Create;
FTxtFont:= AFont;
FTxtSize:= ASize;
end;

destructor TPdfFonte.Destroy;
begin
inherited;
end;

procedure TPdfText.WriteText(const AFlux: TStream);
begin
WriteChaine('BT'+CRLF,AFlux);
WriteChaine(FormatFloat('0.##',FTxtPosX)+' '+FormatFloat('0.##',FTxtPosY)+' Td'+CRLF,AFlux);
TPdfString(FTxtText).WriteString(AFlux);
WriteChaine(' Tj'+CRLF,AFlux);
WriteChaine('ET'+CRLF,AFlux);
end;

constructor TPdfText.CreateText(const APosX,APosY: Single; const AText: string);
begin
inherited Create;
FTxtPosX:= APosX;
FTxtPosY:= APosY;
FTxtText:= TPdfString.CreateString(AText);
end;

destructor TPdfText.Destroy;
begin
FTxtText.Free;
inherited;
end;

procedure TPdfLigne.WriteLigne(const AFlux: TStream);
begin
if (FormatFloat('0.##',FEpais)+' w')<> CurrentWidth
then
  begin
  WriteChaine('1 J'+CRLF,AFlux);
  WriteChaine(FormatFloat('0.##',FEpais)+' w'+CRLF,AFlux);
  CurrentWidth:= FormatFloat('0.##',FEpais)+' w';
  end;
WriteChaine(FormatFloat('0.##',FStaX)+' '+FormatFloat('0.##',FStaY)+' m'+CRLF,AFlux);
WriteChaine(FormatFloat('0.##',FEndX)+' '+FormatFloat('0.##',FEndY)+' l'+CRLF,AFlux);
WriteChaine('S'+CRLF,AFlux);
end;

constructor TPdfLigne.CreateLigne(const AEpais,AStaX,AStaY,AEndX,AEndY: Single);
begin
inherited Create;
FEpais:= AEpais;
FStaX:= AStaX;
FStaY:= AStaY;
FEndX:= AEndX;
FEndY:= AEndY;
end;

destructor TPdfLigne.Destroy;
begin
inherited;
end;

procedure TPdfRectangle.WriteRectangle(const AFlux: TStream);
begin
if FStroke
then
  if (FormatFloat('0.##',FEpais)+' w')<> CurrentWidth
  then
    begin
    WriteChaine('1 J'+CRLF,AFlux);
    WriteChaine(FormatFloat('0.##',FEpais)+' w'+CRLF,AFlux);
    CurrentWidth:= FormatFloat('0.##',FEpais)+' w';
    end;
WriteChaine(FormatFloat('0.##',FRecX)+' '+FormatFloat('0.##',FRecY)+' '+FormatFloat('0.##',FRecW)+' '+FormatFloat('0.##',FRecH)+' re'+CRLF,AFlux);
if FStroke
then
  WriteChaine('S'+CRLF,AFlux);
if FFill
then
  WriteChaine('f'+CRLF,AFlux);
end;

constructor TPdfRectangle.CreateRectangle(const AEpais,APosX,APosY,AWidth,AHeight: Single; const AFill,AStroke: Boolean);
begin
inherited Create;
FEpais:= AEpais;
FRecX:= APosX;
FRecY:= APosY;
FRecW:= AWidth;
FRecH:= AHeight;
FFill:= AFill;
FStroke:= AStroke;
end;

destructor TPdfRectangle.Destroy;
begin
inherited;
end;

procedure TPdfSurface.WriteSurface(const AFlux: TStream);
var
  Cpt: Integer;
begin
WriteChaine(FormatFloat('0.##',FPoints[0].X)+' '+FormatFloat('0.##',FPoints[0].Y)+' m'+CRLF,AFlux);
for Cpt:= 1 to Pred(Length(FPoints)) do
  WriteChaine(FormatFloat('0.##',FPoints[Cpt].X)+' '+FormatFloat('0.##',FPoints[Cpt].Y)+' l'+CRLF,AFlux);
WriteChaine('h'+CRLF,AFlux);
WriteChaine('f'+CRLF,AFlux);
end;

constructor TPdfSurface.CreateSurface(const APoints: T_Points);
begin
inherited Create;
FPoints:= APoints;
end;

destructor TPdfSurface.Destroy;
begin
inherited;
end;

function TPdfImage.WriteImageStream(const ANumber: Integer; AFlux: TStream): Int64;
var
  CptW,CptH: Integer;
  BeginFlux,EndFlux: Int64;
begin
WriteChaine(CRLF+'stream'+CRLF,AFlux);
BeginFlux:= AFlux.Position;
for CptH:= 0 to Pred(TfpgImage(Images[ANumber]).Height) do
  for CptW:= 0 to Pred(TfpgImage(Images[ANumber]).Width) do
    begin
    AFlux.WriteByte(fpgGetRed(TfpgImage(Images[ANumber]).Colors[CptW,CptH]));
    AFlux.WriteByte(fpgGetGreen(TfpgImage(Images[ANumber]).Colors[CptW,CptH]));
    AFlux.WriteByte(fpgGetBlue(TfpgImage(Images[ANumber]).Colors[CptW,CptH]));
    end;
EndFlux:= AFlux.Position;
Result:= EndFlux-BeginFlux;
WriteChaine(CRLF,AFlux);
WriteChaine('endstream',AFlux);
end;

procedure TPdfImage.WriteImage(const AFlux: TStream);
begin
WriteChaine('q'+CRLF,AFlux);
WriteChaine(IntToStr(FWidth)+' 0 0 '+IntToStr(FHeight)+' '+FormatFloat('0.##',FLeft)+' '
            +FormatFloat('0.##',FBottom)+' cm'+CRLF,AFlux);
WriteChaine('/I'+IntToStr(FNumber)+' Do '+CRLF,AFlux);
WriteChaine('Q'+CRLF,AFlux);
end;

constructor TPdfImage.CreateImage(const ALeft,ABottom: Single; AWidth,AHeight,ANumber: Integer);
begin
inherited Create;
FNumber:= ANumber;
FLeft:= ALeft;
FBottom:= ABottom;
FWidth:= AWidth;
FHeight:= AHeight;
end;

destructor TPdfImage.Destroy;
begin
inherited;
end;

procedure TPdfLineStyle.WriteLineStyle(const AFlux: TStream);
begin
WriteChaine('[',AFlux);
case FDash of
  lsDash:
    WriteChaine('5 5',AFlux);
  lsDot:
    WriteChaine('2 2',AFlux);
  lsDashDot:
    WriteChaine('5 2 2 2',AFlux);
  lsDashDotDot:
    WriteChaine('5 2 2 2 2 2',AFlux);
  end;
WriteChaine('] '+IntToStr(FPhase)+' d'+CRLF,AFlux);
end;

constructor TPdfLineStyle.CreateLineStyle(ADash: TfpgLineStyle; APhase: Integer);
begin
inherited Create;
FDash:= ADash;
FPhase:= APhase;
end;

destructor TPdfLineStyle.Destroy;
begin
inherited;
end;

procedure TPdfColor.WriteColor(const AFlux: TStream);
begin
if FStroke
then
  begin
  if (FRed+' '+FGreen+' '+FBlue+' rg')<> CurrentColor
  then
    begin
    WriteChaine(FRed+' '+FGreen+' '+FBlue+' rg'+CRLF,AFlux);
    CurrentColor:= FRed+' '+FGreen+' '+FBlue+' rg';
    end;
  end
else
  if (FRed+' '+FGreen+' '+FBlue+' RG')<> CurrentColor
  then
    begin
    WriteChaine(FRed+' '+FGreen+' '+FBlue+' RG'+CRLF,AFlux);
    CurrentColor:= FRed+' '+FGreen+' '+FBlue+' RG';
    end;
end;

constructor TPdfColor.CreateColor(const AStroke: Boolean; Couleur: Longint);
begin
inherited Create;
FBlue:= FormatFloat('0.##',Couleur mod 256/256);
Couleur:= Couleur div 256;
FGreen:= FormatFloat('0.##',Couleur mod 256/256);
FRed:= FormatFloat('0.##',Couleur div 256/256);
FStroke:= AStroke;
end;

destructor TPdfColor.Destroy;
begin
inherited
end;

procedure TPdfDicElement.WriteDicElement(const AFlux: TStream);
begin
FKey.WriteName(AFlux);
WriteChaine(' ',AFlux);
if FValue is TPdfBoolean
then
  TPdfBoolean(FValue).WriteBoolean(AFlux);
if FValue is TPdfInteger
then
  TPdfInteger(FValue).WriteInteger(AFlux);
if FValue is TPdfReference
then
  TPdfReference(FValue).WriteReference(AFlux);
if FValue is TPdfName
then
  TPdfName(FValue).WriteName(AFlux);
if FValue is TPdfString
then
  TPdfString(FValue).WriteString(AFlux);
if FValue is TPdfArray
then<commit_msg>pdf: implementation of TfpgColor to PDF Color was outdated.<commit_after>{
    << Impressions >>  U_Pdf.pas

    Copyright (C) 2010 - JM.Levecque - <<EMAIL>>

   This library is a free software coming as a add-on to fpGUI toolkit
   See the copyright included in the fpGUI distribution for details about redistribution

   This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

    Description:
      This unit produces the pdf file
}

unit U_Pdf;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  fpg_main, fpg_base;

type
  TPdfObjet = class(TObject)
    private
    protected
    public
      constructor Create; virtual;
      destructor Destroy; override;
    end;

  TPdfBoolean = class(TPdfObjet)
    private
      FValue: Boolean;
    protected
      procedure WriteBoolean(const AFlux: TStream);
    public
      constructor CreateBoolean(const AValue: Boolean);
      destructor Destroy; override;
    end;

  TPdfInteger = class(TPdfObjet)
    private
      FValue: Integer;
    protected
      procedure WriteInteger(const AFlux: TStream);
      procedure IncrementeInteger;
      property Value: Integer read FValue write FValue;
    public
      constructor CreateInteger(const AValue: Integer);
      destructor Destroy; override;
    end;

  TPdfReference = class(TPdfObjet)
    private
      FValue: Integer;
    protected
      procedure WriteReference(const AFlux: TStream);
    public
      constructor CreateReference(const AValue: Integer);
      destructor Destroy; override;
    end;

  TPdfName = class(TPdfObjet)
    private
      FValue: string;
    protected
      procedure WriteName(const AFlux: TStream);
    public
      constructor CreateName(const AValue: string);
      destructor Destroy; override;
    end;

  TPdfString = class(TPdfObjet)
    private
      FValue: string;
    protected
      procedure WriteString(const AFlux: TStream);
    public
      constructor CreateString(const AValue: string);
      destructor Destroy; override;
    end;

  TPdfArray = class(TPdfObjet)
    private
      FArray: TList;
    protected
      procedure WriteArray(const AFlux: TStream);
      procedure AddItem(const AValue: TPdfObjet);
    public
      constructor CreateArray;
      destructor Destroy; override;
    end;

  TPdfStream = class(TPdfObjet)
    private
      FStream: TList;
    protected
      procedure WriteStream(const AFlux: TStream);
      procedure AddItem(const AValue: TPdfObjet);
    public
      constructor CreateStream;
      destructor Destroy; override;
    end;

  TPdfFonte = class(TPdfObjet)
    private
      FTxtFont: Integer;
      FTxtSize: string;
    protected
      procedure WriteFonte(const AFlux: TStream);
    public
      constructor CreateFonte(const AFont: Integer; const ASize: string);
      destructor Destroy; override;
    end;

  TPdfText = class(TPdfObjet)
    private
      FTxtPosX: Single;
      FTxtPosY: Single;
      FTxtText: TPdfString;
    protected
      procedure WriteText(const AFlux: TStream);
    public
      constructor CreateText(const APosX,APosY: Single; const AText: string);
      destructor Destroy; override;
    end;

  TPdfLigne = class(TPdfObjet)
    private
      FEpais: Single;
      FStaX: Single;
      FStaY: Single;
      FEndX: Single;
      FEndY: Single;
    protected
      procedure WriteLigne(const AFlux: TStream);
    public
      constructor CreateLigne(const AEpais,AStaX,AStaY,AEndX,AEndY: Single);
      destructor Destroy; override;
    end;

  TPdfRectangle = class(TPdfObjet)
    private
      FEpais: Single;
      FRecX: Single;
      FRecY: Single;
      FRecW: Single;
      FRecH: Single;
      FFill: Boolean;
      FStroke: Boolean;
    protected
      procedure WriteRectangle(const AFlux: TStream);
    public
      constructor CreateRectangle(const AEpais,APosX,APosY,AWidth,AHeight: Single; const AFill,AStroke: Boolean);
      destructor Destroy; override;
    end;

  TRefPos= record
    X: Single;
    Y: Single;
    end;

  T_Points = array of TRefPos;

  TPdfSurface = class(TPdfObjet)
    private
      FPoints: T_Points;
    protected
      procedure WriteSurface(const AFlux: TStream);
    public
      constructor CreateSurface(const APoints: T_Points);
      destructor Destroy; override;
    end;

  TPdfImage = class(TPdfObjet)
    private
      FNumber: Integer;
      FLeft: Single;
      FBottom: Single;
      FWidth: Integer;
      FHeight: Integer;
    protected
      function WriteImageStream(const ANumber: Integer; AFlux: TStream): Int64;
      procedure WriteImage(const AFlux: TStream);
    public
      constructor CreateImage(const ALeft,ABottom: Single; AWidth,AHeight,ANumber: Integer);
      destructor Destroy; override;
    end;

  TPdfLineStyle = class(TPdfObjet)
    private
      FDash: TfpgLineStyle;
      FPhase: Integer;
    protected
      procedure WriteLineStyle(const AFlux: TStream);
    public
      constructor CreateLineStyle(ADash: TfpgLineStyle; APhase: Integer);
      destructor Destroy; override;
    end;

  TPdfColor = class(TPdfObjet)
    private
      FRed: string;
      FGreen: string;
      FBlue: string;
      FStroke: Boolean;
    protected
      procedure WriteColor(const AFlux: TStream);
    public
      constructor CreateColor(const AStroke: Boolean; AColor: TfpgColor);
      destructor Destroy; override;
    end;

  TPdfDicElement = class(TObject)
    private
      FKey: TPdfName;
      FValue: TPdfObjet;
    protected
      procedure WriteDicElement(const AFlux: TStream);
    public
      constructor CreateDicElement(const AKey: string; const AValue: TPdfObjet);
      destructor Destroy; override;
    end;

  TPdfDictionary = class(TPdfObjet)
    private
      FElement: TList; // list of TPdfDicElement
    protected
      procedure AddElement(const AKey: string; const AValue: TPdfObjet);
      function ElementParCle(const AValue: string): Integer;
      procedure WriteDictionary(const AObjet: Integer; const AFlux: TStream);
    public
      constructor CreateDictionary;
      destructor Destroy; override;
    end;

  TPdfXRef = class(TObject)
    private
      FOffset: Integer;
      FObjet: TPdfDictionary;
      FStream: TPdfStream;
    protected
      procedure WriteXRef(const AFlux: TStream);
    public
      constructor CreateXRef;
      destructor Destroy; override;
      property Offset: Integer read FOffset write FOffset;
    end;

  TPdfDocument = class(TObject)
    private
      FXRefObjets: TList; // list of TPdfXRef
    protected
      function ElementParNom(const AValue: string): Integer;
      procedure WriteXRefTable(const AFlux: TStream);
      procedure WriteObjet(const AObjet: Integer; const AFlux: TStream);
      procedure CreateRefTable;
      procedure CreateTrailer;
      function CreateCatalog: Integer;
      procedure CreateInfo;
      procedure CreatePreferences;
      function CreatePages(Parent: Integer): Integer;
      function CreatePage(Parent,Haut,Larg,PageNum: Integer): Integer;
      function CreateOutlines: Integer;
      function CreateOutline(Parent,SectNo,PageNo: Integer; SectTitre: string): Integer;
      procedure CreateFont(NomFonte: string; NumFonte: Integer);
      procedure CreateImage(ImgWidth,ImgHeight,NumImg: Integer);
      function CreateContents: Integer;
      procedure CreateStream(NumeroPage,PageNum: Integer);
    public
      constructor CreateDocument;
      destructor Destroy; override;
      procedure WriteDocument(const AFlux: TStream);
    end;

const
  CRLF= #13#10;
  PDF_VERSION= '%PDF-1.3';
  PDF_FILE_END= '%%EOF';
  PDF_MAX_GEN_NUM= 65535;
  PDF_UNICODE_HEADER = 'FEFF001B%s001B';
  PDF_LANG_STRING = 'fr';

var
  Document: TPdfDocument;
  OldDecSeparator: Char;
  Outline: Boolean;

implementation

uses
  U_Report, U_Command;

var
  Trailer: TPdfDictionary;
  CurrentColor: string;
  CurrentWidth: string;
  Catalogue: Integer;

// utility functions

function InsertEscape(const AValue: string): string;
var
  Chaine: string;
begin
Result:= '';
Chaine:= AValue;
while Pos('\',Chaine)> 0 do
  begin
  Result:= Result+Copy(Chaine,1,Pred(Pos('\',Chaine)))+'\\';
  Chaine:= Copy(Chaine,Succ(Pos('\',Chaine)),Length(Chaine)-Pos('\',Chaine));
  end;
Chaine:= Result+Chaine;
Result:= '';
while Pos('(',Chaine)> 0 do
  begin
  Result:= Result+Copy(Chaine,1,Pred(Pos('(',Chaine)))+'\(';
  Chaine:= Copy(Chaine,Succ(Pos('(',Chaine)),Length(Chaine)-Pos('(',Chaine));
  end;
Chaine:= Result+Chaine;
Result:= '';
while Pos(')',Chaine)> 0 do
  begin
  Result:= Result+Copy(Chaine,1,Pred(Pos(')',Chaine)))+'\)';
  Chaine:= Copy(Chaine,Succ(Pos(')',Chaine)),Length(Chaine)-Pos(')',Chaine));
  end;
Result:= Result+Chaine;
end;

procedure WriteChaine(const Valeur: string; AFlux: TStream);
begin
AFlux.Write(PChar(Valeur)^,Length(Valeur));
end;

function IntToChaine(const Valeur: Integer; const Long: Integer): string;
var
  Chaine: string;
  Cpt: Integer;
begin
Result:= '';
Chaine:= IntToStr(Valeur);
if Length(Chaine)< Long
then
  for Cpt:= Succ(Length(Chaine)) to Long do
    Result:= Result+'0';
Result:= Result+Chaine;
end;

function DateToPdfDate(const ADate: TDateTime): string;
begin
Result:= FormatDateTime('"D:"yyyymmddhhnnss',ADate);
end;

function ExtractBaseFontName(const AValue: string): string;
var
  FontName,Chaine1,Chaine2: string;
begin
FontName:= Uppercase(AValue[1])+Copy(AValue,2,Pos('-',AValue)-2);
if Pos(':',AValue)> 0
then
  begin
  Chaine1:= Copy(AValue,Succ(Pos(':',AValue)),Length(AValue)-Pos(':',AValue));
  Chaine1:= Uppercase(Chaine1[1])+Copy(Chaine1,2,Pred(Length(Chaine1)));
  if Pos(':',Chaine1)> 0
  then
    begin
    Chaine2:= Copy(Chaine1,Succ(Pos(':',Chaine1)),Length(Chaine1)-Pos(':',Chaine1));
    Chaine2:= Uppercase(Chaine2[1])+Copy(Chaine2,2,Pred(Length(Chaine2)));
    if (FontName= 'Helvetica') or (FontName= 'Courier')
    then
      if Chaine2= 'Italic'
      then
        Chaine2:= 'Oblique';
    Chaine1:= Copy(Chaine1,1,Pred(Pos(':',Chaine1)));
    Chaine1:= Uppercase(Chaine1[1])+Copy(Chaine1,2,Pred(Length(Chaine1)));
    if (FontName= 'Helvetica') or (FontName= 'Courier')
    then
      if Chaine1= 'Italic'
      then
        Chaine1:= 'Oblique';
    Chaine1:= Chaine1+Chaine2;
    end
  else
    if (FontName= 'Helvetica') or (FontName= 'Courier')
    then
      if Chaine1= 'Italic'
      then
        Chaine1:= 'Oblique';
  Chaine1:= '-'+Chaine1;
  end;
Result:= FontName+Chaine1;
end;

// object methods

constructor TPdfObjet.Create;
begin
  // to be implemented by descendents
end;

destructor TPdfObjet.Destroy;
begin
inherited;
end;

procedure TPdfBoolean.WriteBoolean(const AFlux: TStream);
begin
if FValue
then
  WriteChaine('true',AFlux)
else
  WriteChaine('false',AFlux);
end;

constructor TPdfBoolean.CreateBoolean(const AValue: Boolean);
begin
inherited Create;
FValue:= AValue;
end;

destructor TPdfBoolean.Destroy;
begin
inherited;
end;

procedure TPdfInteger.WriteInteger(const AFlux: TStream);
begin
WriteChaine(IntToStr(FValue), AFlux);
end;

procedure TPdfInteger.IncrementeInteger;
begin
FValue:= FValue+1;
end;

constructor TPdfInteger.CreateInteger(const AValue: Integer);
begin
inherited Create;
FValue:= AValue;
end;

destructor TPdfInteger.Destroy;
begin
inherited;
end;

procedure TPdfReference.WriteReference(const AFlux: TStream);
begin
WriteChaine(IntToStr(FValue)+' 0 R',AFlux);
end;

constructor TPdfReference.CreateReference(const AValue: Integer);
begin
inherited Create;
FValue:= AValue;
end;

destructor TPdfReference.Destroy;
begin
inherited;
end;

procedure TPdfName.WriteName(const AFlux: TStream);
begin
if FValue<> ''
then
  WriteChaine('/'+FValue,AFlux);
end;

constructor TPdfName.CreateName(const AValue: string);
begin
inherited Create;
FValue:= AValue;
end;

destructor TPdfName.Destroy;
begin
inherited;
end;

procedure TPdfString.WriteString(const AFlux: TStream);
begin
WriteChaine('('+Utf8ToAnsi(FValue)+')',AFlux);
end;

constructor TPdfString.CreateString(const AValue: string);
begin
inherited Create;
FValue:= AValue;
if (Pos('(',FValue)> 0) or (Pos(')',FValue)> 0) or (Pos('\',FValue)> 0)
then
  FValue:= InsertEscape(FValue);
end;

destructor TPdfString.Destroy;
begin
inherited;
end;

procedure TPdfArray.WriteArray(const AFlux: TStream);
var
  Cpt: Integer;
begin
WriteChaine('[',AFlux);
for Cpt:= 0 to Pred(FArray.Count) do
  begin
  if Cpt> 0
  then
    WriteChaine(' ',AFlux);
  if TPdfObjet(FArray[Cpt]) is TPdfInteger
  then
    TPdfInteger(FArray[Cpt]).WriteInteger(AFlux);
  if TPdfObjet(FArray[Cpt]) is TPdfReference
  then
    TPdfReference(FArray[Cpt]).WriteReference(AFlux);
  if TPdfObjet(FArray[Cpt]) is TPdfName
  then
    TPdfName(FArray[Cpt]).WriteName(AFlux);
  end;
WriteChaine(']',AFlux);
end;

procedure TPdfArray.AddItem(const AValue: TPdfObjet);
begin
FArray.Add(AValue);
end;

constructor TPdfArray.CreateArray;
begin
inherited Create;
FArray:= TList.Create;
end;

destructor TPdfArray.Destroy;
var
  Cpt: Integer;
begin
if FArray.Count> 0
then
  for Cpt:= 0 to Pred(FArray.Count) do
    if TPdfObjet(FArray[Cpt]) is TPdfInteger
    then
      TPdfInteger(FArray[Cpt]).Free
    else
      if TPdfObjet(FArray[Cpt]) is TPdfReference
      then
        TPdfReference(FArray[Cpt]).Free
      else
        if TPdfObjet(FArray[Cpt]) is TPdfName
        then
          TPdfName(FArray[Cpt]).Free;
FArray.Free;
inherited;
end;

procedure TPdfStream.WriteStream(const AFlux: TStream);
var
  Cpt: Integer;
begin
for Cpt:= 0 to Pred(FStream.Count) do
  begin
  if TPdfObjet(FStream[Cpt]) is TPdfFonte
  then
    TPdfFonte(FStream[Cpt]).WriteFonte(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfColor
  then
    TPdfColor(FStream[Cpt]).WriteColor(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfText
  then
    TPdfText(FStream[Cpt]).WriteText(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfRectangle
  then
    TPdfRectangle(FStream[Cpt]).WriteRectangle(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfLigne
  then
    TPdfLigne(FStream[Cpt]).WriteLigne(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfLineStyle
  then
    TPdfLineStyle(FStream[Cpt]).WriteLineStyle(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfSurface
  then
    TPdfSurface(FStream[Cpt]).WriteSurface(AFlux);
  if TPdfObjet(FStream[Cpt]) is TPdfImage
  then
    TPdfImage(FStream[Cpt]).WriteImage(AFlux);
  end;
end;

procedure TPdfStream.AddItem(const AValue: TPdfObjet);
begin
FStream.Add(AValue);
end;

constructor TPdfStream.CreateStream;
begin
inherited Create;
FStream:= TList.Create;
end;

destructor TPdfStream.Destroy;
var
  Cpt: Integer;
begin
if FStream.Count> 0
then
  for Cpt:= 0 to Pred(FStream.Count) do
    if TPdfObjet(FStream[Cpt]) is TPdfFonte
    then
      TPdfFonte(FStream[Cpt]).Free
    else
      if TPdfObjet(FStream[Cpt]) is TPdfColor
      then
        TPdfColor(FStream[Cpt]).Free
      else
        if TPdfObjet(FStream[Cpt]) is TPdfText
        then
          TPdfText(FStream[Cpt]).Free
        else
          if TPdfObjet(FStream[Cpt]) is TPdfRectangle
          then
            TPdfRectangle(FStream[Cpt]).Free
          else
            if TPdfObjet(FStream[Cpt]) is TPdfLigne
            then
              TPdfLigne(FStream[Cpt]).Free
            else
              if TPdfObjet(FStream[Cpt]) is TPdfLineStyle
              then
                TPdfLineStyle(FStream[Cpt]).Free
              else
                if TPdfObjet(FStream[Cpt]) is TPdfSurface
                then
                  TPdfSurface(FStream[Cpt]).Free
                else
                  if TPdfObjet(FStream[Cpt]) is TPdfImage
                  then
                    TPdfImage(FStream[Cpt]).Free;
FStream.Free;
inherited;
end;

procedure TPdfFonte.WriteFonte(const AFlux: TStream);
begin
WriteChaine('/F'+IntToStr(FTxtFont)+' '+FTxtSize+' Tf'+CRLF,AFlux);
end;

constructor TPdfFonte.CreateFonte(const AFont: Integer; const ASize: string);
begin
inherited Create;
FTxtFont:= AFont;
FTxtSize:= ASize;
end;

destructor TPdfFonte.Destroy;
begin
inherited;
end;

procedure TPdfText.WriteText(const AFlux: TStream);
begin
WriteChaine('BT'+CRLF,AFlux);
WriteChaine(FormatFloat('0.##',FTxtPosX)+' '+FormatFloat('0.##',FTxtPosY)+' Td'+CRLF,AFlux);
TPdfString(FTxtText).WriteString(AFlux);
WriteChaine(' Tj'+CRLF,AFlux);
WriteChaine('ET'+CRLF,AFlux);
end;

constructor TPdfText.CreateText(const APosX,APosY: Single; const AText: string);
begin
inherited Create;
FTxtPosX:= APosX;
FTxtPosY:= APosY;
FTxtText:= TPdfString.CreateString(AText);
end;

destructor TPdfText.Destroy;
begin
FTxtText.Free;
inherited;
end;

procedure TPdfLigne.WriteLigne(const AFlux: TStream);
begin
if (FormatFloat('0.##',FEpais)+' w')<> CurrentWidth
then
  begin
  WriteChaine('1 J'+CRLF,AFlux);
  WriteChaine(FormatFloat('0.##',FEpais)+' w'+CRLF,AFlux);
  CurrentWidth:= FormatFloat('0.##',FEpais)+' w';
  end;
WriteChaine(FormatFloat('0.##',FStaX)+' '+FormatFloat('0.##',FStaY)+' m'+CRLF,AFlux);
WriteChaine(FormatFloat('0.##',FEndX)+' '+FormatFloat('0.##',FEndY)+' l'+CRLF,AFlux);
WriteChaine('S'+CRLF,AFlux);
end;

constructor TPdfLigne.CreateLigne(const AEpais,AStaX,AStaY,AEndX,AEndY: Single);
begin
inherited Create;
FEpais:= AEpais;
FStaX:= AStaX;
FStaY:= AStaY;
FEndX:= AEndX;
FEndY:= AEndY;
end;

destructor TPdfLigne.Destroy;
begin
inherited;
end;

procedure TPdfRectangle.WriteRectangle(const AFlux: TStream);
begin
if FStroke
then
  if (FormatFloat('0.##',FEpais)+' w')<> CurrentWidth
  then
    begin
    WriteChaine('1 J'+CRLF,AFlux);
    WriteChaine(FormatFloat('0.##',FEpais)+' w'+CRLF,AFlux);
    CurrentWidth:= FormatFloat('0.##',FEpais)+' w';
    end;
WriteChaine(FormatFloat('0.##',FRecX)+' '+FormatFloat('0.##',FRecY)+' '+FormatFloat('0.##',FRecW)+' '+FormatFloat('0.##',FRecH)+' re'+CRLF,AFlux);
if FStroke
then
  WriteChaine('S'+CRLF,AFlux);
if FFill
then
  WriteChaine('f'+CRLF,AFlux);
end;

constructor TPdfRectangle.CreateRectangle(const AEpais,APosX,APosY,AWidth,AHeight: Single; const AFill,AStroke: Boolean);
begin
inherited Create;
FEpais:= AEpais;
FRecX:= APosX;
FRecY:= APosY;
FRecW:= AWidth;
FRecH:= AHeight;
FFill:= AFill;
FStroke:= AStroke;
end;

destructor TPdfRectangle.Destroy;
begin
inherited;
end;

procedure TPdfSurface.WriteSurface(const AFlux: TStream);
var
  Cpt: Integer;
begin
WriteChaine(FormatFloat('0.##',FPoints[0].X)+' '+FormatFloat('0.##',FPoints[0].Y)+' m'+CRLF,AFlux);
for Cpt:= 1 to Pred(Length(FPoints)) do
  WriteChaine(FormatFloat('0.##',FPoints[Cpt].X)+' '+FormatFloat('0.##',FPoints[Cpt].Y)+' l'+CRLF,AFlux);
WriteChaine('h'+CRLF,AFlux);
WriteChaine('f'+CRLF,AFlux);
end;

constructor TPdfSurface.CreateSurface(const APoints: T_Points);
begin
inherited Create;
FPoints:= APoints;
end;

destructor TPdfSurface.Destroy;
begin
inherited;
end;

function TPdfImage.WriteImageStream(const ANumber: Integer; AFlux: TStream): Int64;
var
  CptW,CptH: Integer;
  BeginFlux,EndFlux: Int64;
begin
WriteChaine(CRLF+'stream'+CRLF,AFlux);
BeginFlux:= AFlux.Position;
for CptH:= 0 to Pred(TfpgImage(Images[ANumber]).Height) do
  for CptW:= 0 to Pred(TfpgImage(Images[ANumber]).Width) do
    begin
    AFlux.WriteByte(fpgGetRed(TfpgImage(Images[ANumber]).Colors[CptW,CptH]));
    AFlux.WriteByte(fpgGetGreen(TfpgImage(Images[ANumber]).Colors[CptW,CptH]));
    AFlux.WriteByte(fpgGetBlue(TfpgImage(Images[ANumber]).Colors[CptW,CptH]));
    end;
EndFlux:= AFlux.Position;
Result:= EndFlux-BeginFlux;
WriteChaine(CRLF,AFlux);
WriteChaine('endstream',AFlux);
end;

procedure TPdfImage.WriteImage(const AFlux: TStream);
begin
WriteChaine('q'+CRLF,AFlux);
WriteChaine(IntToStr(FWidth)+' 0 0 '+IntToStr(FHeight)+' '+FormatFloat('0.##',FLeft)+' '
            +FormatFloat('0.##',FBottom)+' cm'+CRLF,AFlux);
WriteChaine('/I'+IntToStr(FNumber)+' Do '+CRLF,AFlux);
WriteChaine('Q'+CRLF,AFlux);
end;

constructor TPdfImage.CreateImage(const ALeft,ABottom: Single; AWidth,AHeight,ANumber: Integer);
begin
inherited Create;
FNumber:= ANumber;
FLeft:= ALeft;
FBottom:= ABottom;
FWidth:= AWidth;
FHeight:= AHeight;
end;

destructor TPdfImage.Destroy;
begin
inherited;
end;

procedure TPdfLineStyle.WriteLineStyle(const AFlux: TStream);
begin
WriteChaine('[',AFlux);
case FDash of
  lsDash:
    WriteChaine('5 5',AFlux);
  lsDot:
    WriteChaine('2 2',AFlux);
  lsDashDot:
    WriteChaine('5 2 2 2',AFlux);
  lsDashDotDot:
    WriteChaine('5 2 2 2 2 2',AFlux);
  end;
WriteChaine('] '+IntToStr(FPhase)+' d'+CRLF,AFlux);
end;

constructor TPdfLineStyle.CreateLineStyle(ADash: TfpgLineStyle; APhase: Integer);
begin
inherited Create;
FDash:= ADash;
FPhase:= APhase;
end;

destructor TPdfLineStyle.Destroy;
begin
inherited;
end;

procedure TPdfColor.WriteColor(const AFlux: TStream);
begin
if FStroke
then
  begin
  if (FRed+' '+FGreen+' '+FBlue+' rg')<> CurrentColor
  then
    begin
    WriteChaine(FRed+' '+FGreen+' '+FBlue+' rg'+CRLF,AFlux);
    CurrentColor:= FRed+' '+FGreen+' '+FBlue+' rg';
    end;
  end
else
  if (FRed+' '+FGreen+' '+FBlue+' RG')<> CurrentColor
  then
    begin
    WriteChaine(FRed+' '+FGreen+' '+FBlue+' RG'+CRLF,AFlux);
    CurrentColor:= FRed+' '+FGreen+' '+FBlue+' RG';
    end;
end;

constructor TPdfColor.CreateColor(const AStroke: Boolean; AColor: TfpgColor);
begin
  inherited Create;
  FBlue := FormatFloat('0.##', fpgGetBlue(AColor)/256);
  FGreen := FormatFloat('0.##', fpgGetGreen(AColor)/256);
  FRed := FormatFloat('0.##', fpgGetRed(AColor)/256);
  FStroke := AStroke;
end;

destructor TPdfColor.Destroy;
begin
inherited
end;

procedure TPdfDicElement.WriteDicElement(const AFlux: TStream);
begin
FKey.WriteName(AFlux);
WriteChaine(' ',AFlux);
if FValue is TPdfBoolean
then
  TPdfBoolean(FValue).WriteBoolean(AFlux);
if FValue is TPdfInteger
then
  TPdfInteger(FValue).WriteInteger(AFlux);
if FValue is TPdfReference
then
  TPdfReference(FValue).WriteReference(AFlux);
if FValue is TPdfName
then
  TPdfName(FValue).WriteName(AFlux);
if FValue is TPdfString
then
  TPdfString(FValue).WriteString(AFlux);
if FValue is TPdfArray
then
{'fraction_non_alphanumeric': 0.12121004409715082, 'fraction_numerical': 0.0072200516370781636, 'mean_word_length': 4.3122951814540595, 'pattern_counts': {'":': 0, '<': 23, '<?xml version=': 0, '>': 43, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6124382', 'n_tokens_mistral': 16346, 'n_tokens_neox': 15478, 'n_words': 3460}