summaryrefslogtreecommitdiff
path: root/extras/contributed/report_tool/reportengine
diff options
context:
space:
mode:
authorGraeme Geldenhuys <graeme@mastermaths.co.za>2012-08-01 16:40:12 +0100
committerGraeme Geldenhuys <graeme@mastermaths.co.za>2012-08-01 16:40:12 +0100
commita9022e83449e8b885d864279b6aa4700753d6746 (patch)
tree6bb77e920703261787ece2cc964ab7d1183ffe0b /extras/contributed/report_tool/reportengine
parent88d248839e06559a24c786b61d64a4d537a2cf46 (diff)
downloadfpGUI-a9022e83449e8b885d864279b6aa4700753d6746.tar.xz
Moves the PDF report engine & demo into the main source tree.
Diffstat (limited to 'extras/contributed/report_tool/reportengine')
-rw-r--r--extras/contributed/report_tool/reportengine/fpg_report.lpk75
-rw-r--r--extras/contributed/report_tool/reportengine/fpg_report.pas14
-rw-r--r--extras/contributed/report_tool/reportengine/images/Adobe_pdf.bmpbin1254 -> 0 bytes
-rwxr-xr-xextras/contributed/report_tool/reportengine/images/Debut.bmpbin822 -> 0 bytes
-rwxr-xr-xextras/contributed/report_tool/reportengine/images/Fermer.bmpbin822 -> 0 bytes
-rwxr-xr-xextras/contributed/report_tool/reportengine/images/Fin.bmpbin822 -> 0 bytes
-rwxr-xr-xextras/contributed/report_tool/reportengine/images/Imprimante.bmpbin1254 -> 0 bytes
-rwxr-xr-xextras/contributed/report_tool/reportengine/images/Imprimer.bmpbin822 -> 0 bytes
-rwxr-xr-xextras/contributed/report_tool/reportengine/images/Precedent.bmpbin822 -> 0 bytes
-rw-r--r--extras/contributed/report_tool/reportengine/images/Preview.bmpbin1254 -> 0 bytes
-rwxr-xr-xextras/contributed/report_tool/reportengine/images/Stop.bmpbin822 -> 0 bytes
-rwxr-xr-xextras/contributed/report_tool/reportengine/images/Suivant.bmpbin822 -> 0 bytes
-rw-r--r--extras/contributed/report_tool/reportengine/lib/i386-linux/placeholder.txt0
-rw-r--r--extras/contributed/report_tool/reportengine/lib/i386-win32/placeholder.txt0
-rw-r--r--extras/contributed/report_tool/reportengine/lib/x86_64-linux/placeholder.txt0
-rw-r--r--extras/contributed/report_tool/reportengine/u_command.pas855
-rw-r--r--extras/contributed/report_tool/reportengine/u_pdf.pas2117
-rw-r--r--extras/contributed/report_tool/reportengine/u_report.pas3078
-rw-r--r--extras/contributed/report_tool/reportengine/u_reportimages.pas181
-rw-r--r--extras/contributed/report_tool/reportengine/u_visu.pas538
20 files changed, 0 insertions, 6858 deletions
diff --git a/extras/contributed/report_tool/reportengine/fpg_report.lpk b/extras/contributed/report_tool/reportengine/fpg_report.lpk
deleted file mode 100644
index 40483c1d..00000000
--- a/extras/contributed/report_tool/reportengine/fpg_report.lpk
+++ /dev/null
@@ -1,75 +0,0 @@
-<?xml version="1.0"?>
-<CONFIG>
- <Package Version="4">
- <Name Value="fpg_report"/>
- <Author Value="Jean-Marc Levecque &lt;jean-marc.levecque@jmlesite.fr>"/>
- <CompilerOptions>
- <Version Value="11"/>
- <SearchPaths>
- <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
- <LCLWidgetType Value="nogui"/>
- </SearchPaths>
- <Parsing>
- <SyntaxOptions>
- <CStyleOperator Value="False"/>
- <AllowLabel Value="False"/>
- <CPPInline Value="False"/>
- <UseAnsiStrings Value="False"/>
- </SyntaxOptions>
- </Parsing>
- <Linking>
- <Debugging>
- <GenerateDebugInfo Value="False"/>
- <UseLineInfoUnit Value="False"/>
- </Debugging>
- </Linking>
- <Other>
- <CompilerMessages>
- <UseMsgFile Value="True"/>
- </CompilerMessages>
- <CompilerPath Value="$(CompPath)"/>
- </Other>
- </CompilerOptions>
- <Description Value="PDF reporting engine"/>
- <License Value="Modified LGPL with static linking exception."/>
- <Version Minor="2"/>
- <Files Count="5">
- <Item1>
- <Filename Value="u_command.pas"/>
- <UnitName Value="U_Command"/>
- </Item1>
- <Item2>
- <Filename Value="u_report.pas"/>
- <UnitName Value="U_Report"/>
- </Item2>
- <Item3>
- <Filename Value="u_pdf.pas"/>
- <UnitName Value="U_Pdf"/>
- </Item3>
- <Item4>
- <Filename Value="u_visu.pas"/>
- <UnitName Value="U_Visu"/>
- </Item4>
- <Item5>
- <Filename Value="u_reportimages.pas"/>
- <UnitName Value="U_ReportImages"/>
- </Item5>
- </Files>
- <RequiredPkgs Count="2">
- <Item1>
- <PackageName Value="fpgui_toolkit"/>
- </Item1>
- <Item2>
- <PackageName Value="FCL"/>
- <MinVersion Major="1" Valid="True"/>
- </Item2>
- </RequiredPkgs>
- <UsageOptions>
- <UnitPath Value="$(PkgOutDir)"/>
- </UsageOptions>
- <PublishOptions>
- <Version Value="2"/>
- <IgnoreBinaries Value="False"/>
- </PublishOptions>
- </Package>
-</CONFIG>
diff --git a/extras/contributed/report_tool/reportengine/fpg_report.pas b/extras/contributed/report_tool/reportengine/fpg_report.pas
deleted file mode 100644
index 9479e685..00000000
--- a/extras/contributed/report_tool/reportengine/fpg_report.pas
+++ /dev/null
@@ -1,14 +0,0 @@
-{ This file was automatically created by Lazarus. Do not edit!
- This source is only used to compile and install the package.
- }
-
-unit fpg_report;
-
-interface
-
-uses
- U_Command, U_Report, U_Pdf, U_Visu, U_ReportImages;
-
-implementation
-
-end.
diff --git a/extras/contributed/report_tool/reportengine/images/Adobe_pdf.bmp b/extras/contributed/report_tool/reportengine/images/Adobe_pdf.bmp
deleted file mode 100644
index ac307f1e..00000000
--- a/extras/contributed/report_tool/reportengine/images/Adobe_pdf.bmp
+++ /dev/null
Binary files differ
diff --git a/extras/contributed/report_tool/reportengine/images/Debut.bmp b/extras/contributed/report_tool/reportengine/images/Debut.bmp
deleted file mode 100755
index 9518137b..00000000
--- a/extras/contributed/report_tool/reportengine/images/Debut.bmp
+++ /dev/null
Binary files differ
diff --git a/extras/contributed/report_tool/reportengine/images/Fermer.bmp b/extras/contributed/report_tool/reportengine/images/Fermer.bmp
deleted file mode 100755
index 68decf1f..00000000
--- a/extras/contributed/report_tool/reportengine/images/Fermer.bmp
+++ /dev/null
Binary files differ
diff --git a/extras/contributed/report_tool/reportengine/images/Fin.bmp b/extras/contributed/report_tool/reportengine/images/Fin.bmp
deleted file mode 100755
index 6e048cf7..00000000
--- a/extras/contributed/report_tool/reportengine/images/Fin.bmp
+++ /dev/null
Binary files differ
diff --git a/extras/contributed/report_tool/reportengine/images/Imprimante.bmp b/extras/contributed/report_tool/reportengine/images/Imprimante.bmp
deleted file mode 100755
index 666a7911..00000000
--- a/extras/contributed/report_tool/reportengine/images/Imprimante.bmp
+++ /dev/null
Binary files differ
diff --git a/extras/contributed/report_tool/reportengine/images/Imprimer.bmp b/extras/contributed/report_tool/reportengine/images/Imprimer.bmp
deleted file mode 100755
index 51115c5b..00000000
--- a/extras/contributed/report_tool/reportengine/images/Imprimer.bmp
+++ /dev/null
Binary files differ
diff --git a/extras/contributed/report_tool/reportengine/images/Precedent.bmp b/extras/contributed/report_tool/reportengine/images/Precedent.bmp
deleted file mode 100755
index cb9a0847..00000000
--- a/extras/contributed/report_tool/reportengine/images/Precedent.bmp
+++ /dev/null
Binary files differ
diff --git a/extras/contributed/report_tool/reportengine/images/Preview.bmp b/extras/contributed/report_tool/reportengine/images/Preview.bmp
deleted file mode 100644
index 8fdad55e..00000000
--- a/extras/contributed/report_tool/reportengine/images/Preview.bmp
+++ /dev/null
Binary files differ
diff --git a/extras/contributed/report_tool/reportengine/images/Stop.bmp b/extras/contributed/report_tool/reportengine/images/Stop.bmp
deleted file mode 100755
index 55ad2e73..00000000
--- a/extras/contributed/report_tool/reportengine/images/Stop.bmp
+++ /dev/null
Binary files differ
diff --git a/extras/contributed/report_tool/reportengine/images/Suivant.bmp b/extras/contributed/report_tool/reportengine/images/Suivant.bmp
deleted file mode 100755
index afe14564..00000000
--- a/extras/contributed/report_tool/reportengine/images/Suivant.bmp
+++ /dev/null
Binary files differ
diff --git a/extras/contributed/report_tool/reportengine/lib/i386-linux/placeholder.txt b/extras/contributed/report_tool/reportengine/lib/i386-linux/placeholder.txt
deleted file mode 100644
index e69de29b..00000000
--- a/extras/contributed/report_tool/reportengine/lib/i386-linux/placeholder.txt
+++ /dev/null
diff --git a/extras/contributed/report_tool/reportengine/lib/i386-win32/placeholder.txt b/extras/contributed/report_tool/reportengine/lib/i386-win32/placeholder.txt
deleted file mode 100644
index e69de29b..00000000
--- a/extras/contributed/report_tool/reportengine/lib/i386-win32/placeholder.txt
+++ /dev/null
diff --git a/extras/contributed/report_tool/reportengine/lib/x86_64-linux/placeholder.txt b/extras/contributed/report_tool/reportengine/lib/x86_64-linux/placeholder.txt
deleted file mode 100644
index e69de29b..00000000
--- a/extras/contributed/report_tool/reportengine/lib/x86_64-linux/placeholder.txt
+++ /dev/null
diff --git a/extras/contributed/report_tool/reportengine/u_command.pas b/extras/contributed/report_tool/reportengine/u_command.pas
deleted file mode 100644
index 16f7b0e0..00000000
--- a/extras/contributed/report_tool/reportengine/u_command.pas
+++ /dev/null
@@ -1,855 +0,0 @@
-{
- << Impressions >> U_Commande.pas
-
- Copyright (C) 2010 - Jean-Marc Levecque <jean-marc.levecque@jmlesite.fr>
-
- 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 builds the objects in memory to produce either the preview or pdf file
-}
-
-unit U_Command;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Classes, SysUtils,
- fpg_base, fpg_main, //fpg_imgfmt_bmp, fpg_imgfmt_jpg,
- U_Pdf;
-
-type
- TZone = (zHeader,zFooter,zPage,zMargins);
- TSectPageNum = (PageNum,SectNum,PSectNum);
- TBorderFlags= set of (bfLeft,bfRight,bfTop,bfBottom);
-
- TDimensions= record
- T: Single;
- L: Single;
- R: Single;
- B: Single;
- end;
-
- TPaper= record
- H: Integer;
- W: Integer;
- Printable: TDimensions;
- end;
-
- // document classes
-
- T_Section = class
- private
- FNumSect: Integer;
- FNbPages: Integer;
- FPaper: TPaper;
- FMargins: TDimensions;
- FBotHead: Single;
- FTopFoot: Single;
- FPages: TList;
- FHeader: TList;
- FFooter: TList;
- FFrames: TList;
- FDefCol: Integer;
- FTitle: string;
- function GetFirstPage: Integer;
- function GetTotalPages: Integer;
- public
- constructor Create(APaper: TPaper; AMargins: TDimensions; ANum: Integer); virtual;
- destructor Destroy; override;
- procedure LoadPage(APageNum: Integer);
- procedure LoadCmdHeader;
- procedure LoadCmdPage;
- procedure LoadCmdFooter;
- procedure LoadCmdGroup;
- procedure LoadCmdGroupToPage;
- procedure LoadSpaceHeader(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer);
- procedure LoadSpacePage(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer);
- procedure LoadSpaceFooter(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer);
- procedure LoadSpaceGroup(AHeight: Single);
- procedure LoadFrame(AStyle: Integer; AZone: TZone);
- procedure LoadLine(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer);
- procedure LoadLineHorizHeader(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer);
- procedure LoadLineHorizPage(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer);
- procedure LoadLineHorizFooter(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer);
- procedure LoadLineHorizGroupe(AHeight: Single);
- procedure LoadSurf(APos: T_Points; AColor: TfpgColor);
- procedure LoadImgHeader(APosX,APosY: Single; AColumn,AImgNum: Integer);
- procedure LoadImgPage(APosX,APosY: Single; AColumn,AImgNum: Integer);
- procedure LoadImgFooter(APosX,APosY: Single; AColumn,AImgNum: Integer);
- function GetCmdPage(NumPage: Integer): TList;
- property CmdHeader: TList read FHeader;
- property CmdFooter: TList read FFooter;
- property NbPages: Integer read FNbPages;
- property FirstPage: Integer read GetFirstPage;
- property Pages: TList read FPages;
- property TotPages: Integer read GetTotalPages;
- property Paper: TPaper read FPaper;
- property Margins: TDimensions read FMargins;
- property CmdFrames: TList read FFrames;
- property DefaultCol: Integer read FDefCol write FDefCol;
- property Title: string read FTitle write FTitle;
- end;
-
- T_Page = class
- private
- FNumPageTot: Integer;
- FNumPageSect: Integer;
- FCommands: TList;
- public
- constructor Create(ANumSec,ANumTot: Integer); virtual;
- destructor Destroy; override;
- property Commands: TList read FCommands write FCommands;
- property PagesTot: Integer read FNumPageTot;
- property PagesSect: Integer read FNumPageSect;
- end;
-
- T_Group = class
- private
- FLineHeight: Single;
- FGroupHeight: Single;
- FCommands: TList;
- public
- constructor Create; virtual;
- destructor Destroy; override;
- property Commands: TList read FCommands write FCommands;
- property LineHeight: Single read FLineHeight;
- property GroupeHeight: Single read FGroupHeight;
- end;
-
- T_WriteLine = class
- private
- FHeight: Integer;
- FCommands: TList;
- public
- constructor Create; virtual;
- destructor Destroy; override;
- procedure LoadText(APosX,APosY: Single; AColumn,AText,AFont,AHeight,ABackColor,ABorder,ALineSpace: Integer;
- ACurFont: Boolean; AFlags: TfpgTextFlags);
- procedure LoadNumber(APosX,APosY: Single; AColumn,ATextNum,ATextTot,AFont,AHeight,ABackColor,ABorder,ALineSpace: Integer;
- ACurFont: Boolean; AFlags: TfpgTextFlags; ATotal,AAlpha: Boolean; ATypeNum: TSectPageNum);
- property Commands: TList read FCommands;
- property LineHeight: Integer read FHeight;
- end;
-
- // command classes
-
- T_Command = class
- end;
-
- PSection = ^T_Section;
- PPage = ^T_Page;
- PLigne = ^T_WriteLine;
- PCommande = ^T_Command;
- PFont = ^TfpgFont;
-
- T_WriteText = class(T_Command)
- private
- FPosX: Single;
- FPosY: Single;
- FColumn: Integer;
- FText: Integer;
- FFont: Integer;
- FBackColor: Integer;
- FBorder: Integer;
- FLineSpace: Integer;
- FCurFont: Boolean;
- FFlags: TfpgTextFlags;
- public
- constructor Create(APosX,APosY: Single; AColumn,AText,AFont,ABackColor,ABorder,ALineSpace: Integer; ACurFont: Boolean; AFlags: TfpgTextFlags); virtual;
- procedure SetPosY(const AValue: Single);
- property GetPosX: Single read FPosX;
- property GetPosY: Single read FPosY;
- property GetColumn: Integer read FColumn;
- property GetText: Integer read FText;
- property GetFont: Integer read FFont;
- property GetBackColor: Integer read FBackColor;
- property GetBorder: Integer read FBorder;
- property GetLineSpace: Integer read FLineSpace;
- property GetCurFont: Boolean read FCurFont;
- property GetFlags: TfpgTextFlags read FFlags;
- end;
-
- T_Number = class(T_Command)
- private
- FPosX: Single;
- FPosY: Single;
- FColumn: Integer;
- FTextNum: Integer;
- FTextTot: Integer;
- FFont: Integer;
- FBackColor: Integer;
- FBorder: Integer;
- FLineSpace: Integer;
- FCurFont: Boolean;
- FFlags: TfpgTextFlags;
- FTotal: Boolean;
- FAlpha: Boolean;
- FTypeNum: TSectPageNum;
- public
- constructor Create(APosX,APosY: Single; AColumn,ATextNum,ATextTot,AFont,ABackColor,ABorder,ALineSpace: Integer;
- ACurFont: Boolean; AFlags: TfpgTextFlags; ATotal,AAlpha: Boolean; ATypeNum: TSectPageNum); virtual;
- procedure SetPosY(const AValue: Single);
- property GetPosX: Single read FPosX;
- property GetPosY: Single read FPosY;
- property GetColumn: Integer read FColumn;
- property GetTextNum: Integer read FTextNum;
- property GetTextTot: Integer read FTextTot;
- property GetFont: Integer read FFont;
- property GetBackColor: Integer read FBackColor;
- property GetBorder: Integer read FBorder;
- property GetLineSpace: Integer read FLineSpace;
- property GetCurFont: Boolean read FCurFont;
- property GetFlags: TfpgTextFlags read FFlags;
- property GetTotal: Boolean read FTotal;
- property GetAlpha: Boolean read FAlpha;
- property GetTypeNum: TSectPageNum read FTypeNum;
- end;
-
- T_Line = class(T_Command)
- private
- FPosX: Single;
- FPosY: Single;
- FColumn: Integer;
- FStyle: Integer;
- FEndX: Single;
- FEndY: Single;
- public
- constructor Create(APosX,APosY: Single; AColumn,AStyle: Integer; AEndX,AEndY: Single); virtual;
- property GetPosX: Single read FPosX;
- property GetPosY: Single read FPosY;
- property GetColumn: Integer read FColumn;
- property GetStyle: Integer read FStyle;
- property GetEndX: Single read FEndX;
- property GetEndY: Single read FEndY;
- end;
-
- T_Column = class(T_Command)
- private
- FPos: Single;
- FWidth: Single;
- FMargin: Single;
- FColor: TfpgColor;
- public
- constructor Create(APos,AWidth,AMargin: Single; AColor: TfpgColor); virtual;
- function GetTextPos: Single;
- function GetTextWidth: Single;
- procedure SetColColor(AColor: TfpgColor);
- property ColPos: Single read FPos write FPos;
- property ColWidth: Single read FWidth write FWidth;
- property ColMargin: Single read FMargin write FMargin;
- property GetColor: TfpgColor read FColor;
- end;
-
- T_Font = class(T_Command)
- private
- FFont: TfpgFont;
- FColor: TfpgColor;
- FSize: string;
- public
- constructor Create(AFont: string; AColor: TfpgColor); virtual;
- destructor Destroy; override;
- function GetHeight: Integer;
- property GetFont: TfpgFont read FFont;
- property GetColor: TfpgColor read FColor;
- property GetSize: string read FSize;
- end;
-
- T_LineSpace = class(T_Command)
- private
- FSup: Single;
- FInt: Single;
- FInf: Single;
- public
- constructor Create(ASup,AInt,AInf: Single); virtual;
- property GetSup: Single read FSup;
- property GetInt: Single read FInt;
- property GetInf: Single read FInf;
- end;
-
- T_Space = class(T_Command)
- private
- FPosY: Single;
- FColumn: Integer;
- FHeight: Single;
- FBackColor: Integer;
- public
- constructor Create(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer); virtual;
- procedure SetPosY(const AValue: Single);
- property GetPosY: Single read FPosY;
- property GetColumn: Integer read FColumn;
- property GetHeight: Single read FHeight;
- property GetBackColor: Integer read FBackColor;
- end;
-
- T_BackColor = class(T_Command)
- private
- FColor: TfpgColor;
- public
- constructor Create(AColor: TfpgColor); virtual;
- property GetColor: TfpgColor read FColor;
- end;
-
- T_LineStyle = class(T_Command)
- private
- FThick: Single;
- FColor: TfpgColor;
- FStyle: TfpgLineStyle;
- public
- constructor Create(AThick: Single; AColor: Tfpgcolor; AStyle: TfpgLineStyle); virtual;
- property GetThick: Single read FThick;
- property GetColor: TfpgColor read FColor;
- property GetStyle: TfpgLineStyle read FStyle;
- end;
-
- T_Border = class(T_Command)
- private
- FFlags: TBorderFlags;
- FStyle: Integer;
- public
- constructor Create(AFlags: TBorderFlags; AStyle: Integer);
- property GetFlags: TBorderFlags read FFlags;
- property GetStyle: Integer read FStyle;
- end;
-
- T_Frame = class(T_Command)
- private
- FStyle: Integer;
- FZone: TZone;
- public
- constructor Create(AStyle: Integer; AZone: TZone);
- property GetStyle: Integer read FStyle;
- property GetZone: TZone read FZone;
- end;
-
- T_Surface = class(T_Command)
- private
- FPoints: T_Points;
- FColor: TfpgColor;
- public
- constructor Create(APoints: array of TRefPos; AColor: TfpgColor);
- property GetPoints: T_Points read FPoints;
- property GetColor: TfpgColor read FColor;
- end;
-
- T_Image = class(T_Command)
- private
- FImage: Integer;
- FColumn: Integer;
- FPosX: Single;
- FPosY: Single;
- public
- constructor Create(APosX,APosY: Single; AColumn,AImageNum: Integer);
- property GetImage: Integer read FImage;
- property GetColumn: Integer read FColumn;
- property GetPosX: Single read FPosX;
- property GetPosY: Single read FPosY;
- end;
-
-var
- Sections: TList;
- Columns: TList;
- Texts: TStringList;
- ImageNames: TStringList;
- Fonts: TList;
- LineSpaces: TList;
- BackColors: TList;
- LineStyles: TList;
- Borders: TList;
- Images: TList;
- VSection: T_Section;
- VPage: T_Page;
- VGroup: T_Group;
- VWriteLine: T_WriteLine;
- VCommand: T_Command;
- VColumn: T_Column;
- VBackColor: T_BackColor;
- VFont: T_Font;
- VLineSpace: T_LineSpace;
- VLineStyle: T_LineStyle;
- VBorder: T_Border;
-
-implementation
-
-// utility functions
-
-// extracts the font size from the fontdesc
-
-function ExtractFontSize(const AValue: string): string;
-begin
-if Pos(':',AValue)> 0
-then
- Result:= Copy(AValue,Succ(Pos('-',AValue)),Pred(Pos(':',Avalue)-Pos('-',AValue)))
-else
- Result:= Copy(AValue,Succ(Pos('-',AValue)),Length(AValue)-Pos('-',AValue));
-end;
-
-// document class methods
-
-function T_Section.GetFirstPage: Integer;
-begin
-Result:= T_Page(Pages[0]).PagesTot;
-end;
-
-function T_Section.GetTotalPages: Integer;
-begin
-if Pages.Count> 0
-then
- Result:= T_Page(Pages[Pred(Pages.Count)]).PagesTot
-else
- Result:= 0;
-end;
-
-constructor T_Section.Create(APaper: TPaper; AMargins: TDimensions; ANum: Integer);
-begin
-FNumSect:= ANum;
-FNbPages:= 0;
-FPaper:= APaper;
-FMargins:= AMargins;
-FBotHead:= FMargins.T;
-FTopFoot:= FMargins.B;
-FPages:= TList.Create;
-FHeader:= TList.Create;
-FFooter:= TList.Create;
-FFrames:= TList.Create;
-end;
-
-destructor T_Section.Destroy;
-var
- Cpt: Integer;
-begin
-if FPages.Count> 0
-then
- for Cpt:= 0 to Pred(FPages.Count) do
- T_Page(FPages[Cpt]).Free;
-FPages.Free;
-if FHeader.Count> 0
-then
- for Cpt:= 0 to Pred(FHeader.Count) do
- T_Command(FHeader[Cpt]).Free;
-FHeader.Free;
-if FFooter.Count> 0
-then
- for Cpt:= 0 to Pred(FFooter.Count) do
- T_Command(FFooter[Cpt]).Free;
-FFooter.Free;
-if FFrames.Count> 0
-then
- for Cpt:= 0 to Pred(FFrames.Count) do
- T_Command(FFrames[Cpt]).Free;
-FFrames.Free;
-inherited Destroy;
-end;
-
-procedure T_Section.LoadPage(APageNum: Integer);
-begin
-Inc(FNbPages);
-VPage:= T_Page.Create(FNbPages,APageNum);
-FPages.Add(VPage);
-end;
-
-procedure T_Section.LoadCmdHeader;
-var
- Cpt: Integer;
-begin
-for Cpt:= 0 to Pred(VWriteLine.Commands.Count) do
- FHeader.Add(VWriteLine.Commands.Items[Cpt]);
-VWriteLine.FHeight:= 0;
-VWriteLine.Commands.Clear;
-end;
-
-procedure T_Section.LoadCmdPage;
-var
- Cpt: Integer;
-begin
-for Cpt:= 0 to Pred(VWriteLine.Commands.Count) do
- T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VWriteLine.Commands.Items[Cpt]);
-VWriteLine.FHeight:= 0;
-VWriteLine.Commands.Clear;
-end;
-
-procedure T_Section.LoadCmdFooter;
-var
- Cpt: Integer;
-begin
-for Cpt:= 0 to Pred(VWriteLine.Commands.Count) do
- FFooter.Add(VWriteLine.Commands.Items[Cpt]);
-VWriteLine.FHeight:= 0;
-VWriteLine.Commands.Clear;
-end;
-
-procedure T_Section.LoadCmdGroup;
-var
- Cpt: Integer;
-begin
-for Cpt:= 0 to Pred(VWriteLine.Commands.Count) do
- VGroup.Commands.Add(VWriteLine.Commands.Items[Cpt]);
-with VGroup do
- begin
- FLineHeight:= VWriteLine.FHeight;
- FGroupHeight:= FGroupHeight+FLineHeight;
- end;
-VWriteLine.FHeight:= 0;
-VWriteLine.Commands.Clear;
-end;
-
-procedure T_Section.LoadCmdGroupToPage;
-var
- Cpt: Integer;
-begin
-for Cpt:= 0 to Pred(VGroup.Commands.Count) do
- T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VGroup.Commands.Items[Cpt]);
-VGroup.FGroupHeight:= 0;
-VGroup.Commands.Clear;
-end;
-
-procedure T_Section.LoadSpaceHeader(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer);
-begin
-VCommand:= T_Space.Create(APosY,AColumn,AHeight,ABackColor);
-FHeader.Add(VCommand);
-end;
-
-procedure T_Section.LoadSpacePage(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer);
-begin
-VCommand:= T_Space.Create(APosY,AColumn,AHeight,ABackColor);
-T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand);
-end;
-
-procedure T_Section.LoadSpaceFooter(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer);
-begin
-VCommand:= T_Space.Create(APosY,AColumn,AHeight,ABackColor);
-FFooter.Add(VCommand);
-end;
-
-procedure T_Section.LoadSpaceGroup(AHeight: Single);
-begin
-VGroup.FGroupHeight:= VGroup.FGroupHeight+AHeight;
-end;
-
-procedure T_Section.LoadFrame(AStyle: Integer; AZone: TZone);
-begin
-VCommand:= T_Frame.Create(AStyle,AZone);
-FFrames.Add(VCommand);
-end;
-
-procedure T_Section.LoadLine(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer);
-begin
-VCommand:= T_Line.Create(APosXBegin,APosYBegin,AColumn,AStyle,APosXEnd,APosYEnd);
-T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand);
-end;
-
-procedure T_Section.LoadLineHorizHeader(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single;
- AStyle: Integer);
-begin
-VCommand:= T_Line.Create(APosXBegin,APosYBegin,AColumn,AStyle,APosXEnd,APosYEnd);
-FHeader.Add(VCommand);
-end;
-
-procedure T_Section.LoadLineHorizPage(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer);
-begin
-VCommand:= T_Line.Create(APosXBegin,APosYBegin,AColumn,AStyle,APosXEnd,APosYEnd);
-T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand);
-end;
-
-procedure T_Section.LoadLineHorizFooter(APosXBegin,APosYBegin: Single; AColumn: Integer; APosXEnd,APosYEnd: Single; AStyle: Integer);
-begin
-VCommand:= T_Line.Create(APosXBegin,APosYBegin,AColumn,AStyle,APosXEnd,APosYEnd);
-FFooter.Add(VCommand);
-end;
-
-procedure T_Section.LoadLineHorizGroupe(AHeight: Single);
-begin
-VGroup.FGroupHeight:= VGroup.FGroupHeight+AHeight;
-end;
-
-procedure T_Section.LoadSurf(APos: T_Points; AColor: TfpgColor);
-begin
-VCommand:= T_Surface.Create(APos,AColor);
-T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand);
-end;
-
-procedure T_Section.LoadImgHeader(APosX,APosY: Single; AColumn,AImgNum: Integer);
-begin
-VCommand:= T_Image.Create(APosX,APosY,AColumn,AImgNum);
-FHeader.Add(VCommand);
-end;
-
-procedure T_Section.LoadImgPage(APosX,APosY: Single; AColumn,AImgNum: Integer);
-begin
-VCommand:= T_Image.Create(APosX,APosY,AColumn,AImgNum);
-T_Page(Pages[Pred(FPages.Count)]).Commands.Add(VCommand);
-end;
-
-procedure T_Section.LoadImgFooter(APosX,APosY: Single; AColumn,AImgNum: Integer);
-begin
-VCommand:= T_Image.Create(APosX,APosY,AColumn,AImgNum);
-FFooter.Add(VCommand);
-end;
-
-function T_Section.GetCmdPage(NumPage: Integer): TList;
-begin
-Result:= T_Page(Pages[Pred(NumPage)]).Commands;
-end;
-
-constructor T_Page.Create(ANumSec,ANumTot: Integer);
-begin
-FNumPageTot:= ANumTot;
-FNumPageSect:= ANumSec;
-FCommands:= TList.Create;
-end;
-
-destructor T_Page.Destroy;
-var
- Cpt: Integer;
-begin
-if FCommands.Count> 0
-then
- for Cpt:= 0 to Pred(FCommands.Count) do
- T_Command(FCommands[Cpt]).Free;
-FCommands.Free;
-inherited Destroy;
-end;
-
-constructor T_Group.Create;
-begin
-FLineHeight:= 0;
-FGroupHeight:= 0;
-FCommands:= TList.Create;
-end;
-
-destructor T_Group.Destroy;
-var
- Cpt: Integer;
-begin
-if FCommands.Count> 0
-then
- for Cpt:= 0 to Pred(FCommands.Count) do
- T_Command(FCommands[Cpt]).Free;
-FCommands.Free;
-inherited Destroy;
-end;
-
-constructor T_WriteLine.Create;
-begin
-FHeight:= 0;
-FCommands:= TList.Create;
-end;
-
-destructor T_WriteLine.Destroy;
-var
- Cpt: Integer;
-begin
-if FCommands.Count> 0
-then
- for Cpt:= 0 to Pred(FCommands.Count) do
- T_Command(FCommands[Cpt]).Free;
-FCommands.Free;
-inherited Destroy;
-end;
-
-procedure T_WriteLine.LoadText(APosX,APosY: Single; AColumn,AText,AFont,AHeight,ABackColor,ABorder,ALineSpace: Integer;
- ACurFont: Boolean; AFlags: TfpgTextFlags);
-begin
-if FHeight< AHeight
-then
- FHeight:= AHeight;
-VCommand:= T_WriteText.Create(APosX,APosY,AColumn,AText,AFont,ABackColor,ABorder,ALineSpace,ACurFont,AFlags);
-Commands.Add(VCommand);
-end;
-
-procedure T_WriteLine.LoadNumber(APosX,APosY: Single; AColumn,ATextNum,ATextTot,AFont,AHeight,ABackColor,ABorder,ALineSpace: Integer;
- ACurFont: Boolean; AFlags: TfpgTextFlags; ATotal,AAlpha: Boolean; ATypeNum: TSectPageNum);
-begin
-if FHeight< AHeight
-then
- FHeight:= AHeight;
-VCommand:= T_Number.Create(APosX,APosY,AColumn,ATextNum,ATextTot,AFont,ABackColor,ABorder,ALineSpace,ACurFont,AFlags,ATotal,AAlpha,ATypeNum);
-Commands.Add(VCommand);
-end;
-
-// command class methods
-
-procedure T_WriteText.SetPosY(const AValue: Single);
-begin
-if FPosY<> AValue
-then
- FPosY:= AValue;
-end;
-
-constructor T_WriteText.Create(APosX,APosY: Single; AColumn,AText,AFont,ABackColor,ABorder,ALineSpace: Integer; ACurFont: Boolean; AFlags: TfpgTextFlags);
-begin
-inherited Create;
-FPosX:= APosX;
-FPosY:= APosY;
-FColumn:= AColumn;
-FText:= AText;
-FFont:= AFont;
-FBackColor:= ABackColor;
-FBorder:= ABorder;
-FLineSpace:= ALineSpace;
-FCurFont:= ACurFont;
-FFlags:= AFlags;
-end;
-
-procedure T_Number.SetPosY(const AValue: Single);
-begin
-if FPosY<> AValue
-then
- FPosY:= AValue;
-end;
-
-constructor T_Number.Create(APosX,APosY: Single; AColumn,ATextNum,ATextTot,AFont,ABackColor,ABorder,ALineSpace: Integer;
- ACurFont: Boolean; AFlags: TfpgTextFlags; ATotal,AAlpha: Boolean; ATypeNum: TSectPageNum);
-begin
-inherited Create;
-FPosX:= APosX;
-FPosY:= APosY;
-FColumn:= AColumn;
-FTextNum:= ATextNum;
-FTextTot:= ATextTot;
-FFont:= AFont;
-FBackColor:= ABackColor;
-FBorder:= ABorder;
-FLineSpace:= ALineSpace;
-FCurFont:= ACurFont;
-FFlags:= AFlags;
-FTotal:= ATotal;
-FAlpha:= AAlpha;
-FTypeNum:= ATypeNum;
-end;
-
-constructor T_Line.Create(APosX,APosY: Single; AColumn,AStyle: Integer; AEndX,AEndY: Single);
-begin
-FPosX:= APosX;
-FPosY:= APosY;
-FColumn:= AColumn;
-FStyle:= AStyle;
-FEndX:= AEndX;
-FEndY:= AEndY;
-end;
-
-constructor T_Column.Create(APos,AWidth,AMargin: Single; AColor: TfpgColor);
-begin
-inherited Create;
-FPos:= APos;
-FWidth:= AWidth;
-FMargin:= AMargin;
-FColor:= AColor;
-end;
-
-function T_Column.GetTextPos: Single;
-begin
-Result:= FPos+FMargin;
-end;
-
-function T_Column.GetTextWidth: Single;
-begin
-Result:= FWidth-(FMargin*2);
-end;
-
-procedure T_Column.SetColColor(AColor: TfpgColor);
-begin
-if FColor<> AColor
-then
- FColor:= AColor;
-end;
-
-constructor T_Font.Create(AFont: string; AColor: TfpgColor);
-begin
-inherited Create;
-FFont:= fpgApplication.GetFont(AFont);
-FColor:= AColor;
-FSize:= ExtractFontSize(AFont);
-end;
-
-destructor T_Font.Destroy;
-begin
-FFont.Free;
-inherited Destroy;
-end;
-
-function T_Font.GetHeight: Integer;
-begin
-Result:= TfpgFont(FFont).Height;
-end;
-
-constructor T_LineSpace.Create(ASup,AInt,AInf: Single);
-begin
-inherited Create;
-FSup:= ASup;
-FInt:= AInt;
-FInf:= AInf;
-end;
-
-constructor T_Space.Create(APosY: Single; AColumn: Integer; AHeight: Single; ABackColor: Integer);
-begin
-inherited Create;
-FPosY:= APosY;
-FColumn:= AColumn;
-FHeight:= AHeight;
-FBackColor:= ABackColor;
-end;
-
-constructor T_Surface.Create(APoints: array of TRefPos; AColor: TfpgColor);
-var
- Cpt: Integer;
-begin
-inherited Create;
-SetLength(FPoints,Length(APoints));
-for Cpt:= 0 to Pred(Length(FPoints)) do
- FPoints[Cpt]:= APoints[Cpt];
-FColor:= AColor;
-end;
-
-procedure T_Space.SetPosY(const AValue: Single);
-begin
-if FPosY<> AValue
-then
- FPosY:= AValue;
-end;
-
-constructor T_BackColor.Create(AColor: TfpgColor);
-begin
-FColor:= AColor;
-end;
-
-constructor T_LineStyle.Create(AThick: Single; AColor: Tfpgcolor; AStyle: TfpgLineStyle);
-begin
-inherited Create;
-FThick:= AThick;
-FColor:= AColor;
-FStyle:= AStyle;
-end;
-
-constructor T_Border.Create(AFlags: TBorderFlags; AStyle: Integer);
-begin
-inherited Create;
-FFlags:= AFlags;
-FStyle:= AStyle;
-end;
-
-constructor T_Frame.Create(AStyle: Integer; AZone: TZone);
-begin
-inherited Create;
-FStyle:= AStyle;
-FZone:= AZone;
-end;
-
-constructor T_Image.Create(APosX,APosY: Single; AColumn,AImageNum: Integer);
-begin
-inherited Create;
-FImage:= AImageNum;
-FColumn:= AColumn;
-FPosX:= APosX;
-FPosY:= APosY;
-end;
-
-end.
-
diff --git a/extras/contributed/report_tool/reportengine/u_pdf.pas b/extras/contributed/report_tool/reportengine/u_pdf.pas
deleted file mode 100644
index 48e3fa92..00000000
--- a/extras/contributed/report_tool/reportengine/u_pdf.pas
+++ /dev/null
@@ -1,2117 +0,0 @@
-{
- << Impressions >> U_Pdf.pas
-
- Copyright (C) 2010 - JM.Levecque - <jmarc.levecque@jmlesite.fr>
-
- 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, StrUtils,
- fpg_main, fpg_base, fpg_dialogs;
-
-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);
- function WriteFonteStream(const FFlux: TMemoryStream; const AFlux: TStream): Int64;
- 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;
-
- TPageLayout= (lSingle,lTwo,lContinuous);
-
- TPdfDocument = class(TObject)
- private
- FPreferences: Boolean;
- FPageLayout: TPageLayout;
- FZoomValue: string;
- 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 CreateStdFont(NomFonte: string; NumFonte: Integer);
- function LoadFont(NomFonte: string): string;
- procedure CreateTtfFont(const NumFonte: Integer);
- procedure CreateTp1Font(const NumFonte: Integer);
- procedure CreateFontDescriptor(const NumFonte: Integer);
- procedure CreateFontWidth;
- procedure CreateFontFile(const NumFonte: Integer);
- procedure CreateImage(ImgWidth,ImgHeight,NumImg: Integer);
- function CreateContents: Integer;
- procedure CreateStream(NumeroPage,PageNum: Integer);
- public
- constructor CreateDocument(const ALayout: TPageLayout= lSingle; const AZoom: string= '100'; const APreferences: Boolean= True);
- destructor Destroy; override;
- procedure WriteDocument(const AFlux: TStream);
- property PageLayout: TPageLayout read FPageLayout write FPageLayout default lSingle;
- end;
-
- TFontDef = record
- FType: string;
- FName: string;
- FAscent: string;
- FDescent: string;
- FCapHeight: string;
- FFlags: string;
- FFontBBox: string;
- FItalicAngle: string;
- FStemV: string;
- FMissingWidth: string;
- FEncoding: string;
- FFile: string;
- FOriginalSize: string;
- FDiffs: widestring;
- FCharWidth: widestring;
- 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;
- FontDirectory: string;
-
-implementation
-
-uses
- U_Report, U_Command;
-
-var
- Trailer: TPdfDictionary;
- CurrentColor: string;
- CurrentWidth: string;
- Catalogue: Integer;
- FontDef: TFontDef;
- Flux: TMemoryStream;
- FontFiles: array of string;
-
-// utility functions
-
-function InsertEscape(const AValue: string): string;
-var
- Chaine: string;
-begin
-Result:= '';
-Chaine:= AValue;
-if Pos('\',Chaine)> 0
-then
- Chaine:= AnsiReplaceStr(Chaine,'\','\\');
-if Pos('(',Chaine)> 0
-then
- Chaine:= AnsiReplaceStr(Chaine,'(','\(');
-if Pos(')',Chaine)> 0
-then
- Chaine:= AnsiReplaceStr(Chaine,')','\)');
-Result:= Chaine;
-//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:= Copy(AValue,1,Pred(Pos('-',AValue)));
-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)));
- Chaine1:= Copy(Chaine1,1,Pred(Pos(':',Chaine1)));
- Chaine1:= Uppercase(Chaine1[1])+Copy(Chaine1,2,Pred(Length(Chaine1)));
- Chaine1:= Chaine1+Chaine2;
- end;
- 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
- if Pos('Length1',FValue)> 0
- then
- WriteChaine('/Length1',AFlux)
- else
- 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;
-
-function TPdfFonte.WriteFonteStream(const FFlux: TMemoryStream; const AFlux: TStream): Int64;
-var
- BeginFlux,EndFlux: Int64;
-begin
-WriteChaine(CRLF+'stream'+CRLF,AFlux);
-BeginFlux:= AFlux.Position;
-FFlux.SaveToStream(AFlux);
-EndFlux:= AFlux.Position;
-Result:= EndFlux-BeginFlux;
-WriteChaine(CRLF,AFlux);
-WriteChaine('endstream',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
- TPdfArray(FValue).WriteArray(AFlux);
-if FValue is TPdfDictionary
-then
- TPdfDictionary(FValue).WriteDictionary(-1,AFlux);
-WriteChaine(CRLF,AFlux);
-end;
-
-constructor TPdfDicElement.CreateDicElement(const AKey: string; const AValue: TPdfObjet);
-begin
-inherited Create;
-FKey:= TPdfName.CreateName(AKey);
-FValue:= AValue;
-end;
-
-destructor TPdfDicElement.Destroy;
-begin
-FKey.Free;
-if FValue is TPdfBoolean
-then
- TPdfBoolean(FValue).Free
-else
- if FValue is TPdfDictionary
- then
- TPdfDictionary(FValue).Free
- else
- if FValue is TPdfInteger
- then
- TPdfInteger(FValue).Free
- else
- if FValue is TPdfName
- then
- TPdfName(FValue).Free
- else
- if FValue is TPdfReference
- then
- TPdfReference(FValue).Free
- else
- if FValue is TPdfString
- then
- TPdfString(FValue).Free
- else
- if FValue is TPdfArray
- then
- TPdfArray(FValue).Free;
-inherited;
-end;
-
-procedure TPdfDictionary.AddElement(const AKey: string; const AValue: TPdfObjet);
-var
- DicElement: TPdfDicElement;
-begin
-DicElement:= TPdfDicElement.CreateDicElement(AKey,AValue);
-FElement.Add(DicElement);
-end;
-
-function TPdfDictionary.ElementParCle(const AValue: string): Integer;
-var
- Cpt: Integer;
-begin
-Result:= -1;
-for Cpt:= 0 to Pred(FElement.Count) do
- if TPdfDicElement(FElement[Cpt]).FKey.FValue= AValue
- then
- begin
- Result:= Cpt;
- Exit;
- end;
-end;
-
-procedure TPdfDictionary.WriteDictionary(const AObjet: Integer; const AFlux: TStream);
-var
- Long: TPdfInteger;
- Cpt,NumImg,NumFnt: Integer;
- Value: string;
-begin
-if TPdfName(TPdfDicElement(FElement[0]).FKey).FValue= ''
-then
- TPdfDicElement(FElement[0]).WriteDicElement(AFlux) // write a charwidth array of a font
-else
- begin
- WriteChaine('<<'+CRLF,AFlux);
- if FElement.Count> 0
- then
- for Cpt:= 0 to Pred(FElement.Count) do
- TPdfDicElement(FElement[Cpt]).WriteDicElement(AFlux);
- NumImg:= -1;
- NumFnt:= -1;
- if FElement.Count> 0
- then
- for Cpt:= 0 to Pred(FElement.Count) do
- if AObjet> -1
- then
- begin
- if (TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue= 'Name')
- then
- if (TPdfObjet(TPdfDicElement(FElement[Cpt]).FValue) is TPdfName)
- and (TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue[1]= 'I')
- then
- begin
- NumImg:= StrToInt(Copy(TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue,2,Length(TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue)-1));
- Flux:= TMemoryStream.Create;
- Flux.Position:= 0;
-// write image stream length in xobject dictionary
- Long:= TPdfInteger.CreateInteger(TPdfImage(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).WriteImageStream(NumImg,Flux));
- TPdfDictionary(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).AddElement('Length',Long);
- TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AFlux);
- Flux.Free;
- WriteChaine('>>',AFlux);
-// write image stream in xobject dictionary
- TPdfImage(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).WriteImageStream(NumImg,AFlux);
- end;
- if Pos('Length1',TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue)> 0
- then
- begin
- Flux:= TMemoryStream.Create;
- Value:= TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue;
- NumFnt:= StrToInt(Copy(Value,Succ(Pos(' ',Value)),Length(Value)-Pos(' ',Value)));
- Flux.LoadFromFile(FontFiles[NumFnt]);
-// write fontfile stream length in xobject dictionary
- Long:= TPdfInteger.CreateInteger(Flux.Size);
- TPdfDictionary(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).AddElement('Length',Long);
- TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AFlux);
- WriteChaine('>>',AFlux);
-// write fontfile stream in xobject dictionary
- TPdfFonte(TPdfXRef(Document.FXRefObjets[NumFnt]).FObjet).WriteFonteStream(Flux,AFlux);
- Flux.Free;
- end;
- end;
- if (NumImg= -1) and (NumFnt= -1)
- then
- WriteChaine('>>',AFlux);
- end;
-end;
-
-constructor TPdfDictionary.CreateDictionary;
-begin
-inherited Create;
-FElement:= TList.Create;
-end;
-
-destructor TPdfDictionary.Destroy;
-var
- Cpt: integer;
-begin
-if FElement.Count> 0
-then
- for Cpt:= 0 to Pred(FElement.Count) do
- TPdfDicElement(FElement[Cpt]).Free;
-FElement.Free;
-inherited;
-end;
-
-procedure TPdfXRef.WriteXRef(const AFlux: TStream);
-begin
-WriteChaine(IntToChaine(FOffset,10)+' '+IntToChaine(0,5)+' n'+CRLF,AFlux);
-end;
-
-constructor TPdfXRef.CreateXRef;
-begin
-inherited Create;
-FOffset:= 0;
-FObjet:= TpdfDictionary.CreateDictionary;
-FStream:= nil;
-end;
-
-destructor TPdfXRef.Destroy;
-begin
-FObjet.Free;
-FStream.Free;
-inherited;
-end;
-
-function TPdfDocument.ElementParNom(const AValue: string): Integer;
-var
- Cpt: Integer;
-begin
-for Cpt:= 1 to Pred(FXRefObjets.Count) do
- if TPdfName(TPdfDicElement(TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet).FElement[0]).FValue).FValue= AValue
- then
- Result:= Cpt;
-end;
-
-procedure TPdfDocument.WriteXRefTable(const AFlux: TStream);
-var
- Cpt: Integer;
-begin
-if FXRefObjets.Count> 1
-then
- for Cpt:= 1 to Pred(FXRefObjets.Count) do
- TPdfXRef(FXRefObjets[Cpt]).WriteXRef(AFlux);
-end;
-
-procedure TPdfDocument.WriteObjet(const AObjet: Integer; const AFlux: TStream);
-var
- Long: TPdfInteger;
- Flux: TMemoryStream;
-begin
-WriteChaine(IntToStr(AObjet)+' 0 obj'+CRLF,AFlux);
-if TPdfXRef(FXRefObjets[AObjet]).FStream= nil
-then
- TPdfDictionary(TPdfXRef(FXRefObjets[AObjet]).FObjet).WriteDictionary(AObjet,AFlux)
-else
- begin
- Flux:= TMemoryStream.Create;
- Flux.Position:= 0;
- CurrentColor:= '';
- CurrentWidth:= '';
- TPdfXRef(FXRefObjets[AObjet]).FStream.WriteStream(Flux);
-// write stream length element in contents dictionary
- Long:= TPdfInteger.CreateInteger(Flux.Size);
- TPdfDictionary(TPdfXRef(FXRefObjets[AObjet]).FObjet).AddElement('Length',Long);
- Flux.Free;
- TPdfXRef(FXRefObjets[AObjet]).FObjet.WriteDictionary(-1,AFlux);
-// write stream in contents dictionary
- CurrentColor:= '';
- CurrentWidth:= '';
- WriteChaine(CRLF+'stream'+CRLF,AFlux);
- TPdfXRef(FXRefObjets[AObjet]).FStream.WriteStream(AFlux);
- WriteChaine('endstream',AFlux);
- end;
-WriteChaine(CRLF+'endobj'+CRLF+CRLF,AFlux);
-end;
-
-procedure TPdfDocument.CreateRefTable;
-var
- XRefObjet: TPdfXRef;
-begin
-FXRefObjets:= TList.Create;
-// add first xref entry
-XRefObjet:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(XRefObjet);
-end;
-
-procedure TPdfDocument.CreateTrailer;
-var
- XRefObjets: TPdfInteger;
-begin
-Trailer:= TPdfDictionary.CreateDictionary;
-// add size trailer element
-XRefObjets:= TPdfInteger.CreateInteger(FXRefObjets.Count);
-Trailer.AddElement('Size',XRefObjets);
-end;
-
-function TPdfDocument.CreateCatalog: Integer;
-var
- Catalog: TPdfXRef;
- XRefObjets: TPdfReference;
- Nom: TPdfName;
- Table: TPdfArray;
-begin
-// add xref entry
-Catalog:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(Catalog);
-// add root trailer element
-XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
-Trailer.AddElement('Root',XRefObjets);
-// add type element to catalog dictionary
-Nom:= TPdfName.CreateName('Catalog');
-Catalog.FObjet.AddElement('Type',Nom);
-// add pagelayout element to catalog dictionary
-case FPageLayout of
- lSingle:
- Nom:= TPdfName.CreateName('SinglePage');
- lTwo:
- Nom:= TPdfName.CreateName('TwoColumnLeft');
- lContinuous:
- Nom:= TPdfName.CreateName('OneColumn');
- end;
-Catalog.FObjet.AddElement('PageLayout',Nom);
-// add openaction element to catalog dictionary
-Table:= TPdfArray.CreateArray;
-Catalog.FObjet.AddElement('OpenAction',Table);
-Result:= Pred(FXRefObjets.Count);
-end;
-
-procedure TPdfDocument.CreateInfo;
-var
- Info: TPdfXRef;
- XRefObjets: TPdfReference;
- Nom: TPdfString;
-begin
-// add xref entry
-Info:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(Info);
-// add info trailer element
-XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
-Trailer.AddElement('Info',XRefObjets);
-TPdfInteger(TPdfDicElement(Trailer.FElement[Trailer.ElementParCle('Size')]).FValue).FValue:= FXRefObjets.Count;
-// add title element to info dictionary
-Nom:= TPdfString.CreateString(Infos.Titre);
-Info.FObjet.AddElement('Title',Nom);
-// add author element to info dictionary
-Nom:= TPdfString.CreateString(Infos.Auteur);
-Info.FObjet.AddElement('Author',Nom);
-// add creator element to info dictionary
-Nom:= TPdfString.CreateString(ApplicationName);
-Info.FObjet.AddElement('Creator',Nom);
-// add producer element to info dictionary
-Nom:= TPdfString.CreateString('fpGUI/FPC');
-Info.FObjet.AddElement('Producer',Nom);
-// add creationdate element to info dictionary
-Nom:= TPdfString.CreateString(DateToPdfDate(Now));
-Info.FObjet.AddElement('CreationDate',Nom);
-end;
-
-procedure TPdfDocument.CreatePreferences;
-var
- Viewer: TPdfXRef;
- XRefObjets: TPdfReference;
- Nom: TPdfName;
- Preference: TPdfBoolean;
-begin
-// add xref entry
-Viewer:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(Viewer);
-// add type element to preferences dictionary
-Nom:= TPdfName.CreateName('ViewerPreferences');
-Viewer.FObjet.AddElement('Type',Nom);
-// add preference element to preferences dictionary
-Preference:= TPdfBoolean.CreateBoolean(True);
-Viewer.FObjet.AddElement('FitWindow',Preference);
-// add preferences reference to catalog dictionary
-XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
-TPdfDictionary(TPdfXRef(FXRefObjets[ElementParNom('Catalog')]).FObjet).AddElement('ViewerPreferences',XRefObjets)
-end;
-
-function TPdfDocument.CreatePages(Parent: Integer): Integer;
-var
- Pages: TPdfXRef;
- XRefObjets: TPdfReference;
- Nom: TPdfName;
- Dictionaire: TPdfDictionary;
- Table: TPdfArray;
- Count: TPdfInteger;
-begin
-// add xref entry
-Pages:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(Pages);
-// add type element to pages dictionary
-Nom:= TPdfName.CreateName('Pages');
-Pages.FObjet.AddElement('Type',Nom);
-// add parent reference to pages dictionary if pages is not the root of the page tree
-if Parent> 0
-then
- begin
- XRefObjets:= TPdfReference.CreateReference(Parent);
- Pages.FObjet.AddElement('Parent',XRefObjets);
- // increment count in parent pages dictionary
- Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[Parent]).FObjet);
- TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger;
- // add kid reference in parent pages dictionary
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Kids')]).FValue).AddItem(XRefObjets);
- end
-else
- begin
- // add pages reference to catalog dictionary
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[ElementParNom('Catalog')]).FObjet).AddElement('Pages',XRefObjets)
- end;
-// add kids element to pages dictionary
-Table:= TPdfArray.CreateArray;
-Pages.FObjet.AddElement('Kids',Table);
-// add count element to pages dictionary
-Count:= TPdfInteger.CreateInteger(0);
-Pages.FObjet.AddElement('Count',Count);
-Result:= Pred(FXRefObjets.Count);
-end;
-
-function TPdfDocument.CreatePage(Parent,Haut,Larg,PageNum: Integer): Integer;
-var
- Page: TPdfXRef;
- XRefObjets: TPdfReference;
- Nom: TPdfName;
- Dictionaire: TPdfDictionary;
- Table: TPdfArray;
- Coord: TPdfInteger;
- Cpt: Integer;
-begin
-// add xref entry
-Page:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(Page);
-// add type element to page dictionary
-Nom:= TPdfName.CreateName('Page');
-Page.FObjet.AddElement('Type',Nom);
-// add parent reference to page dictionary
-XRefObjets:= TPdfReference.CreateReference(Parent);
-Page.FObjet.AddElement('Parent',XRefObjets);
-// increment count in parent pages dictionary
-Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[Parent]).FObjet);
-TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger;
-// add kid reference in parent pages dictionary
-XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
-TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Kids')]).FValue).AddItem(XRefObjets);
-// add mediabox element to page dictionary
-Table:= TPdfArray.CreateArray;
-Page.FObjet.AddElement('MediaBox',Table);
-// add coordinates in page mediabox
-Dictionaire:= TPdfDictionary(TPdfXRef(Page).FObjet);
-Coord:= TPdfInteger.CreateInteger(0);
-TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord);
-Coord:= TPdfInteger.CreateInteger(0);
-TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord);
-Coord:= TPdfInteger.CreateInteger(Larg);
-TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord);
-Coord:= TPdfInteger.CreateInteger(Haut);
-TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord);
-// add resources element to page dictionary
-Dictionaire:= TPdfDictionary.CreateDictionary;
-Page.FObjet.AddElement('Resources',Dictionaire);
-// add procset element in resources element to page dictionary
-Table:= TPdfArray.CreateArray;
-TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('ProcSet',Table);
-// add font element in resources element to page dictionary
-if Fonts.Count> 0
-then
- begin
- Dictionaire:= TPdfDictionary.CreateDictionary;
- TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('Font',Dictionaire);
- end;
-for Cpt:= 0 to Pred(PdfPage.Count) do
- if TPdfElement(PdfPage[Cpt]) is TPdfImg
- then
- if TPdfImg(PdfPage[Cpt]).PageId= PageNum
- then
- begin
-// add xobject element in resources element to page dictionary
- Dictionaire:= TPdfDictionary.CreateDictionary;
- TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('XObject',Dictionaire);
- Break;
- end;
-// add pdf element in procset array to page dictionary
-Dictionaire:= TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue);
-Nom:= TPdfName.CreateName('PDF');
-TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(Nom);
-// add text element in procset array to page dictionary
-Nom:= TPdfName.CreateName('Text');
-TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(Nom);
-// add image element in procset array to page dictionary
-Nom:= TPdfName.CreateName('ImageC');
-TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('ProcSet')]).FValue).AddItem(Nom);
-Result:= Pred(FXRefObjets.Count);
-end;
-
-function TPdfDocument.CreateOutlines: Integer;
-var
- Outlines: TPdfXRef;
- Nom: TPdfName;
- Count: TPdfInteger;
-begin
-// add xref entry
-Outlines:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(Outlines);
-// add type element to outlines dictionary
-Nom:= TPdfName.CreateName('Outlines');
-Outlines.FObjet.AddElement('Type',Nom);
-// add count element to outlines dictionary
-Count:= TPdfInteger.CreateInteger(0);
-Outlines.FObjet.AddElement('Count',Count);
-Result:= Pred(FXRefObjets.Count);
-end;
-
-function TPdfDocument.CreateOutline(Parent,SectNo,PageNo: Integer; SectTitre: string): Integer;
-var
- Outline: TPdfXRef;
- XRefObjets: TPdfReference;
- Titre: TPdfString;
- Count: TPdfInteger;
- Table: TPdfArray;
-begin
-// add xref entry
-Outline:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(Outline);
-// add title element to outline dictionary
-if PageNo> -1
-then
- if SectTitre<> ''
- then
- Titre:= TPdfString.CreateString(SectTitre+' Page '+IntToStr(PageNo))
- else
- Titre:= TPdfString.CreateString('Section '+IntToStr(SectNo)+' Page '+IntToStr(PageNo))
-else
- if SectTitre<> ''
- then
- Titre:= TPdfString.CreateString(SectTitre)
- else
- Titre:= TPdfString.CreateString('Section '+IntToStr(SectNo));
-Outline.FObjet.AddElement('Title',Titre);
-// add parent reference to outline dictionary
-XRefObjets:= TPdfReference.CreateReference(Parent);
-Outline.FObjet.AddElement('Parent',XRefObjets);
-// add count element to outline dictionary
-Count:= TPdfInteger.CreateInteger(0);
-Outline.FObjet.AddElement('Count',Count);
-// add dest element to outline dictionary
-Table:= TPdfArray.CreateArray;
-Outline.FObjet.AddElement('Dest',Table);
-Result:= Pred(FXRefObjets.Count);
-end;
-
-procedure TPdfDocument.CreateStdFont(NomFonte: string; NumFonte: Integer);
-var
- Fontes: TPdfXRef;
- XRefObjets: TPdfReference;
- Nom: TPdfName;
- Dictionaire: TPdfDictionary;
- Cpt: Integer;
-begin
-if Pos('Italic',NomFonte)> 0
-then
- NomFonte:= Copy(NomFonte,1,Pred(Pos('Italic',NomFonte)))+'Oblique';
-// AnsiReplaceText(NomFonte,'Italic','Oblique');
-// add xref entry
-Fontes:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(Fontes);
-// add type element to font dictionary
-Nom:= TPdfName.CreateName('Font');
-Fontes.FObjet.AddElement('Type',Nom);
-// add subtype element to font dictionary
-Nom:= TPdfName.CreateName('Type1');
-Fontes.FObjet.AddElement('Subtype',Nom);
-// add encoding element to font dictionary
-Nom:= TPdfName.CreateName('WinAnsiEncoding');
-Fontes.FObjet.AddElement('Encoding',Nom);
-// add firstchar element to font dictionary
-Nom:= TPdfName.CreateName('32');
-//Nom:= TPdfName.CreateName('0');
-Fontes.FObjet.AddElement('FirstChar',Nom);
-// add lastchar element to font dictionary
-Nom:= TPdfName.CreateName('255');
-Fontes.FObjet.AddElement('LastChar',Nom);
-// add basefont element to font dictionary
-Nom:= TPdfName.CreateName(NomFonte);
-Fontes.FObjet.AddElement('BaseFont',Nom);
-// add name element to font dictionary
-Nom:= TPdfName.CreateName('F'+IntToStr(NumFonte));
-Fontes.FObjet.AddElement('Name',Nom);
-// add font reference to all page dictionary
-for Cpt:= 1 to Pred(FXRefObjets.Count) do
- begin
- Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet);
- if Dictionaire.FElement.Count> 0
- then
- if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue= 'Page'
- then
- begin
- Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue);
- Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Font')]).FValue);
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- Dictionaire.AddElement(TPdfName(Nom).FValue,XRefObjets);
- end;
- end;
-SetLength(FontFiles,Succ(Length(FontFiles)));
-FontFiles[NumFonte]:= '';
-end;
-
-function TPdfDocument.LoadFont(NomFonte: string): string;
-var
- FileTxt: TextFile;
- Ligne: widestring;
-begin
-if FileExists(FontDirectory+NomFonte+'.fnt')
-then
- begin
- AssignFile(FileTxt,FontDirectory+NomFonte+'.fnt');
- Reset(FileTxt);
- while not Eof(FileTxt) do
- begin
- Readln(FileTxt,Ligne);
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'FontType'
- then
- FontDef.FType:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'FontName'
- then
- FontDef.FName:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Ascent'
- then
- FontDef.FAscent:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Descent'
- then
- FontDef.FDescent:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'CapHeight'
- then
- FontDef.FCapHeight:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Flags'
- then
- FontDef.FFlags:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'FontBBox'
- then
- FontDef.FFontBBox:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'ItalicAngle'
- then
- FontDef.FItalicAngle:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'StemV'
- then
- FontDef.FStemV:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'MissingWidth'
- then
- FontDef.FMissingWidth:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Encoding'
- then
- FontDef.FEncoding:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'FontFile'
- then
- FontDef.FFile:= FontDirectory+Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'OriginalSize'
- then
- FontDef.FOriginalSize:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Diffs'
- then
- FontDef.FDiffs:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'CharWidth'
- then
- FontDef.FCharWidth:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne));
- end;
- Result:= FontDef.FType;
- end
-else
- ShowMessage('Font file '+NomFonte+'.fnt not found');
-end;
-
-procedure TPdfDocument.CreateTtfFont(const NumFonte: Integer);
-var
- Fontes: TPdfXRef;
- XRefObjets: TPdfReference;
- Nom: TPdfName;
- Dictionaire: TPdfDictionary;
- Value: TPdfInteger;
- Cpt: Integer;
-begin
-// add xref entry
-Fontes:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(Fontes);
-// add type element to font dictionary
-Nom:= TPdfName.CreateName('Font');
-Fontes.FObjet.AddElement('Type',Nom);
-// add subtype element to font dictionary
-Nom:= TPdfName.CreateName(FontDef.FType);
-Fontes.FObjet.AddElement('Subtype',Nom);
-// add encoding element to font dictionary
-Nom:= TPdfName.CreateName('WinAnsiEncoding');
-Fontes.FObjet.AddElement('Encoding',Nom);
-// add firstchar element to font dictionary
-Value:= TPdfInteger.CreateInteger(32);
-Fontes.FObjet.AddElement('FirstChar',Value);
-// add lastchar element to font dictionary
-Value:= TPdfInteger.CreateInteger(255);
-Fontes.FObjet.AddElement('LastChar',Value);
-// add basefont element to font dictionary
-Nom:= TPdfName.CreateName(FontDef.FName);
-Fontes.FObjet.AddElement('BaseFont',Nom);
-// add name element to font dictionary
-Nom:= TPdfName.CreateName('F'+IntToStr(NumFonte));
-Fontes.FObjet.AddElement('Name',Nom);
-// add font reference to all page dictionary
-for Cpt:= 1 to Pred(FXRefObjets.Count) do
- begin
- Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet);
- if Dictionaire.FElement.Count> 0
- then
- if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue= 'Page'
- then
- begin
- Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue);
- Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Font')]).FValue);
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- Dictionaire.AddElement(TPdfName(Nom).FValue,XRefObjets);
- end;
- end;
-CreateFontDescriptor(NumFonte);
-// add fontdescriptor reference to font dictionary
-XRefObjets:= TPdfReference.CreateReference(FXRefObjets.Count-2);
-Fontes.FObjet.AddElement('FontDescriptor',XRefObjets);
-CreateFontWidth;
-// add fontwidth reference to font dictionary
-XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
-Fontes.FObjet.AddElement('Widths',XRefObjets);
-SetLength(FontFiles,Succ(Length(FontFiles)));
-FontFiles[NumFonte]:= FontDef.FFile;
-end;
-
-procedure TPdfDocument.CreateTp1Font(const NumFonte: Integer);
-begin
-
-end;
-
-procedure TPdfDocument.CreateFontDescriptor(const NumFonte: Integer);
-var
- FtDesc: TPdfXRef;
- XRefObjets: TPdfReference;
- Nom: TPdfName;
- Value: TPdfInteger;
- Table: TPdfArray;
- Dictionaire: TPdfDictionary;
-begin
-// add xref entry
-FtDesc:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(FtDesc);
-// add type element to fontdescriptor dictionary
-Nom:= TPdfName.CreateName('FontDescriptor');
-FtDesc.FObjet.AddElement('Type',Nom);
-// add fontname element to fontdescriptor dictionary
-Nom:= TPdfName.CreateName(FontDef.FName);
-FtDesc.FObjet.AddElement('FontName',Nom);
-// add ascent element to fontdescriptor dictionary
-Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FAscent));
-FtDesc.FObjet.AddElement('Ascent',Value);
-// add descent element to fontdescriptor dictionary
-Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FDescent));
-FtDesc.FObjet.AddElement('Descent',Value);
-// add capheight element to fontdescriptor dictionary
-Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FCapHeight));
-FtDesc.FObjet.AddElement('CapHeight',Value);
-// add flags element to fontdescriptor dictionary
-Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FFlags));
-FtDesc.FObjet.AddElement('Flags',Value);
-// add fontbbox element to fontdescriptor dictionary
-Table:= TPdfArray.CreateArray;
-FtDesc.FObjet.AddElement('FontBBox',Table);
-// add coordinates in page fontbbox
-while Pos(' ',FontDef.FFontBBox)> 0 do
- begin
- Dictionaire:= TPdfDictionary(TPdfXRef(FtDesc).FObjet);
- Value:= TPdfInteger.CreateInteger(StrToInt(Copy(FontDef.FFontBBox,1,Pred(Pos(' ',FontDef.FFontBBox)))));
- TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('FontBBox')]).FValue).AddItem(Value);
- FontDef.FFontBBox:= Copy(FontDef.FFontBBox,Succ(Pos(' ',FontDef.FFontBBox)),Length(FontDef.FFontBBox)-Pos(' ',FontDef.FFontBBox));;
- end;
-// add italicangle element to fontdescriptor dictionary
-Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FItalicAngle));
-FtDesc.FObjet.AddElement('ItalicAngle',Value);
-// add stemv element to fontdescriptor dictionary
-Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FStemV));
-FtDesc.FObjet.AddElement('StemV',Value);
-// add missingwidth element to fontdescriptor dictionary
-Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FMissingWidth));
-FtDesc.FObjet.AddElement('MissingWidth',Value);
-CreateFontFile(NumFonte);
-// add fontfilereference to fontdescriptor dictionary
-XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
-FtDesc.FObjet.AddElement('FontFile2',XRefObjets);
-end;
-
-procedure TPdfDocument.CreateFontWidth;
-var
- FtDesc: TPdfXRef;
- XRefObjets: TPdfReference;
- Value: TPdfInteger;
- Table: TPdfArray;
- Dictionaire: TPdfDictionary;
-begin
-// add xref entry
-FtDesc:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(FtDesc);
-// add element to fontwidth dictionary
-Table:= TPdfArray.CreateArray;
-FtDesc.FObjet.AddElement('',Table);
-// add width values in fontwidth array
-while Pos(' ',FontDef.FCharWidth)> 0 do
- begin
- Dictionaire:= TPdfDictionary(TPdfXRef(FtDesc).FObjet);
- Value:= TPdfInteger.CreateInteger(StrToInt(Copy(FontDef.FCharWidth,1,Pred(Pos(' ',FontDef.FCharWidth)))));
- TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('')]).FValue).AddItem(Value);
- FontDef.FCharWidth:= Copy(FontDef.FCharWidth,Succ(Pos(' ',FontDef.FCharWidth)),Length(FontDef.FCharWidth)-Pos(' ',FontDef.FCharWidth));;
- end;
-end;
-
-procedure TPdfDocument.CreateFontFile(const NumFonte: Integer);
-var
- FtDesc: TPdfXRef;
- XRefObjets: TPdfReference;
- Nom: TPdfName;
- Value: TPdfInteger;
-begin
-// add xref entry
-FtDesc:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(FtDesc);
-// add filter element to fontfile dictionary
-Nom:= TPdfName.CreateName('FlateDecode');
-FtDesc.FObjet.AddElement('Filter',Nom);
-// add length1 element to fontfile dictionary
-Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FOriginalSize));
-FtDesc.FObjet.AddElement('Length1 '+IntToStr(NumFonte),Value);
-end;
-
-procedure TPdfDocument.CreateImage(ImgWidth,ImgHeight,NumImg: Integer);
-var
- Images: TPdfXRef;
- XRefObjets: TPdfReference;
- Nom: TPdfName;
- Dictionaire: TPdfDictionary;
- Long: TPdfInteger;
- Cpt: Integer;
-begin
-// add xref entry
-Images:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(Images);
-// add type element to image dictionary
-Nom:= TPdfName.CreateName('XObject');
-Images.FObjet.AddElement('Type',Nom);
-// add subtype element to image dictionary
-Nom:= TPdfName.CreateName('Image');
-Images.FObjet.AddElement('Subtype',Nom);
-// add width element to image dictionary
-Long:= TPdfInteger.CreateInteger(ImgWidth);
-Images.FObjet.AddElement('Width',Long);
-// add height element to image dictionary
-Long:= TPdfInteger.CreateInteger(ImgHeight);
-Images.FObjet.AddElement('Height',Long);
-// add color space element to image dictionary
-Nom:= TPdfName.CreateName('DeviceRGB');
-Images.FObjet.AddElement('ColorSpace',Nom);
-// add bits per component element to image dictionary
-Long:= TPdfInteger.CreateInteger(8);
-Images.FObjet.AddElement('BitsPerComponent',Long);
-// add name element to image dictionary
-Nom:= TPdfName.CreateName('I'+IntToStr(NumImg));
-Images.FObjet.AddElement('Name',Nom);
-// add image reference to page dictionary
-for Cpt:= 1 to Pred(FXRefObjets.Count) do
- begin
- Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet);
- if Dictionaire.FElement.Count> 0
- then
- if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue= 'Page'
- then
- begin
- Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue);
- if Dictionaire.ElementParCle('XObject')> -1
- then
- begin
- Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('XObject')]).FValue);
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- Dictionaire.AddElement(TPdfName(Nom).FValue,XRefObjets);
- end;
- end;
- end;
-end;
-
-function TPdfDocument.CreateContents: Integer;
-var
- Contents: TPdfXRef;
- XRefObjets: TPdfReference;
- Stream: TPdfStream;
-begin
-// add xref entry
-Contents:= TPdfXRef.CreateXRef;
-FXRefObjets.Add(Contents);
-Stream:= TPdfStream.CreateStream;
-TPdfXRef(FXRefObjets[Pred(FXRefObjets.Count)]).FStream:= Stream;
-// add contents reference to page dictionary
-XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
-TPdfDictionary(TPdfXRef(FXRefObjets[Pred(Pred(FXRefObjets.Count))]).FObjet).AddElement('Contents',XRefObjets);
-Result:= Pred(FXRefObjets.Count);
-end;
-
-procedure TPdfDocument.CreateStream(NumeroPage,PageNum: Integer);
-var
- Cpt: Integer;
- Txt: TPdfText;
- Clr: TPdfColor;
- Fnt: TPdfFonte;
- Rct: TPdfRectangle;
- Lin: TPdfLigne;
- Srf: TPdfSurface;
- Sty: TPdfLineStyle;
- Img: TPdfImage;
-begin
-for Cpt:= 0 to Pred(PdfPage.Count) do
- begin
- if TPdfElement(PdfPage[Cpt]) is TPdfTexte
- then
- if TPdfTexte(PdfPage[Cpt]).PageId= NumeroPage
- then
- with TPdfTexte(PdfPage[Cpt]) do
- begin
- if FontName> -1
- then
- begin
- Fnt:= TPdfFonte.CreateFonte(FontName,FontSize);
-// adjust font size to display device
- Fnt.FTxtSize:= IntToStr(Round((StrToInt(FontSize)*fpgApplication.Screen_dpi_y) div 72));
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Fnt);
- Clr:= TPdfColor.CreateColor(True,Couleur);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr);
- end;
- Txt:= TPdfText.CreateText(TextPosX,TextPosY,Writting);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Txt);
- end;
- if TPdfElement(PdfPage[Cpt]) is TPdfRect
- then
- if TPdfRect(PdfPage[Cpt]).PageId= NumeroPage
- then
- with TPdfRect(PdfPage[Cpt]) do
- begin
- Clr:= TPdfColor.CreateColor(True,RectColor);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr);
- if RectStroke
- then
- begin
- Sty:= TPdfLineStyle.CreateLineStyle(RectLineStyle,0);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Sty);
- end;
- Rct:= TPdfRectangle.CreateRectangle(RectThickness,RectLeft,RectBottom,RectWidth,RectHeight,RectFill,RectStroke);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Rct);
- end;
- if TPdfElement(PdfPage[Cpt]) is TPdfLine
- then
- if TPdfLine(PdfPage[Cpt]).PageId= NumeroPage
- then
- with TPdfLine(PdfPage[Cpt]) do
- begin
- Clr:= TPdfColor.CreateColor(False,LineColor);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr);
- Sty:= TPdfLineStyle.CreateLineStyle(LineStyle,0);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Sty);
- Lin:= TPdfLigne.CreateLigne(LineThikness,LineBeginX,LineBeginY,LineEndX,LineEndY);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Lin);
- end;
- if TPdfElement(PdfPage[Cpt]) is TPdfSurf
- then
- if TPdfSurf(PdfPage[Cpt]).PageId= NumeroPage
- then
- with TPdfSurf(PdfPage[Cpt]) do
- begin
- Clr:= TPdfColor.CreateColor(True,SurfColor);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr);
- Srf:= TPdfSurface.CreateSurface(Points);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Srf);
- end;
- if TPdfElement(PdfPage[Cpt]) is TPdfImg
- then
- if TPdfImg(PdfPage[Cpt]).PageId= NumeroPage
- then
- with TPdfImg(PdfPage[Cpt]) do
- begin
- Img:= TPdfImage.CreateImage(ImgLeft,ImgBottom,ImgWidth,ImgHeight,ImgNumber);
- TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Img);
- end;
- end;
-end;
-
-constructor TPdfDocument.CreateDocument(const ALayout: TPageLayout; const AZoom: string; const APreferences: Boolean);
-var
- Cpt,CptSect,CptPage,NumFont,TreeRoot,ParentPage,PageNum,NumPage: Integer;
- OutlineRoot,ParentOutline,PageOutline,NextOutline,NextSect,NewPage,PrevOutline,PrevSect: Integer;
- Dictionaire: TPdfDictionary;
- XRefObjets: TPdfReference;
- Nom: TPdfName;
- FontName,FtName: string;
-begin
-inherited Create;
-FPreferences:= APreferences;
-FPageLayout:= ALayout;
-FZoomValue:= AZoom;
-CreateRefTable;
-CreateTrailer;
-Catalogue:= CreateCatalog;
-CreateInfo;
-CreatePreferences;
-ParentPage:= 0;
-ParentOutline:= 0;
-if Sections.Count> 1
-then
- begin
- if Outline
- then
- begin
- OutlineRoot:= CreateOutlines;
- // add outline reference to catalog dictionary
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[Catalogue]).FObjet).AddElement('Outlines',XRefObjets);
- // add useoutline element to catalog dictionary
- Nom:= TPdfName.CreateName('UseOutlines');
- TPdfDictionary(TPdfXRef(FXRefObjets[Catalogue]).FObjet).AddElement('PageMode',Nom);
- end;
- TreeRoot:= CreatePages(ParentPage);
- end;
-NumPage:= 0; // page number identical to the call to PrintPage
-for CptSect:= 0 to Pred(Sections.Count) do
- begin
- if Sections.Count> 1
- then
- begin
- if Outline
- then
- begin
- ParentOutline:= CreateOutline(OutlineRoot,Succ(CptSect),-1,T_Section(Sections[CptSect]).Title);
- Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[OutlineRoot]).FObjet);
- TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger;
- if CptSect= 0
- then
- begin
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[OutlineRoot]).FObjet).AddElement('First',XRefObjets);
- NextSect:= ParentOutline;
- PrevSect:= Pred(FXRefObjets.Count);
- end
- else
- begin
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[NextSect]).FObjet).AddElement('Next',XRefObjets);
- XRefObjets:= TPdfReference.CreateReference(PrevSect);
- TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet).AddElement('Prev',XRefObjets);
- NextSect:= ParentOutline;
- if CptSect< Pred(Sections.Count)
- then
- PrevSect:= Pred(FXRefObjets.Count);
- end;
- if CptSect= Pred(Sections.Count)
- then
- begin
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[OutlineRoot]).FObjet).AddElement('Last',XRefObjets);
- end;
- end;
- ParentPage:= CreatePages(TreeRoot);
- end
- else
- ParentPage:= CreatePages(ParentPage);
- for CptPage:= 0 to Pred(T_Section(Sections[CptSect]).Pages.Count) do
- begin
- with T_Section(Sections[CptSect]) do
- NewPage:= CreatePage(ParentPage,Paper.H,Paper.W,Succ(NumPage));
- // add zoom factor to catalog dictionary
- if (CptSect= 0) and (CptPage= 0)
- then
- begin
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[ElementParNom('Catalog')]).FObjet);
- TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('OpenAction')]).FValue).AddItem(XRefObjets);
- Nom:= TPdfName.CreateName('XYZ null null '+FormatFloat('0.##',StrToInt(FZoomValue)/100));
- TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('OpenAction')]).FValue).AddItem(Nom);
- end;
- Inc(NumPage);
- PageNum:= CreateContents; // pagenum = object number in the pdf file
- CreateStream(NumPage,PageNum);
- if (Sections.Count> 1) and Outline
- then
- begin
- PageOutline:= CreateOutline(ParentOutline,Succ(CptSect),Succ(Cptpage),T_Section(Sections[CptSect]).Title);
- Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet);
- TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).IncrementeInteger;
- // add page reference to outline destination
- Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[PageOutline]).FObjet);
- XRefObjets:= TPdfReference.CreateReference(NewPage);
- TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(XRefObjets);
- // add display control name to outline destination
- Nom:= TPdfName.CreateName('Fit');
- TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(Nom);
- if CptPage= 0
- then
- begin
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet).AddElement('First',XRefObjets);
- NextOutline:= PageOutline;
- PrevOutline:= Pred(FXRefObjets.Count);
- // add page reference to parent outline destination
- Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet);
- XRefObjets:= TPdfReference.CreateReference(NewPage);
- TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(XRefObjets);
- // add display control name to outline destination
- Nom:= TPdfName.CreateName('Fit');
- TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Dest')]).FValue).AddItem(Nom);
- end
- else
- begin
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[NextOutline]).FObjet).AddElement('Next',XRefObjets);
- XRefObjets:= TPdfReference.CreateReference(PrevOutline);
- TPdfDictionary(TPdfXRef(FXRefObjets[PageOutline]).FObjet).AddElement('Prev',XRefObjets);
- NextOutline:= PageOutline;
- if CptPage< Pred(T_Section(Sections[CptSect]).Pages.Count)
- then
- PrevOutline:= Pred(FXRefObjets.Count);
- end;
- if CptPage= Pred(T_Section(Sections[CptSect]).Pages.Count)
- then
- begin
- XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count));
- TPdfDictionary(TPdfXRef(FXRefObjets[ParentOutline]).FObjet).AddElement('Last',XRefObjets);
- end;
- end;
- end;
- end;
-if Sections.Count> 1
-then
- begin
- // update count in root parent pages dictionary
- Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[TreeRoot]).FObjet);
- TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).Value:= T_Section(Sections[CptSect]).TotPages;
- end;
-if FontDirectory= ''
-then
- FontDirectory:= ExtractFilePath(Paramstr(0));
-// select the font type
-NumFont:= 0;
-if Fonts.Count> 0
-then
- for Cpt:= 0 to Pred(Fonts.Count) do
- begin
- FontName:= ExtractBaseFontName(T_Font(Fonts[Cpt]).GetFont.FontDesc);
- if Pos('-',FontName)> 0
- then
- FtName:= Copy(FontName,1,Pred(Pos('-',FontName)))
- else
- FtName:= FontName;
- if (Lowercase(FtName)= 'courier') or (Lowercase(FtName)= 'helvetica') or (Lowercase(FtName)= 'times')
- then
- begin
- FontName:= Uppercase(FontName[1])+Copy(FontName,2,Pred(Length(FontName)));
- CreateStdFont(FontName,NumFont);
- end
- else
- if LoadFont(FontName)= 'TrueType'
- then
- CreateTtfFont(NumFont)
- else
- CreateTp1Font(NumFont); // not implemented yet
- Inc(NumFont);
- end;
-if Images.Count> 0
-then
- for Cpt:= 0 to Pred(Images.Count) do
- CreateImage(TfpgImage(Images[Cpt]).Width,TfpgImage(Images[Cpt]).Height,Cpt);
-TPdfInteger(TPdfDicElement(Trailer.FElement[Trailer.ElementParCle('Size')]).FValue).FValue:= FXRefObjets.Count;
-end;
-
-destructor TPdfDocument.Destroy;
-var
- Cpt: Integer;
-begin
-Trailer.Free;
-if FXRefObjets.Count> 0
-then
- for Cpt:= 0 to Pred(FXRefObjets.Count) do
- TPdfXRef(FXRefObjets[Cpt]).Free;
-FXRefObjets.Free;
-inherited;
-end;
-
-procedure TPdfDocument.WriteDocument(const AFlux: TStream);
-var
- Cpt,XRefPos: Integer;
-begin
-AFlux.Position:= 0;
-WriteChaine(PDF_VERSION+CRLF,AFlux);
-// write numbered indirect objects
-for Cpt:= 1 to Pred(FXRefObjets.Count) do
- begin
- XRefPos:= AFlux.Position;
- WriteObjet(Cpt,AFlux);
- TPdfXRef(FXRefObjets[Cpt]).Offset:= XRefPos;
- end;
-XRefPos:= AFlux.Position;
-// write xref table
-WriteChaine('xref'+CRLF+'0 '+IntToStr(FXRefObjets.Count)+CRLF,AFlux);
-with TPdfXRef(FXRefObjets[0]) do
- WriteChaine(IntToChaine(Offset,10)+' '+IntToChaine(PDF_MAX_GEN_NUM,5)+' f'+CRLF,AFlux);
-WriteXRefTable(AFlux);
-// write trailer
-WriteChaine('trailer'+CRLF,AFlux);
-Trailer.WriteDictionary(-1,AFlux);
-// write offset of last xref table
-WriteChaine(CRLF+'startxref'+CRLF+IntToStr(XRefPos)+CRLF,AFlux);
-WriteChaine(PDF_FILE_END,AFlux);
-end;
-
-end.
-
diff --git a/extras/contributed/report_tool/reportengine/u_report.pas b/extras/contributed/report_tool/reportengine/u_report.pas
deleted file mode 100644
index 70179365..00000000
--- a/extras/contributed/report_tool/reportengine/u_report.pas
+++ /dev/null
@@ -1,3078 +0,0 @@
-{
- << Impressions >> U_Report.pas
-
- Copyright (C) 2010 - Jean-Marc Levecque <jean-marc.levecque@jmlesite.fr>
-
- 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 interfaces with the user program
-}
-
-unit U_Report;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Classes, SysUtils, StrUtils,
- fpg_base, fpg_main,
- fpg_panel, fpg_dialogs, fpg_imgfmt_bmp, fpg_imgfmt_jpg,
- U_Command, U_Pdf;
-
-type
- TPaperType= (A4,Letter,Legal,Executive,Comm10,Monarch,DL,C5,B5);
- TOrient= (oPortrait,oLandscape);
- TMeasureUnit = (msMM,msInch);
- TPreparation= (ppPrepare,ppVisualize,ppPdfFile);
-
- T_Report = class(TObject)
- private
- OldSeparator: Char;
- FVersion: Char;
- FPaper: TPaper;
- FPaperType: TPaperType;
- FOrientation: TOrient;
- FCurrentMargin: TDimensions;
- FMeasureUnit: TMeasureUnit;
- FPreparation: TPreparation;
- FVisualization: Boolean;
- FCanvas: TfpgCanvas;
- FCurrentFont: Integer;
- FCurrentLineSpace: Integer;
- FCurrentColor: Integer;
- FNmSection: Integer;
- FNmPage: Integer;
- FNmPageSect: Integer;
- FPosRef: TRefPos; // absolute writting position
- FHeaderHeight: Single; // end of text vertical position in the header
- FPageHeight: Single; // end of text vertical position in the page
- FFooterHeight: Single; // beginning of text vertical position in the footer
- FGroup: Boolean;
- FDefaultFile: string;
- function Dim2Pixels(Value: Single): Single;
- function Pixels2Dim(Value: Single): Single;
- function AddLineBreaks(const Txt: TfpgString; AMaxLineWidth: integer; AFnt: TfpgFont): string;
- function TxtHeight(AWid: Integer; const ATxt: TfpgString; AFnt: TfpgFont; ALSpace: Integer= 2): Integer;
- function Convert2Alpha(Valeur: Integer): string;
- function GetPaperHeight: Integer;
- function GetPaperWidth: Integer;
- procedure Bv_VisuPaint(Sender: TObject);
- procedure PrepareFormat;
- procedure CreateVisu;
- procedure PrintPage(PageNumero: Integer);
- procedure ShiftFooterLines(Shift: Single);
- procedure ShiftPageLines(Shift: Single);
- procedure ShiftGroup(Shift: Single);
- function WriteText(PosX,PosY: Single; Column,Text,FontNum,BkColorNum,BordNum,SpLine: Integer;
- TxtFlags: TfpgTextFlags; Zone: TZone): Single;
- function WriteNumber(PosX,PosY: Single; Column,TextNum,TextTot,FontNum,BkColorNum,BordNum,SpLine: Integer;
- TxtFlags: TfpgTextFlags; Total,Alpha: Boolean; Zone: TZone; SPNum: TSectPageNum): Single;
- function InsertSpace(PosY: Single; Column: Integer; SpaceHeight: Single; BkColorNum: Integer; Zone: TZone): Single;
- procedure LineEnd(Zone: TZone);
- procedure DrawAFrame(StyLine: Integer; Zone: TZone);
- procedure DrawALine(XBegin,YBegin,XEnd,YEnd: Single; StyLine: Integer);
- procedure DrawAHorizLine(XBegin,YBegin: Single; Column: Integer; XEnd: Single; StyLine: Integer; Zone: TZone);
- procedure PaintSurface(Points: T_Points; Couleur: TfpgColor);
- procedure PaintImage(PosX,PosY: Single; Column,ImgNum: Integer; Zone: TZone);
- function GetSectionTitle: string;
- procedure SetSectionTitle(ATitle: string);
- public
- constructor Create;
- destructor Destroy; override;
- procedure BeginWrite(IniOrientation: TOrient= oPortrait; IniPaperType: TPaperType= A4;
- IniMeasure: TMeasureUnit= msMM; IniVersion: Char= 'F'; IniVisu: Boolean= True);
- // starts preview and printing process with initializations
- // IniOrientation = paper orientation >> oPortrait or oLandscape
- // IniPaperType = (A4, Letter,Legal,Executive,Comm10,Monarch,DL,C5,B5)
- // IniMeasure = millimeters (msMM) or inches (msInches)
- // IniVersion = version française 'F' or version English 'E', or other, to come
- // IniVisu = True (Preview) or False (direct printing or PDF generation)
- procedure EndWrite;
- procedure WriteDocument;
- procedure PagePreview;
- procedure Section(MgLeft,MgRight,MgTop,MgBottom: Single; BackPos: Single= 0;
- IniOrientation: TOrient= oPortrait);
- // new section with initialization of margins
- // BackPos = additional margin which can be necessary when frames are drawn
- // IniOrientation = paper orientation >> oPortrait or oLandscape
- procedure Page;
- // new page in the current section
- function BackColor(FdColor: TfpgColor): Integer;
- // returns the number allocated to the color
- // FdColor = background color
- function Font(FtNom: string; FtColor: TfpgColor): Integer;
- // returns the number allocated to the font
- // FtNom = FontDesc of the font
- // FtColor = font color
- function LineStyle(StThick: Single; StColor: Tfpgcolor; StStyle: TfpgLineStyle): Integer;
- // returns the number allocated to the line style
- // StThick = thickness of the line in pixels
- // StColor = line color
- // StStyle = line style
- function Border(BdFlags: TBorderFlags; BdStyle: Integer): Integer;
- // returns the number allocated to the border
- // BdFlags = position of the border (bdTop,bdBottom,bdLeft,bdRight)
- // BdStyle = border line style: thickness, color, style
- function Column(ClnPos,ClnWidth: Single; ClnMargin: Single= 0; ClnColor: TfpgColor= clWhite): Integer;
- // returns the number allocated to the column
- // ClnPos = left position in numeric value in the measurement unit (msMM or msInch)
- // ClnWidth = width in numeric value in the measurement unit (msMM or msInch)
- // ClnMargin = left and right margins in numeric value in the measurement unit (msMM or msInch)
- // ClnColor = column background color
- procedure WriteHeader(Horiz,Verti: Single; Text: string; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1);
- // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight)
- // or numeric value in the measurement unit (msMM or msInch)
- // Verti = line position in column (lnCourante,lnFin)
- // or numeric value in the measurement unit (msMM or msInch)
- // Text = text to be written
- // ColNum = column reference, default between left and right margins
- // FontNum = font reference
- // LineSpNum = space between lines reference
- // BkColorNum = background color reference, if > -1, replaces the column background color if any
- // BordNum = border reference, if > -1
- function WritePage(Horiz,Verti: Single; Text: string; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1): Single;
- // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight)
- // or numeric value in the measurement unit (msMM or msInch)
- // Verti = line position in column (lnCourante,lnFin)
- // or numeric value in the measurement unit (msMM or msInch)
- // Text = text to be written
- // ColNum = column reference, default between left and right margins
- // FontNum = font reference
- // LineSpNum = space between lines reference
- // BkColorNum = background color reference, if > -1, replaces the column background color if any
- // BordNum = border reference, if > -1
- procedure WriteFooter(Horiz,Verti: Single; Text: string; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1);
- // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight)
- // or numeric value in the measurement unit (msMM or msInch)
- // Verti = line position in column (lnCourante,lnFin)
- // or numeric value in the measurement unit (msMM or msInch)
- // Text = text to be written
- // ColNum = column reference, default between left and right margins
- // FontNum = font reference
- // LineSpNum = space between lines reference
- // BkColorNum = background color reference, if > -1, replaces the column background color if any
- // BordNum = border reference, if > -1
- procedure NumSectionHeader(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= '';
- Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1);
- // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight)
- // or numeric value in the measurement unit (msMM or msInch)
- // Verti = line position in column (lnCourante,lnFin)
- // or numeric value in the measurement unit (msMM or msInch)
- // TexteSection = text to be written before the section number
- // TextTot = text to be written before the number of sections
- // Total= True => displays the number of sections
- // Alpha= True => displays the number of sections using letters in alphabetic order
- // ColNum = column reference, default between left and right margins
- // FontNum = font reference
- // LineSpNum = space between lines reference
- // BkColorNum = background color reference, if > -1, replaces the column background color if any
- // BordNum = border reference, if > -1
- procedure NumSectionFooter(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= '';
- Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1);
- // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight)
- // or numeric value in the measurement unit (msMM or msInch)
- // Verti = line position in column (lnCourante,lnFin)
- // or numeric value in the measurement unit (msMM or msInch)
- // TexteSection = text to be written before the section number
- // TextTot = text to be written before the number of sections
- // Total= True => displays the number of sections
- // Alpha= True => displays the number of sections using letters in alphabetic order
- // ColNum = column reference, default between left and right margins
- // FontNum = font reference
- // LineSpNum = space between lines reference
- // BkColorNum = background color reference, if > -1, replaces the column background color if any
- // BordNum = border reference, if > -1
- procedure NumPageHeader(Horiz,Verti: Single; TextePage: string= ''; TextTot: string= '';
- Total: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; LineSpNum: Integer= 0;
- BkColorNum: Integer= -1; BordNum: Integer= -1);
- // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight)
- // or numeric value in the measurement unit (msMM or msInch)
- // Verti = line position in column (lnCourante,lnFin)
- // or numeric value in the measurement unit (msMM or msInch)
- // TextePage = text to be written before the page number in the document
- // TextTot = text to be written before the number of pages of the document
- // Total= True > displays the number of pages of the document
- // ColNum = column reference, default between left and right margins
- // FontNum = font reference
- // LineSpNum = space between lines reference
- // BkColorNum = background color reference, if > -1, replaces the column background color if any
- // BordNum = border reference, if > -1
- procedure NumPageFooter(Horiz,Verti: Single; TextePage: string= ''; TextTot: string= '';
- Total: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; LineSpNum: Integer= 0;
- BkColorNum: Integer= -1; BordNum: Integer= -1);
- // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight)
- // or numeric value in the measurement unit (msMM or msInch)
- // Verti = line position in column (lnCourante,lnFin)
- // or numeric value in the measurement unit (msMM or msInch)
- // TextePage = text to be written before the page number in the document
- // TextTot = text to be written before the number of pages of the document
- // Total= True > displays the number of pages of the document
- // ColNum = column reference, default between left and right margins
- // FontNum = font reference
- // LineSpNum = space between lines reference
- // BkColorNum = background color reference, if > -1, replaces the column background color if any
- // BordNum = border reference, if > -1
- procedure NumPageSectionHeader(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= '';
- Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1);
- // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight)
- // or numeric value in the measurement unit (msMM or msInch)
- // Verti = line position in column (lnCourante,lnFin)
- // or numeric value in the measurement unit (msMM or msInch)
- // TextePage = text to ba written before the page number in the section
- // TextTot = text to be written before the number of pages of the section
- // Total= True > displays the number of pages of the section
- // ColNum = column reference, default between left and right margins
- // FontNum = font reference
- // LineSpNum = space between lines reference
- // BkColorNum = background color reference, if > -1, replaces the column background color if any
- // BordNum = border reference, if > -1
- procedure NumPageSectionFooter(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= '';
- Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1);
- // Horiz = horizontal position in column (cnLeft,cnCenter,cnRight)
- // or numeric value in the measurement unit (msMM or msInch)
- // Verti = line position in column (lnCourante,lnFin)
- // or numeric value in the measurement unit (msMM or msInch)
- // TextePage = text to ba written before the page number in the section
- // TextTot = text to be written before the number of pages of the section
- // Total= True > displays the number of pages of the section
- // ColNum = column reference, default between left and right margins
- // FontNum = font reference
- // LineSpNum = space between lines reference
- // BkColorNum = background color reference, if > -1, replaces the column background color if any
- // BordNum = border reference, if > -1
- procedure HorizLineHeader(SpBefore,SpAfter: Single; ColNum: Integer= 0; StyleNum: Integer= 0);
- // SpBefore = empty space before the horizontal line : numeric value in the measurement unit (msMM or msInch)
- // SpAfter = empty space after the horizontal line : numeric value in the measurement unit (msMM or msInch)
- // ColNum = column reference, default between left and right margins
- // StyleNum = reference of the line style
- procedure HorizLinePage(SpBefore,SpAfter: Single; ColNum: Integer= 0; StyleNum: Integer= 0);
- // SpBefore = empty space before the horizontal line : numeric value in the measurement unit (msMM or msInch)
- // SpAfter = empty space after the horizontal line : numeric value in the measurement unit (msMM or msInch)
- // ColNum = column reference, default between left and right margins
- // StyleNum = reference of the line style
- procedure HorizLineFooter(SpBefore,SpAfter: Single; ColNum: Integer= 0; StyleNum: Integer= 0);
- // SpBefore = empty space before the horizontal line : numeric value in the measurement unit (msMM or msInch)
- // SpAfter = empty space after the horizontal line : numeric value in the measurement unit (msMM or msInch)
- // ColNum = column reference, default between left and right margins
- // StyleNum = reference of the line style
- procedure SpaceHeader(Verti: Single; ColNum: Integer= 0; BkColorNum: Integer= -1);
- // Verti = height of the empty space : numeric value in the measurement unit (msMM or msInch)
- // ColNum = column reference, default between left and right margins
- // BkColorNum = background color reference, if > -1, replaces the column background color if any
- procedure SpacePage(Verti: Single; ColNum: Integer= 0; BkColorNum: Integer= -1);
- // Verti = height of the empty space : numeric value in the measurement unit (msMM or msInch)
- // ColNum = column reference, default between left and right margins
- // BkColorNum = background color reference, if > -1, replaces the column background color if any
- procedure SpaceFooter(Verti: Single; ColNum: Integer= 0; BkColorNum: Integer= -1);
- // Verti = height of the empty space : numeric value in the measurement unit (msMM or msInch)
- // ColNum = column reference, default between left and right margins
- // BkColorNum = background color reference, if > -1, replaces the column background color if any
- function LineSpace(SpSup,SpInt,SpInf: Single): Integer;
- // SpSup = space between lines, top : numeric value in the measurement unit (msMM or msInch)
- // SpInt = space between lines, internal if wrapping : numeric value in the measurement unit (msMM or msInch)
- // SpInf = space between lines, botom : numeric value in the measurement unit (msMM or msInch)
- procedure BeginGroup(PageJump: Boolean= False);
- // PageJump = True >> forces new page before the group
- // = False >> does not create a new page if the whole group can stand on the same page as the preceding text
- procedure EndGroup(PageJump: Boolean= False);
- // PageJump = True >> forces new page after the group
- // = False >> lets continue on the same page after the group
- procedure ColorColChange(ColNum: Integer; ColColor: TfpgColor);
- // Changes the background color of a column
- // ColNum = column reference
- // ColColor = new background color for the column
- procedure FrameMargins(AStyle: Integer);
- // draw a frame at the page margins
- // AStyle = reference of the line style of the frame
- procedure FrameHeader(AStyle: Integer);
- // draw a frame at the limits of the header
- // AStyle = reference of the line style of the frame
- procedure FramePage(AStyle: Integer);
- // draw a frame at the page limits : left and right margins, header bottom and footer top
- // AStyle = reference of the line style of the frame
- procedure FrameFooter(AStyle: Integer);
- // draw a frame at the limits of the footer
- // AStyle = reference of the line style of the frame
- procedure LinePage(XBegin,YBegin,XEnd,YEnd: Single; AStyle: Integer);
- // draw a line at absolute position
- // XBegin = horizontal position of starting point in numeric value in the measurement unit (msMM or msInch)
- // YBegin = vertical position of starting point in numeric value in the measurement unit (msMM or msInch)
- // XEnd = horizontal position of ending point in numeric value in the measurement unit (msMM or msInch)
- // YEnd = vertical position of ending point in numeric value in the measurement unit (msMM or msInch)
- // AStyle = reference of the line style of the line
- procedure SurfPage(XLimits,YLimits: array of Single; AColor: TfpgColor);
- // draw a coloured surface inside the defined limit points
- // XLimits = list of horizontal positions of limit points
- // YLimits = list of vertical positions of limit points
- // AColor = colour to be painted within the limits
- procedure ImageHeader(Horiz,Verti: Single; ImgFileName: string; ColNum: Integer= 0; Scale: Integer= 1);
- // draw a bmp or jpg image at the defined position
- // Horiz = horizontal position in numeric value in the measurement unit (msMM or msInch)
- // Verti = vertical position in numeric value in the measurement unit (msMM or msInch)
- // ImgFileName = name of the image file
- // ColNum = column reference, default between left and right margins
- // Scale = 1 for full size
- // 2 for 1/2 size
- // 3 for 1/3 size
- // 4 for 1/4 size
- procedure ImagePage(Horiz,Verti: Single; ImgFileName: string; ColNum: Integer= 0; Scale: Integer= 1);
- // draw a bmp or jpg image at the defined position
- // Horiz = horizontal position in numeric value in the measurement unit (msMM or msInch)
- // Verti = vertical position in numeric value in the measurement unit (msMM or msInch)
- // ImgFileName = name of the image file
- // ColNum = column reference, default between left and right margins
- // Scale = 1 for full size
- // 2 for 1/2 size
- // 3 for 1/3 size
- // 4 for 1/4 size
- procedure ImageFooter(Horiz,Verti: Single; ImgFileName: string; ColNum: Integer= 0; Scale: Integer= 1);
- // draw a bmp or jpg image at the defined position
- // Horiz = horizontal position in numeric value in the measurement unit (msMM or msInch)
- // Verti = vertical position in numeric value in the measurement unit (msMM or msInch)
- // ImgFileName = name of the image file
- // ColNum = column reference, default between left and right margins
- // Scale = 1 for full size
- // 2 for 1/2 size
- // 3 for 1/3 size
- // 4 for 1/4 size
- property Language: Char read FVersion write FVersion;
- property Visualiser: Boolean read FVisualization write FVisualization;
- property NumSection: Integer read FNmSection write FNmSection;
- property NumPage: Integer read FNmPage write FNmPage;
- property NumPageSection: Integer read FNmPageSect write FNmPageSect;
- property PaperHeight: Integer read GetPaperHeight;
- property PagerWidth: Integer read GetPaperWidth;
- property DefaultFile: string read FDefaultFile write FDefaultFile;
- property CurrentColor: Integer read FCurrentColor write FCurrentColor;
- property SectionTitle: string read GetSectionTitle write SetSectionTitle;
- end;
-
- // classes for interface with PDF generation
-
- TPdfElement = class
- end;
-
- TPdfTexte= class(TPdfElement)
- private
- FPage: Integer;
- FFont: Integer;
- FSize: string;
- FPosX: Single;
- FPosY: Single;
- FWidth: Single;
- FText: string;
- FColor: TfpgColor;
- public
- property PageId: Integer read FPage write FPage;
- property FontName: Integer read FFont write FFont;
- property FontSize: string read FSize write FSize;
- property TextPosX: Single read FPosX write FPosX;
- property TextPosY: Single read FPosY write FPosY;
- property TextWidt: Single read FWidth write FWidth;
- property Writting: string read FText write FText;
- property Couleur: TfpgColor read FColor write FColor;
- end;
-
- TPdfRect = class(TPdfElement)
- private
- FPage: Integer;
- FThick: Single;
- FLeft: Single;
- FBottom: Single;
- FHeight: Single;
- FWidth: Single;
- FColor: TfpgColor;
- FFill: Boolean;
- FStroke: Boolean;
- FLineStyle: TfpgLineStyle;
- protected
- public
- property PageId: Integer read FPage write FPage;
- property RectThickness: Single read FThick write FThick;
- property RectLeft: Single read FLeft write FLeft;
- property RectBottom: Single read FBottom write FBottom;
- property RectHeight: Single read FHeight write FHeight;
- property RectWidth: Single read FWidth write FWidth;
- property RectColor: TfpgColor read FColor write FColor;
- property RectFill: Boolean read FFill write FFill;
- property RectStroke: Boolean read FStroke write FStroke;
- property RectLineStyle: TfpgLineStyle read FLineStyle write FLineStyle;
- end;
-
- TPdfLine = class(TPdfElement)
- private
- FPage: Integer;
- FThick: Single;
- FBeginX: Single;
- FBeginY: Single;
- FEndX: Single;
- FEndY: Single;
- FColor: TfpgColor;
- FStyle: TfpgLineStyle;
- protected
- public
- property PageId: Integer read FPage write FPage;
- property LineThikness: Single read FThick write FThick;
- property LineBeginX: Single read FBeginX write FBeginX;
- property LineBeginY: Single read FBeginY write FBeginY;
- property LineEndX: Single read FEndX write FEndX;
- property LineEndY: Single read FEndY write FEndY;
- property LineColor: TfpgColor read FColor write FColor;
- property LineStyle: TfpgLineStyle read FStyle write FStyle;
- end;
-
- TPdfSurf = class(TPdfElement)
- private
- FPage: Integer;
- FPoints: T_Points;
- FColor: TfpgColor;
- protected
- public
- property PageId: Integer read FPage write FPage;
- property Points: T_Points read FPoints;
- property SurfColor: TfpgColor read FColor write FColor;
- end;
-
- TPdfImg = class(TPdfElement)
- private
- FPage: Integer;
- FNumber: Integer;
- FLeft: Single;
- FBottom: Single;
- FWidth: Integer;
- FHeight: Integer;
- protected
- public
- property PageId: Integer read FPage write FPage;
- property ImgNumber: Integer read FNumber write FNumber;
- property ImgLeft: Single read FLeft write FLeft;
- property ImgBottom: Single read FBottom write FBottom;
- property ImgWidth: Integer read FWidth write FWidth;
- property ImgHeight: Integer read FHeight write FHeight;
- end;
-
-var
- Infos: record
- Titre: string;
- Auteur: string;
- end;
-
- PdfPage: TList;
- PdfTexte: TPdfTexte;
- PdfRect: TPdfRect;
- PdfLine: TPdfLine;
- PdfSurf: TPdfSurf;
- PdfImg: TPdfImg;
-
-const
- PPI= 72;
- FontDefaut= 0;
- ColDefaut= -2;
- lnCurrent= -1;
- lnEnd= -2;
-// cnSuite= -1;
- cnLeft= -2;
- cnCenter= -3;
- cnRight= -4;
-
-implementation
-
-uses
- U_Visu;
-
-const
- InchToMM= 25.4;
-
-function T_Report.Dim2Pixels(Value: Single): Single;
-begin
-if FMeasureUnit= msMM
-then
- Result:= Value*PPI/InchToMM
-else
- Result:= Value*PPI;
-end;
-
-function T_Report.Pixels2Dim(Value: Single): Single;
-begin
-if FMeasureUnit= msMM
-then
- Result:= Value*InchToMM/PPI
-else
- Result:= Value/PPI;
-end;
-
-function T_Report.AddLineBreaks(const Txt: TfpgString; AMaxLineWidth: integer; AFnt: TfpgFont): string;
-var
- i,n,ls: integer;
- sub: string;
- lw,tw: integer;
-begin
-Result:= '';
-ls:= Length(Txt);
-lw:= 0;
-i:= 1;
-while i<= ls do
- begin
- if (Txt[i] in txtWordDelims)
- then // read the delimeter only
- begin
- sub:= Txt[i];
- Inc(i);
- end
- else // read the whole word
- begin
- n:= PosSetEx(txtWordDelims,Txt,i);
- if n> 0
- then
- begin
- sub:= Copy(Txt,i,n-i);
- i:= n;
- end
- else
- begin
- sub:= Copy(Txt,i,MaxInt);
- i:= ls+1;
- end;
- end;
- tw:= AFnt.TextWidth(sub); // wrap if needed
- if (lw+tw> aMaxLineWidth) and (lw> 0)
- then
- begin
- lw:= tw;
- Result:= TrimRight(Result)+sLineBreak;
- end
- else
- Inc(lw,tw);
- Result:= Result+sub;
- end;
-end;
-
-function T_Report.TxtHeight(AWid: Integer; const ATxt: TfpgString; AFnt: TfpgFont; ALSpace: Integer= 2): Integer;
-var
- Cpt: Integer;
- Wraplst: TStringList;
-begin
-Wraplst:= TStringList.Create;
-Wraplst.Text := ATxt;
-for Cpt:= 0 to Pred(Wraplst.Count) do
- Wraplst[Cpt] := AddLineBreaks(Wraplst[Cpt],AWid,AFnt);
-Wraplst.Text := Wraplst.Text;
-Result:= (AFnt.Height*Wraplst.Count)+(ALSpace*Pred(Wraplst.Count));
-WrapLst.Free;
-end;
-
-function T_Report.Convert2Alpha(Valeur: Integer): string;
-var
- Cpt: Byte;
-begin
-Result:= '';
-Cpt:= 0;
-repeat
- if Valeur> 26
- then
- begin
- Valeur:= Valeur-26;
- Inc(Cpt);
- Result:= Chr(Cpt+64);
- end
- else
- begin
- Result:= Chr(Valeur+64);
- Valeur:= 0;
- end;
-until Valeur< 1;
-end;
-
-function T_Report.GetPaperHeight: Integer;
-begin
-Result:= FPaper.H;
-end;
-
-function T_Report.GetPaperWidth: Integer;
-begin
-Result:= FPaper.W;
-end;
-
-procedure T_Report.Bv_VisuPaint(Sender: TObject);
-begin
-PrintPage(NumPage);
-end;
-
-procedure T_Report.PrepareFormat;
-var
- TempH,TempW: Integer;
- TempT,TempL,TempR,TempB: Single;
-begin
-with FPaper do
- begin
- case FPaperType of
- A4:
- begin
- H:= 842;
- W:= 595;
- with Printable do
- begin
- T:= 10;
- L:= 11;
- R:= 586;
- B:= 822;
- end;
- end;
- Letter:
- begin
- H:= 792;
- W:= 612;
- with Printable do
- begin
- T:= 13;
- L:= 13;
- R:= 599;
- B:= 780;
- end;
- end;
- Legal:
- begin
- H:= 1008;
- W:= 612;
- with Printable do
- begin
- T:= 13;
- L:= 13;
- R:= 599;
- B:= 996;
- end;
- end;
- Executive:
- begin
- H:= 756;
- W:= 522;
- with Printable do
- begin
- T:= 14;
- L:= 13;
- R:= 508;
- B:= 744;
- end;
- end;
- Comm10:
- begin
- H:= 684;
- W:= 297;
- with Printable do
- begin
- T:= 13;
- L:= 13;
- R:= 284;
- B:= 672;
- end;
- end;
- Monarch:
- begin
- H:= 540;
- W:= 279;
- with Printable do
- begin
- T:= 13;
- L:= 13;
- R:= 266;
- B:= 528;
- end;
- end;
- DL:
- begin
- H:= 624;
- W:= 312;
- with Printable do
- begin
- T:= 14;
- L:= 13;
- R:= 297;
- B:= 611;
- end;
- end;
- C5:
- begin
- H:= 649;
- W:= 459;
- with Printable do
- begin
- T:= 13;
- L:= 13;
- R:= 446;
- B:= 637;
- end;
- end;
- B5:
- begin
- H:= 708;
- W:= 499;
- with Printable do
- begin
- T:= 14;
- L:= 13;
- R:= 485;
- B:= 696;
- end;
- end;
- end;
- if FOrientation= oLandscape
- then
- begin
- TempH:= H;
- TempW:= W;
- H:= TempW;
- W:= TempH;
- with Printable do
- begin
- TempT:= T;
- TempL:= L;
- TempR:= R;
- TempB:= B;
- T:= TempL;
- L:= TempT;
- R:= TempB;
- B:= TempR;
- end;
- end;
- end;
-end;
-
-procedure T_Report.CreateVisu;
-begin
-F_Visu:= TF_Visu.Create(nil, self);
-with F_Visu do
- begin
- Bv_Visu:= CreateBevel(F_Visu,(F_Visu.Width-FPaper.W) div 2,((F_Visu.Height+50-FPaper.H) div 2),
- FPaper.W,FPaper.H,bsBox,bsRaised);
- Bv_Visu.BackgroundColor:= clWhite;
- Bv_Visu.OnPaint:= @Bv_VisuPaint;
- end;
-end;
-
-procedure T_Report.PrintPage(PageNumero: Integer);
-var
- CptSect,CptPage,CptCmd: Integer;
- ThePage: T_Page;
- Cmd: T_Command;
-begin
-CptSect:= 0;
-repeat
- Inc(CptSect);
- CptPage:= 0;
- with T_Section(Sections[Pred(CptSect)]) do
- repeat
- Inc(CptPage);
- ThePage:= T_Page(Pages.Items[Pred(CptPage)]);
- until (ThePage.PagesTot= PageNumero) or (CptPage= Pages.Count);
-until (ThePage.PagesTot= PageNumero) or (CptSect= Sections.Count);
-NumPage:= PageNumero;
-NumSection:= CptSect;
-NumPageSection:= ThePage.PagesSect;
-with T_Section(Sections[Pred(NumSection)]) do
- begin
- if CmdHeader.Count> 0
- then
- for CptCmd:= 0 to Pred(CmdHeader.Count) do
- begin
- Cmd:= T_Command(CmdHeader.Items[CptCmd]);
- if Cmd is T_WriteText
- then
- with Cmd as T_WriteText do
- WriteText(GetPosX,GetPosY,GetColumn,GetText,GetFont,GetBackColor,GetBorder,GetLineSpace,GetFlags,ZHeader);
- if Cmd is T_Number
- then
- with Cmd as T_Number do
- WriteNumber(GetPosX,GetPosY,GetColumn,GetTextNum,GetTextTot,GetFont,GetBackColor,GetBorder,GetLineSpace,
- GetFlags,GetTotal,GetAlpha,zHeader,GetTypeNum);
- if Cmd is T_Space
- then
- with Cmd as T_Space do
- InsertSpace(GetPosY,GetColumn,GetHeight,GetBackColor,zHeader);
- if Cmd is T_Line
- then
- with Cmd as T_Line do
- DrawALine(GetPosX,GetPosY,GetEndX,GetEndY,GetStyle);
- if Cmd is T_Image
- then
- with Cmd as T_Image do
- PaintImage(GetPosX,GetPosY,GetColumn,GetImage,zHeader);
- end;
- if GetCmdPage(NumPageSection).Count> 0
- then
- for CptCmd:= 0 to Pred(GetCmdPage(NumPageSection).Count) do
- begin
- Cmd:= T_Command(GetCmdPage(NumPageSection).Items[CptCmd]);
- if Cmd is T_WriteText
- then
- with Cmd as T_WriteText do
- WriteText(GetPosX,GetPosY,GetColumn,GetText,GetFont,GetBackColor,GetBorder,GetLineSpace,GetFlags,ZPage);
- if Cmd is T_Space
- then
- with Cmd as T_Space do
- InsertSpace(GetPosY,GetColumn,GetHeight,GetBackColor,zPage);
- if Cmd is T_Line
- then
- with Cmd as T_Line do
- DrawALine(GetPosX,GetPosY,GetEndX,GetEndY,GetStyle);
- if Cmd is T_Surface
- then
- with Cmd as T_Surface do
- PaintSurface(GetPoints,GetColor);
- if Cmd is T_Image
- then
- with Cmd as T_Image do
- PaintImage(GetPosX,GetPosY,GetColumn,GetImage,zPage);
- end;
- if CmdFooter.Count> 0
- then
- for CptCmd:= 0 to Pred(CmdFooter.Count) do
- begin
- Cmd:= T_Command(CmdFooter.Items[CptCmd]);
- if Cmd is T_WriteText
- then
- with Cmd as T_WriteText do
- WriteText(GetPosX,GetPosY,GetColumn,GetText,GetFont,GetBackColor,GetBorder,GetLineSpace,GetFlags,ZFooter);
- if Cmd is T_Number
- then
- with Cmd as T_Number do
- WriteNumber(GetPosX,GetPosY,GetColumn,GetTextNum,GetTextTot,GetFont,GetBackColor,GetBorder,GetLineSpace,
- GetFlags,GetTotal,GetAlpha,zFooter,GetTypeNum);
- if Cmd is T_Space
- then
- with Cmd as T_Space do
- InsertSpace(GetPosY,GetColumn,GetHeight,GetBackColor,zFooter);
- if Cmd is T_Line
- then
- with Cmd as T_Line do
- DrawALine(GetPosX,GetPosY,GetEndX,GetEndY,GetStyle);
- if Cmd is T_Image
- then
- with Cmd as T_Image do
- PaintImage(GetPosX,GetPosY,GetColumn,GetImage,zFooter);
- end;
- if CmdFrames.Count> 0
- then
- for CptCmd:= 0 to Pred(CmdFrames.Count) do
- begin
- Cmd:= T_Command(CmdFrames.Items[CptCmd]);
- if Cmd is T_Frame
- then
- with Cmd as T_Frame do
- DrawAFrame(GetStyle,GetZone);
- end;
- end;
-end;
-
-procedure T_Report.ShiftFooterLines(Shift: Single);
-var
- Cpt: Integer;
- Cmd: T_Command;
-begin
-with T_Section(Sections[Pred(NumSection)]) do
- if CmdFooter.Count> 0
- then
- for Cpt:= 0 to Pred(CmdFooter.Count) do
- begin
- Cmd:= T_Command(CmdFooter.Items[Cpt]);
- if Cmd is T_WriteText
- then
- with Cmd as T_WriteText do
- SetPosY(GetPosY-Shift);
- if Cmd is T_Number
- then
- with Cmd as T_Number do
- SetPosY(GetPosY-Shift);
- if Cmd is T_Space
- then
- with Cmd as T_Space do
- SetPosY(GetPosY-Shift);
- end;
-end;
-
-procedure T_Report.ShiftPageLines(Shift: Single);
-var
- Cpt: Integer;
- Cmd: T_Command;
-begin
-with VWriteLine do
- for Cpt:= 0 to Pred(Commands.Count) do
- begin
- Cmd:= T_Command(Commands.Items[Cpt]);
- if Cmd is T_WriteText
- then
- with Cmd as T_WriteText do
- SetPosY(GetPosY-Shift);
- end;
-end;
-
-procedure T_Report.ShiftGroup(Shift: Single);
-var
- Cpt: Integer;
- Cmd: T_Command;
-begin
-with VGroup do
- for Cpt:= 0 to Pred(Commands.Count) do
- begin
- Cmd:= T_Command(Commands.Items[Cpt]);
- if Cmd is T_WriteText
- then
- with Cmd as T_WriteText do
- SetPosY(GetPosY-Shift);
- end;
-end;
-
-function T_Report.WriteText(PosX,PosY: Single; Column,Text,FontNum,BkColorNum,BordNum,SpLine: Integer;
- TxtFlags: TfpgTextFlags; Zone: TZone): Single;
-var
- PosH,PosV,LnSpInt,LnSpSup,LnSpInf,ThickLine: Single;
- HTxt,HeighTxt,Half,ColorLine,Cpt: Integer;
- EndOfLine,UseCurFont: Boolean;
- Fnt: TfpgFont;
- StyleLine: TfpgLineStyle;
- Wraplst: TStringList;
-begin
-with T_Section(Sections[Pred(NumSection)]) do
- begin
- EndOfLine:= False;
- if FPreparation= ppPrepare
- then
- if FCurrentFont<> FontNum
- then
- begin
- FCurrentFont:= FontNum;
- UseCurFont:= False;
- end
- else
- UseCurFont:= True;
- Fnt:= T_Font(Fonts[FontNum]).GetFont;
- if LineSpaces.Count= 0
- then
- LineSpace(0,0,0);
- if FCurrentLineSpace<> SpLine
- then
- FCurrentLineSpace:= SpLine;
- with T_LineSpace(LineSpaces[FCurrentLineSpace]) do
- begin
- LnSpSup:= GetSup;
- LnSpInt:= GetInt;
- LnSpInf:= GetInf;
- end;
- if Column= -2
- then
- Column:= DefaultCol;
- if Column> -1
- then
- HeighTxt:= TxtHeight(Round(T_Column(Columns[Column]).GetTextWidth),Texts[Text],Fnt,Round(LnSpInt))+Round(LnSpSup+LnSpInf)
- else
- HeighTxt:= TxtHeight(Paper.W,Texts[Text],Fnt,Round(LnSpInt))+Round(LnSpSup+LnSpInf);
- if (Column> -1) and (BordNum> -1)
- then
- Half:= Round(T_LineStyle(LineStyles[T_Border(Borders[BordNum]).GetStyle]).GetThick) div 2
- else
- Half:= 0;
- case FPreparation of
- ppPrepare:
- begin
- if NbPages= 0
- then
- Page;
- if Column> -1
- then
- begin
- HTxt:= VWriteLine.LineHeight;
- if HTxt< HeighTxt
- then
- HTxt:= HeighTxt;
- end
- else
- if HTxt< Fnt.Height
- then
- HTxt:= Fnt.Height;
- case Zone of
- zHeader:
- FPosRef.Y:= FCurrentMargin.T+FHeaderHeight;
- zPage:
- FPosRef.Y:= FCurrentMargin.T+FHeaderHeight+FPageHeight;
- zFooter:
- begin
- FPosRef.Y:= FCurrentMargin.B-HTxt;
- FFooterHeight:= FFooterHeight+HTxt;
- ShiftFooterLines(HTxt);
- end;
- end;
- if PosY= lnCurrent
- then
- PosV:= FPosRef.Y+LnSpSup
- else
- begin
- EndOfLine:= True;
- if PosY= lnEnd
- then
- begin
- PosV:= FPosRef.Y+LnSpSup;
- case Zone of
- zHeader:
- FPosRef.Y:= FPosRef.Y+HTxt;
- zPage:
- begin
- if FPosRef.Y+HTxt> FCurrentMargin.B-FFooterHeight
- then
- if FGroup
- then
- begin
- if VGroup.GroupeHeight+HTxt< FCurrentMargin.B-FCurrentMargin.T-FHeaderHeight-FFooterHeight
- then
- begin
- Page;
- if VGroup.Commands.Count> 0
- then
- begin
- FPosRef.Y:= FCurrentMargin.T+FHeaderHeight;
- ShiftGroup(T_WriteText(VGroup.Commands[0]).GetPosY-FPosRef.Y);
- FPosRef.Y:= FPosRef.Y+VGroup.GroupeHeight+Succ(Half);
- if VWriteLine.Commands.Count> 0
- then
- ShiftPageLines(T_WriteText(VWriteLine.Commands[0]).GetPosY-FPosRef.Y);
- PosV:= FPosRef.Y+LnSpSup;
- FPosRef.Y:= FPosRef.Y+HTxt+Succ(Half);
- end
- else
- begin
- if VWriteLine.Commands.Count> 0
- then
- ShiftPageLines(T_WriteText(VWriteLine.Commands[0]).GetPosY-FPosRef.Y);
- PosV:= FPosRef.Y+LnSpSup;
- FPosRef.Y:= FPosRef.Y+HTxt+Succ(Half);
- end;
- end
- else
- begin
- LoadCmdGroupToPage;
-// VGroup.Commands.Clear;
- Page;
- FPosRef.Y:= FCurrentMargin.T+FHeaderHeight;
- if VWriteLine.Commands.Count> 0
- then
- ShiftPageLines(T_WriteText(VWriteLine.Commands[0]).GetPosY-FPosRef.Y);
- PosV:= FPosRef.Y+LnSpSup;
- FPosRef.Y:= FPosRef.Y+HTxt+Succ(Half);
- end;
- end
- else
- begin
- Page;
- FPosRef.Y:= FCurrentMargin.T+FHeaderHeight;
- if VWriteLine.Commands.Count> 0
- then
- ShiftPageLines(T_WriteText(VWriteLine.Commands[0]).GetPosY-FPosRef.Y);
- PosV:= FPosRef.Y+LnSpSup;
- FPosRef.Y:= FPosRef.Y+HTxt+Succ(Half);
- end
- else
- FPosRef.Y:= FPosRef.Y+HTxt;
- end;
- end;
- if BordNum> -1
- then
- with T_Border(Borders[BordNum]) do
- if bfBottom in GetFlags
- then
- FPosRef.Y:= FPosRef.Y+1;
- end
- else
- begin
- PosV:= PosY;
- FPosRef.Y:= PosV+LnSpInf;
- end;
- case Zone of
- zHeader:
- FHeaderHeight:= FPosRef.Y-FCurrentMargin.T;
- zPage:
- FPageHeight:= FPosRef.Y-FHeaderHeight-FCurrentMargin.T;
- end;
- end;
- //if PosX= cnSuite
- //then
- //PosH:= FPosRef.X
- //else
- if Column= -1
- then
- if PosX> 0
- then
- PosH:= PosX
- else
- begin
- PosH:= T_Column(Columns[ColDefaut]).GetTextPos;
- if (txtRight in TxtFlags)
- then
- PosH:= PosH+T_Column(Columns[ColDefaut]).ColWidth-Fnt.TextWidth(Texts[Text])-T_Column(Columns[ColDefaut]).ColMargin;
- if (txtHCenter in TxtFlags)
- then
- PosH:= PosH+(T_Column(Columns[ColDefaut]).ColWidth-Fnt.TextWidth(Texts[Text]))/2;
- end
- else
- if PosX> 0
- then
- begin
- if (PosX< T_Column(Columns[Column]).GetTextPos)
- or (PosX> (T_Column(Columns[Column]).GetTextPos+T_Column(Columns[Column]).GetTextWidth))
- then
- PosH:= T_Column(Columns[Column]).GetTextPos
- else
- PosH:= PosX;
- end
- else
- begin
- PosH:= T_Column(Columns[Column]).GetTextPos;
- if (txtRight in TxtFlags)
- then
- PosH:= PosH+T_Column(Columns[Column]).ColWidth-Fnt.TextWidth(Texts[Text])-T_Column(Columns[Column]).ColMargin;
- if (txtHCenter in TxtFlags)
- then
- PosH:= PosH+(T_Column(Columns[Column]).ColWidth-Fnt.TextWidth(Texts[Text]))/2;
- end;
- FPosRef.X:= PosH+Fnt.TextWidth(Texts[Text]+' ');
- VWriteLine.LoadText(PosH,PosV,Column,Text,FontNum,HTxt,BkColorNum,BordNum,SpLine,UseCurFont,TxtFlags);
- Result:= Pixels2Dim(FPosRef.Y);
- if EndOfLine
- then
- begin
- HTxt:= 0;
- LineEnd(Zone);
- end;
- end;
- ppVisualize:
- with FCanvas do
- begin
- Font:= T_Font(Fonts[FontNum]).GetFont;
- SetTextColor(T_Font(Fonts[FontNum]).GetColor);
- if Column> -1
- then
- with T_Column(Columns[Column]) do
- begin
- if BkColorNum> -1
- then
- SetColor(T_BackColor(BackColors[BkColorNum]).GetColor)
- else
- SetColor(GetColor);
- FillRectangle(Round(ColPos),Round(PosY-LnSpSup),Round(ColWidth),HeighTxt);
- if BordNum> -1
- then
- with T_Border(Borders[BordNum]) do
- begin
- SetLineStyle(Round(T_LineStyle(LineStyles[GetStyle]).GetThick),T_LineStyle(LineStyles[GetStyle]).GetStyle);
- SetColor(T_LineStyle(LineStyles[GetStyle]).GetColor);
- if bfLeft in GetFlags
- then
- DrawLine(Round(ColPos)+Half,Round(PosY-LnSpSup),Round(ColPos)+Half,Round(PosY-LnSpSup)+HeighTxt);
- if bfRight in GetFlags
- then
- DrawLine(Round(ColPos+ColWidth)-Succ(Half),Round(PosY-LnSpSup),Round(ColPos+ColWidth)-Succ(Half),Round(PosY-LnSpSup)+HeighTxt);
- if bfTop in GetFlags
- then
- DrawLine(Round(ColPos),Round(PosY-LnSpSup)+Half,Round(ColPos+ColWidth),Round(PosY-LnSpSup)+Half);
- if bfBottom in GetFlags
- then
- DrawLine(Round(ColPos),Round(PosY-LnSpSup)+HeighTxt-Half,Round(ColPos+ColWidth),Round(PosY-LnSpSup)+HeighTxt-Half);
- end;
- DrawText(Round(GetTextPos),Round(PosY),Round(GetTextWidth),0,Texts[Text],TxtFlags,Round(LnSpInt));
- end
- else
- DrawText(Round(PosX),Round(PosY)-Fnt.Ascent,Round(Paper.W-PosX),0,Texts[Text],TxtFlags);
- end;
- ppPdfFile:
- if Column> -1
- then
- with T_Column(Columns[Column]) do
- begin
- if (GetColor<> clWhite) or (BkColorNum> -1)
- then
- begin
- PdfRect:= TPdfRect.Create;
- with PdfRect do
- begin
- PageId:= NumPage;
- FLeft:= ColPos;
- FBottom:= Paper.H-PosY+LnSpSup-HeighTxt;
- FHeight:= HeighTxt;
- FWidth:= ColWidth;
- if BkColorNum> -1
- then
- FColor:= T_BackColor(BackColors[BkColorNum]).GetColor
- else
- FColor:= GetColor;
- FFill:= True;
- FStroke:= False;
- end;
- PdfPage.Add(PdfRect);
- end;
- if BordNum> -1
- then
- with T_Border(Borders[BordNum]) do
- begin
- StyleLine:= T_LineStyle(LineStyles[GetStyle]).GetStyle;
- ColorLine:= T_LineStyle(LineStyles[GetStyle]).GetColor;
- ThickLine:= T_LineStyle(LineStyles[GetStyle]).GetThick;
- if bfLeft in GetFlags
- then
- begin
- PdfLine:= TPdfLine.Create;
- with PdfLine do
- begin
- PageId:= NumPage;
- FBeginX:= ColPos;
- FBeginY:= Paper.H-PosY+LnSpSup;
- FEndX:= ColPos;
- FEndY:= Paper.H-PosY+LnSpSup-HeighTxt;
- FStyle:= StyleLine;
- FColor:= ColorLine;
- FThick:= ThickLine;
- end;
- PdfPage.Add(PdfLine);
- end;
- if bfRight in GetFlags
- then
- begin
- PdfLine:= TPdfLine.Create;
- with PdfLine do
- begin
- PageId:= NumPage;
- FBeginX:= ColPos+ColWidth;
- FBeginY:= Paper.H-PosY+LnSpSup;
- FEndX:= ColPos+ColWidth;
- FEndY:= Paper.H-PosY+LnSpSup-HeighTxt;
- FStyle:= StyleLine;
- FColor:= ColorLine;
- FThick:= ThickLine;
- end;
- PdfPage.Add(PdfLine);
- end;
- if bfTop in GetFlags
- then
- begin
- PdfLine:= TPdfLine.Create;
- with PdfLine do
- begin
- PageId:= NumPage;
- FBeginX:= ColPos;
- FBeginY:= Paper.H-PosY+LnSpSup;
- FEndX:= ColPos+ColWidth;
- FEndY:= Paper.H-PosY+LnSpSup;
- FStyle:= StyleLine;
- FColor:= ColorLine;
- FThick:= ThickLine;
- end;
- PdfPage.Add(PdfLine);
- end;
- if bfBottom in GetFlags
- then
- begin
- PdfLine:= TPdfLine.Create;
- with PdfLine do
- begin
- PageId:= NumPage;
- FBeginX:= ColPos;
- FBeginY:= Paper.H-PosY+LnSpSup-HeighTxt;
- FEndX:= ColPos+ColWidth;
- FEndY:= Paper.H-PosY+LnSpSup-HeighTxt;
- FStyle:= StyleLine;
- FColor:= ColorLine;
- FThick:= ThickLine;
- end;
- PdfPage.Add(PdfLine);
- end;
- end;
- if Fnt.TextWidth(Texts[Text])< GetTextWidth
- then
- begin
- PdfTexte:= TPdfTexte.Create;
- with PdfTexte do
- begin
- PageId:= NumPage;
- FFont:= FontNum;
- FSize:= T_Font(Fonts[FontNum]).GetSize;
- FColor:= T_Font(Fonts[FontNum]).GetColor;
- TextPosX:= GetTextPos;
- if (txtRight in TxtFlags)
- then
- TextPosX:= ColPos+ColWidth-ColMargin-Fnt.TextWidth(Texts[Text]);
- if (txtHCenter in TxtFlags)
- then
- TextPosX:= GetTextPos+(ColWidth-Fnt.TextWidth(Texts[Text]))/2;
- TextPosY:= Paper.H-PosY-Fnt.Ascent;
- TextWidt:= ColWidth;
- Writting:= Texts[Text];
- end;
- PdfPage.Add(PdfTexte);
- end
- else
- begin
- Wraplst:= TStringList.Create;
- Wraplst.Text:= Texts[Text];
- for Cpt:= 0 to Pred(Wraplst.Count) do
- Wraplst[Cpt]:= AddLineBreaks(Wraplst[Cpt],Round(GetTextWidth),Fnt);
- Wraplst.Text:= Wraplst.Text;
- for Cpt:= 0 to Pred(Wraplst.Count) do
- begin
- PdfTexte:= TPdfTexte.Create;
- with PdfTexte do
- begin
- PageId:= NumPage;
- FFont:= FontNum;
- FSize:= T_Font(Fonts[FontNum]).GetSize;
- FColor:= T_Font(Fonts[FontNum]).GetColor;
- TextPosX:= GetTextPos;
- if (txtRight in TxtFlags)
- then
- TextPosX:= ColPos+ColWidth-ColMargin-Fnt.TextWidth(Wraplst[Cpt]);
- if (txtHCenter in TxtFlags)
- then
- TextPosX:= GetTextPos+(ColWidth-Fnt.TextWidth(Wraplst[Cpt]))/2;
- TextPosY:= Paper.H-PosY-Fnt.Ascent-(Fnt.Height+LnSpInt)*Cpt;
- TextWidt:= ColWidth;
- Writting:= Wraplst[Cpt];
- end;
- PdfPage.Add(PdfTexte);
- end;
- WrapLst.Free;
- end;
- end
- else
- if Fnt.TextWidth(Texts[Text])< Paper.W-PosX
- then
- begin
- PdfTexte:= TPdfTexte.Create;
- with PdfTexte do
- begin
- PageId:= NumPage;
- FFont:= FontNum;
- FSize:= T_Font(Fonts[FontNum]).GetSize;
- FColor:= T_Font(Fonts[FontNum]).GetColor;
- FPosX:= PosX;
- FPosY:= Paper.H-PosY;
- FWidth:= Paper.W;
- FText:= Texts[Text];
- end;
- PdfPage.Add(PdfTexte);
- end
- else
- begin
- Wraplst:= TStringList.Create;
- Wraplst.Text:= Texts[Text];
- for Cpt:= 0 to Pred(Wraplst.Count) do
- Wraplst[Cpt]:= AddLineBreaks(Wraplst[Cpt],Round(Paper.W-PosX),Fnt);
- Wraplst.Text:= Wraplst.Text;
- for Cpt:= 0 to Pred(Wraplst.Count) do
- begin
- PdfTexte:= TPdfTexte.Create;
- with PdfTexte do
- begin
- PageId:= NumPage;
- FFont:= FontNum;
- FSize:= T_Font(Fonts[FontNum]).GetSize;
- FColor:= T_Font(Fonts[FontNum]).GetColor;
- FPosX:= PosX;
- FPosY:= Paper.H-PosY-Fnt.Ascent-(Fnt.Height+LnSpInt)*Cpt;
- FWidth:= Paper.W;
- FText:= Wraplst[Cpt];
- end;
- PdfPage.Add(PdfTexte);
- end;
- WrapLst.Free;
- end;
- end;
- end;
-end;
-
-function T_Report.WriteNumber(PosX,PosY: Single; Column,TextNum,TextTot,FontNum,BkColorNum,BordNum,SpLine: Integer;
- TxtFlags: TfpgTextFlags; Total,Alpha: Boolean; Zone: TZone; SPNum: TSectPageNum): Single;
-
- function BuildChaine: string;
- var
- NumAlpha: string;
- begin
- case SPNum of
- PageNum:
- if Total
- then
- Result:= Texts[TextNum]+' '+IntToStr(NumPage)+' '+Texts[TextTot]+' '
- +IntToStr(T_Section(Sections[Pred(Sections.Count)]).TotPages)
- else
- Result:= Texts[TextNum]+' '+IntToStr(NumPage);
- SectNum:
- begin
- if Alpha
- then
- NumAlpha:= Convert2Alpha(NumSection)
- else
- NumAlpha:= IntToStr(NumSection);
- if Total
- then
- Result:= Texts[TextNum]+' '+NumAlpha+' '+Texts[TextTot]+' '+IntToStr(Sections.Count)
- else
- Result:= Texts[TextNum]+' '+NumAlpha;
- end;
- PSectNum:
- begin
- if Alpha
- then
- NumAlpha:= Convert2Alpha(NumPageSection)
- else
- NumAlpha:= IntToStr(NumPageSection);
- if Total
- then
- Result:= Texts[TextNum]+' '+NumAlpha+' '+Texts[TextTot]+' '
- +IntToStr(T_Section(Sections[Pred(NumSection)]).NbPages)
- else
- Result:= Texts[TextNum]+' '+NumAlpha;
- end;
- end;
- end;
-
-var
- PosH,PosV,LnSpInt,LnSpSup,LnSpInf,ThickLine: Single;
- HTxt,HeighTxt,Half,ColorLine: Integer;
- EndOfLine,UseCurFont: Boolean;
- Fnt: TfpgFont;
- StyleLine: TfpgLineStyle;
- Chaine: string;
-begin
-with T_Section(Sections[Pred(NumSection)]) do
- begin
- EndOfLine:= False;
- if FPreparation= ppPrepare
- then
- if FCurrentFont<> FontNum
- then
- begin
- FCurrentFont:= FontNum;
- UseCurFont:= False;
- end
- else
- UseCurFont:= True;
- Fnt:= T_Font(Fonts[FontNum]).GetFont;
- if LineSpaces.Count= 0
- then
- LineSpace(0,0,0);
- if FCurrentLineSpace<> SpLine
- then
- FCurrentLineSpace:= SpLine;
- with T_LineSpace(LineSpaces[FCurrentLineSpace]) do
- begin
- LnSpSup:= GetSup;
- LnSpInt:= GetInt;
- LnSpInf:= GetInf;
- end;
- if Column= -2
- then
- Column:= DefaultCol;
- if Column> -1
- then
- HeighTxt:= TxtHeight(Round(T_Column(Columns[Column]).GetTextWidth),Texts[TextNum]+' 0 '+Texts[TextTot]+' 0',Fnt,Round(LnSpInt))+Round(LnSpSup+LnSpInf)
- else
- HeighTxt:= TxtHeight(Paper.W,Texts[TextNum]+' 0 '+Texts[TextTot]+' 0',Fnt,Round(LnSpInt))+Round(LnSpSup+LnSpInf);
- if (Column> -1) and (BordNum> -1)
- then
- Half:= Round(T_LineStyle(LineStyles[T_Border(Borders[BordNum]).GetStyle]).GetThick) div 2;
- case FPreparation of
- ppPrepare:
- begin
- if NbPages= 0
- then
- Page;
- if Column> -1
- then
- begin
- HTxt:= VWriteLine.LineHeight;
- if HTxt< HeighTxt
- then
- HTxt:= HeighTxt;
- end
- else
- if HTxt< Fnt.Height
- then
- HTxt:= Fnt.Height;
- case Zone of
- zHeader:
- FPosRef.Y:= FCurrentMargin.T+FHeaderHeight;
- zFooter:
- begin
- FPosRef.Y:= FCurrentMargin.B-HTxt;
- FFooterHeight:= FFooterHeight+HTxt;
- ShiftFooterLines(HTxt);
- end;
- end;
- if PosY= lnCurrent
- then
- PosV:= FPosRef.Y+LnSpSup
- else
- begin
- EndOfLine:= True;
- if PosY= lnEnd
- then
- begin
- PosV:= FPosRef.Y+LnSpSup;
- case Zone of
- zHeader:
- FPosRef.Y:= FPosRef.Y+HTxt;
- end;
- if BordNum> -1
- then
- with T_Border(Borders[BordNum]) do
- if bfBottom in GetFlags
- then
- FPosRef.Y:= FPosRef.Y+1;
- end
- else
- begin
- PosV:= PosY;
- FPosRef.Y:= PosV+LnSpInf;
- end;
- case Zone of
- zHeader:
- FHeaderHeight:= FPosRef.Y-FCurrentMargin.T;
- end;
- end;
- if Column= -1
- then
- if PosX> 0
- then
- PosH:= PosX
- else
- begin
- PosH:= T_Column(Columns[ColDefaut]).GetTextPos-T_Column(Columns[0]).ColMargin;
- if (txtRight in TxtFlags)
- then
- if Total
- then
- PosH:= PosH+T_Column(Columns[ColDefaut]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 '+Texts[TextTot]+' 0 ')-T_Column(Columns[ColDefaut]).ColMargin
- else
- PosH:= PosH+T_Column(Columns[ColDefaut]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 ')-T_Column(Columns[ColDefaut]).ColMargin;
- if (txtHCenter in TxtFlags)
- then
- if Total
- then
- PosH:= PosH+(T_Column(Columns[ColDefaut]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 '+Texts[TextTot]+' 0 '))/2
- else
- PosH:= PosH+(T_Column(Columns[ColDefaut]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 '))/2;
- end
- else
- if PosX> 0
- then
- if (PosX< T_Column(Columns[Column]).GetTextPos)
- or (PosX> (T_Column(Columns[Column]).GetTextPos+T_Column(Columns[Column]).GetTextWidth))
- then
- PosH:= T_Column(Columns[Column]).GetTextPos
- else
- PosH:= PosX
- else
- begin
- PosH:= T_Column(Columns[Column]).GetTextPos-T_Column(Columns[Column]).ColMargin;
- if (txtRight in TxtFlags)
- then
- if Total
- then
- PosH:= PosH+T_Column(Columns[Column]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 '+Texts[TextTot]+' 0 ')-T_Column(Columns[Column]).ColMargin
- else
- PosH:= PosH+T_Column(Columns[Column]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 ')-T_Column(Columns[Column]).ColMargin;
- if (txtHCenter in TxtFlags)
- then
- if Total
- then
- PosH:= PosH+(T_Column(Columns[Column]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 '+Texts[TextTot]+' 0 '))/2
- else
- PosH:= PosH+(T_Column(Columns[Column]).ColWidth-Fnt.TextWidth(Texts[TextNum]+' 0 '))/2;
- end;
- FPosRef.X:= PosH+Fnt.TextWidth(Texts[TextNum]+' 0 '+Texts[TextTot]+' 0 ');
- VWriteLine.LoadNumber(PosH,PosV,Column,TextNum,TextTot,FontNum,HTxt,BkColorNum,BordNum,SpLine,UseCurFont,TxtFlags,Total,Alpha,SPNum);
- Result:= Pixels2Dim(FPosRef.Y);
- if EndOfLine
- then
- begin
- HTxt:= 0;
- LineEnd(Zone);
- end;
- end;
- ppVisualize:
- with FCanvas do
- begin
- Chaine:= BuildChaine;
- Font:= T_Font(Fonts[FontNum]).GetFont;
- SetTextColor(T_Font(Fonts[FontNum]).GetColor);
- if Column> -1
- then
- with T_Column(Columns[Column]) do
- begin
- if BkColorNum> -1
- then
- SetColor(T_BackColor(BackColors[BkColorNum]).GetColor)
- else
- SetColor(GetColor);
- FillRectangle(Round(ColPos),Round(PosY-LnSpSup),Round(ColWidth),HeighTxt);
- if BordNum> -1
- then
- with T_Border(Borders[BordNum]) do
- begin
- SetLineStyle(Round(T_LineStyle(LineStyles[GetStyle]).GetThick),T_LineStyle(LineStyles[GetStyle]).GetStyle);
- SetColor(T_LineStyle(LineStyles[GetStyle]).GetColor);
- if bfLeft in GetFlags
- then
- DrawLine(Round(ColPos)+Half,Round(PosY-LnSpSup),Round(ColPos)+Half,Round(PosY-LnSpSup)+HeighTxt);
- if bfRight in GetFlags
- then
- DrawLine(Round(ColPos+ColWidth)-Half,Round(PosY-LnSpSup),Round(ColPos+ColWidth)-Half,Round(PosY-LnSpSup)+HeighTxt);
- if bfTop in GetFlags
- then
- DrawLine(Round(ColPos),Round(PosY-LnSpSup)+Half,Round(ColPos+ColWidth),Round(PosY-LnSpSup)+Half);
- if bfBottom in GetFlags
- then
- DrawLine(Round(ColPos),Round(PosY-LnSpSup)+HeighTxt-Succ(Half),Round(ColPos+ColWidth),Round(PosY-LnSpSup)+HeighTxt-Succ(Half));
- end;
- DrawText(Round(GetTextPos),Round(PosY),Round(GetTextWidth),0,Chaine,TxtFlags,Round(LnSpInt));
- end
- else
- DrawText(Round(PosX),Round(PosY),Chaine,TxtFlags);
- end;
- ppPdfFile:
- begin
- Chaine:= BuildChaine;
- if Column> -1
- then
- with T_Column(Columns[Column]) do
- begin
- if (GetColor<> clWhite) or (BkColorNum> -1)
- then
- begin
- PdfRect:= TPdfRect.Create;
- with PdfRect do
- begin
- PageId:= NumPage;
- FLeft:= ColPos;
- FBottom:= Paper.H-PosY+LnSpSup-HeighTxt;
- FHeight:= HeighTxt;
- FWidth:= ColWidth;
- if BkColorNum> -1
- then
- FColor:= T_BackColor(BackColors[BkColorNum]).GetColor
- else
- FColor:= GetColor;
- FFill:= True;
- FStroke:= False;
- end;
- PdfPage.Add(PdfRect);
- end;
- if BordNum> -1
- then
- with T_Border(Borders[BordNum]) do
- begin
- StyleLine:= T_LineStyle(LineStyles[GetStyle]).GetStyle;
- ColorLine:= T_LineStyle(LineStyles[GetStyle]).GetColor;
- ThickLine:= T_LineStyle(LineStyles[GetStyle]).GetThick;
- if bfLeft in GetFlags
- then
- begin
- PdfLine:= TPdfLine.Create;
- with PdfLine do
- begin
- PageId:= NumPage;
- FBeginX:= ColPos;
- FBeginY:= Paper.H-PosY+LnSpSup;
- FEndX:= ColPos;
- FEndY:= Paper.H-PosY+LnSpSup-HeighTxt;
- FStyle:= StyleLine;
- FColor:= ColorLine;
- FThick:= ThickLine;
- end;
- PdfPage.Add(PdfLine);
- end;
- if bfRight in GetFlags
- then
- begin
- PdfLine:= TPdfLine.Create;
- with PdfLine do
- begin
- PageId:= NumPage;
- FBeginX:= ColPos+ColWidth;
- FBeginY:= Paper.H-PosY+LnSpSup;
- FEndX:= ColPos+ColWidth;
- FEndY:= Paper.H-PosY+LnSpSup-HeighTxt;
- FStyle:= StyleLine;
- FColor:= ColorLine;
- FThick:= ThickLine;
- end;
- PdfPage.Add(PdfLine);
- end;
- if bfTop in GetFlags
- then
- begin
- PdfLine:= TPdfLine.Create;
- with PdfLine do
- begin
- PageId:= NumPage;
- FBeginX:= ColPos;
- FBeginY:= Paper.H-PosY+LnSpSup;
- FEndX:= ColPos+ColWidth;
- FEndY:= Paper.H-PosY+LnSpSup;
- FStyle:= StyleLine;
- FColor:= ColorLine;
- FThick:= ThickLine;
- end;
- PdfPage.Add(PdfLine);
- end;
- if bfBottom in GetFlags
- then
- begin
- PdfLine:= TPdfLine.Create;
- with PdfLine do
- begin
- PageId:= NumPage;
- FBeginX:= ColPos;
- FBeginY:= Paper.H-PosY+LnSpSup-HeighTxt;
- FEndX:= ColPos+ColWidth;
- FEndY:= Paper.H-PosY+LnSpSup-HeighTxt;
- FStyle:= StyleLine;
- FColor:= ColorLine;
- FThick:= ThickLine;
- end;
- PdfPage.Add(PdfLine);
- end;
- end;
- PdfTexte:= TPdfTexte.Create;
- with PdfTexte do
- begin
- PageId:= NumPage;
- FFont:= FontNum;
- FSize:= T_Font(Fonts[FontNum]).GetSize;
- FColor:= T_Font(Fonts[FontNum]).GetColor;
- TextPosX:= GetTextPos;
- if (txtRight in TxtFlags)
- then
- TextPosX:= ColPos+ColWidth-ColMargin-Fnt.TextWidth(Chaine);
- if (txtHCenter in TxtFlags)
- then
- TextPosX:= GetTextPos+(ColWidth-Fnt.TextWidth(Chaine))/2;
- TextPosY:= Paper.H-PosY-Fnt.Ascent;
- TextWidt:= ColWidth;
- Writting:= Chaine;
- end;
- PdfPage.Add(PdfTexte);
- end
- else
- begin
- PdfTexte:= TPdfTexte.Create;
- with PdfTexte do
- begin
- PageId:= NumPage;
- FFont:= FontNum;
- FSize:= T_Font(Fonts[FontNum]).GetSize;
- FColor:= T_Font(Fonts[FontNum]).GetColor;
- FPosX:= PosX;
- FPosY:= PosY-Fnt.Ascent;
- FWidth:= Paper.W;
- FText:= Chaine;
- end;
- PdfPage.Add(PdfTexte);
- end;
- end;
- end;
- end;
-end;
-
-function T_Report.InsertSpace(PosY: Single; Column: Integer; SpaceHeight: Single; BkColorNum: Integer; Zone: TZone): Single;
-var
- PosV: Single;
-begin
-with T_Section(Sections[Pred(NumSection)]) do
- begin
- if PosY> -1
- then
- PosV:= PosY
- else
- PosV:= FPosRef.Y;
- if Column= -2
- then
- Column:= DefaultCol;
- case FPreparation of
- ppPrepare:
- begin
- case Zone of
- zHeader:
- begin
- FPosRef.Y:= FCurrentMargin.T+FHeaderHeight;
- FPosRef.Y:= FPosRef.Y+SpaceHeight;
- FHeaderHeight:= FPosRef.Y-FCurrentMargin.T;
- LoadSpaceHeader(PosV,Column,SpaceHeight,BkColorNum);
- end;
- zPage:
- begin
- FPosRef.Y:= FCurrentMargin.T+FHeaderHeight+FPageHeight;
- if FPosRef.Y+SpaceHeight> FCurrentMargin.B-FFooterHeight
- then
- begin
- FPosRef.Y:= FCurrentMargin.T+FHeaderHeight;
- Page;
- end
- else
- FPosRef.Y:= FPosRef.Y+SpaceHeight;
- FPageHeight:= FPosRef.Y-FHeaderHeight-FCurrentMargin.T;
- LoadSpacePage(PosV,Column,SpaceHeight,BkColorNum);
- end;
- zFooter:
- begin
- FPosRef.Y:= FCurrentMargin.B-SpaceHeight;
- FFooterHeight:= FFooterHeight+SpaceHeight;
- PosV:= FPosRef.Y;
- ShiftFooterLines(SpaceHeight);
- LoadSpaceFooter(PosV,Column,SpaceHeight,BkColorNum);
- end;
- end;
- if FGroup
- then
- LoadSpaceGroup(SpaceHeight);
- Result:= Pixels2Dim(FPosRef.Y);
- LineEnd(Zone);
- end;
- ppVisualize:
- with FCanvas,T_Column(Columns[Column]) do
- begin
- if BkColorNum> -1
- then
- SetColor(T_BackColor(BackColors[BkColorNum]).GetColor)
- else
- SetColor(GetColor);
- FillRectangle(Round(ColPos),Round(PosV),Round(ColWidth),Round(SpaceHeight));
- end;
- ppPdfFile:
- begin
- if Column> -1
- then
- with T_Column(Columns[Column]) do
- begin
- if (GetColor<> clWhite) or (BkColorNum> -1)
- then
- begin
- PdfRect:= TPdfRect.Create;
- with PdfRect do
- begin
- PageId:= NumPage;
- FLeft:= ColPos;
- FBottom:= Paper.H-PosY-SpaceHeight;
- FHeight:= SpaceHeight;
- FWidth:= ColWidth;
- if BkColorNum> -1
- then
- FColor:= T_BackColor(BackColors[BkColorNum]).GetColor
- else
- FColor:= GetColor;
- FFill:= True;
- FStroke:= False;
- end;
- PdfPage.Add(PdfRect);
- end;
- end;
- end;
- end;
- end;
-end;
-
-procedure T_Report.LineEnd(Zone: TZone);
-begin
-with T_Section(Sections[Pred(NumSection)]) do
- case Zone of
- zHeader:
- LoadCmdHeader;
- zPage:
- if FGroup
- then
- LoadCmdGroup
- else
- LoadCmdPage;
- zFooter:
- LoadCmdFooter;
- end;
-end;
-
-procedure T_Report.DrawAFrame(StyLine: Integer; Zone: TZone);
-var
- Half,MarginL,MarginR,MarginT,MarginB,HeaderH,FooterH: Integer;
-begin
-with T_Section(Sections[Pred(NumSection)]) do
- case FPreparation of
- ppPrepare:
- LoadFrame(StyLine,Zone);
- ppVisualize:
- with FCanvas do
- begin
- with T_LineStyle(LineStyles[StyLine]) do
- begin
- SetLineStyle(Round(GetThick),GetStyle);
- Half:= Round(GetThick) div 2;
- SetColor(GetColor);
- end;
- with FCurrentMargin do
- begin
- MarginL:= Round(L);
- MarginR:= Round(R);
- MarginT:= Round(T);
- MarginB:= Round(B);
- HeaderH:= Round(FHeaderHeight);
- FooterH:= Round(FFooterHeight);
- case Zone of
- zHeader:
- begin
- DrawLine(MarginL+Half,MarginT,MarginL+Half,MarginT+HeaderH); // left
- DrawLine(MarginR-Half,MarginT,MarginR-Half,MarginT+HeaderH); // right
- DrawLine(MarginL,MarginT+Half,MarginR,MarginT+Half); // top
- DrawLine(MarginL,MarginT+HeaderH-Half,MarginR,MarginT+HeaderH-Half); // bottom
- end;
- zPage:
- begin
- DrawLine(MarginL+Half,MarginT+HeaderH,MarginL+Half,MarginB-FooterH); // left
- DrawLine(MarginR-Half,MarginT+HeaderH,MarginR-Half,MarginB-FooterH); // right
- DrawLine(MarginL,MarginT+HeaderH-Half,MarginR,MarginT+HeaderH-Half); // top
- DrawLine(MarginL,MarginB-FooterH+Half,MarginR,MarginB-FooterH+Half); // bottom
- end;
- zFooter:
- begin
- DrawLine(MarginL+Half,MarginB-FooterH,MarginL+Half,MarginB); // left
- DrawLine(MarginR-Half,MarginB-FooterH,MarginR-Half,MarginB); // right
- DrawLine(MarginL,MarginB-FooterH+Half,MarginR,MarginB-FooterH+Half); // top
- DrawLine(MarginL,MarginB-Half,MarginR,MarginB-Half); // bottom
- end;
- zMargins:
- begin
- DrawLine(MarginL+Half,MarginT,MarginL+Half,MarginB-Succ(Half)); // left
- DrawLine(MarginR-Half,MarginT,MarginR-Half,MarginB-Succ(Half)); // right
- DrawLine(MarginL,MarginT+Half,MarginR,MarginT+Half); // top
- DrawLine(MarginL,MarginB-Half,MarginR,MarginB-Half); // bottom
- end;
- end;
- end;
- end;
- ppPdfFile:
- begin
- PdfRect:= TPdfRect.Create;
- with PdfRect do
- begin
- PageId:= NumPage;
- with T_LineStyle(LineStyles[StyLine]) do
- begin
- FThick:= GetThick;
- FColor:= GetColor;
- FLineStyle:= GetStyle;
- end;
- with FCurrentMargin do
- case Zone of
- zHeader:
- begin
- FLeft:= L;
- FBottom:= Paper.H-T-FHeaderHeight;
- FHeight:= FHeaderHeight;
- FWidth:= R-L;
- end;
- zPage:
- begin
- FLeft:= L;
- FBottom:= Paper.H-B+FFooterHeight;
- FHeight:= B-T-FHeaderHeight-FFooterHeight;
- FWidth:= R-L;
- end;
- zFooter:
- begin
- FLeft:= L;
- FBottom:= Paper.H-B;
- FHeight:= FFooterHeight;
- FWidth:= R-L;
- end;
- zMargins:
- begin
- FLeft:= L;
- FBottom:= Paper.H-B;
- FHeight:= B-T;
- FWidth:= R-L;
- end;
- end;
- FFill:= False;
- FStroke:= True;
- PdfPage.Add(PdfRect);
- end;
- end;
- end;
-end;
-
-procedure T_Report.DrawALine(XBegin,YBegin,XEnd,YEnd: Single; StyLine: Integer);
-begin
-with T_Section(Sections[Pred(NumSection)]) do
- case FPreparation of
- ppPrepare:
- LoadLine(XBegin,YBegin,ColDefaut,XEnd,YEnd,StyLine);
- ppVisualize:
- with FCanvas do
- begin
- with T_LineStyle(LineStyles[StyLine]) do
- begin
- SetLineStyle(Round(GetThick),GetStyle);
- SetColor(GetColor);
- end;
- DrawLine(Round(XBegin),Round(YBegin),Round(XEnd),Round(YEnd));
- end;
- ppPdfFile:
- begin
- PdfLine:= TPdfLine.Create;
- with PdfLine do
- begin
- PageId:= NumPage;
- FBeginX:= XBegin;
- FBeginY:= Paper.H-YBegin;
- FEndX:= XEnd;
- FEndY:= Paper.H-YEnd;
- FStyle:= T_LineStyle(LineStyles[StyLine]).GetStyle;;
- FColor:= T_LineStyle(LineStyles[StyLine]).GetColor;
- FThick:= T_LineStyle(LineStyles[StyLine]).GetThick;
- end;
- PdfPage.Add(PdfLine);
- end;
- end;
-end;
-
-procedure T_Report.DrawAHorizLine(XBegin,YBegin: Single; Column: Integer; XEnd: Single; StyLine: Integer; Zone: TZone);
-var
- PosV: Single;
-begin
-with T_Section(Sections[Pred(NumSection)]) do
- case FPreparation of
- ppPrepare:
- begin
- case Zone of
- zHeader:
- begin
- FPosRef.Y:= FCurrentMargin.T+FHeaderHeight;
- PosV:= FPosRef.Y+XBegin;
- FPosRef.Y:= FPosRef.Y+XBegin+YBegin+T_LineStyle(LineStyles[StyLine]).GetThick;
- FHeaderHeight:= FPosRef.Y-FCurrentMargin.T;
- with T_Column(Columns[Column]) do
- LoadLineHorizHeader(ColPos,PosV,Column,ColPos+ColWidth,PosV,StyLine);
- end;
- zPage:
- begin
- FPosRef.Y:= FCurrentMargin.T+FHeaderHeight+FPageHeight;
- PosV:= FPosRef.Y+XBegin;
- FPosRef.Y:= FPosRef.Y+XBegin+YBegin+T_LineStyle(LineStyles[StyLine]).GetThick;
- FPageHeight:= FPosRef.Y-FHeaderHeight-FCurrentMargin.T;
- with T_Column(Columns[Column]) do
- LoadLineHorizPage(ColPos,PosV,Column,ColPos+ColWidth,PosV,StyLine);
- end;
- zFooter:
- begin
- FPosRef.Y:= FCurrentMargin.B-XBegin;
- PosV:= FPosRef.Y;
- FPosRef.Y:= FPosRef.Y-YBegin-T_LineStyle(LineStyles[StyLine]).GetThick;
- FFooterHeight:= FFooterHeight+XBegin+YBegin+T_LineStyle(LineStyles[StyLine]).GetThick;
- ShiftFooterLines(XBegin+YBegin+T_LineStyle(LineStyles[StyLine]).GetThick);
- with T_Column(Columns[Column]) do
- LoadLineHorizFooter(ColPos,PosV,Column,ColPos+ColWidth,PosV,StyLine);
- end;
- end;
- if FGroup
- then
- LoadLineHorizGroupe(T_LineStyle(LineStyles[StyLine]).GetThick);
- end;
- ppVisualize:
- with FCanvas do
- begin
- with T_LineStyle(LineStyles[StyLine]) do
- begin
- SetLineStyle(Round(GetThick),GetStyle);
- SetColor(GetColor);
- end;
- DrawLine(Round(XBegin),Round(YBegin),Round(XEnd),Round(YBegin));
- end;
- ppPdfFile:
- begin
- PdfLine:= TPdfLine.Create;
- with PdfLine do
- begin
- PageId:= NumPage;
- FBeginX:= XBegin;
- FBeginY:= Paper.H-YBegin;
- FEndX:= XEnd;
- FEndY:= Paper.H-YBegin;
- FStyle:= T_LineStyle(LineStyles[StyLine]).GetStyle;;
- FColor:= T_LineStyle(LineStyles[StyLine]).GetColor;
- FThick:= T_LineStyle(LineStyles[StyLine]).GetThick;
- end;
- PdfPage.Add(PdfLine);
- end;
- end;
-end;
-
-procedure T_Report.PaintSurface(Points: T_Points; Couleur: TfpgColor);
-var
- OldColor: TfpgColor;
- Cpt: Integer;
- Pts: array of TPoint;
-begin
-with T_Section(Sections[Pred(NumSection)]) do
- case FPreparation of
- ppPrepare:
- LoadSurf(Points,Couleur);
- ppVisualize:
- begin
- OldColor:= FCanvas.Color;
- FCanvas.SetColor(Couleur);
- SetLength(Pts,Length(Points));
- for Cpt:= 0 to Pred(Length(Pts)) do
- begin
- Pts[Cpt].X:= Round(Points[Cpt].X);
- Pts[Cpt].Y:= Round(Points[Cpt].Y);
- end;
- FCanvas.DrawPolygon(Pts);
- FCanvas.SetColor(OldColor);
- end;
- ppPdfFile:
- begin
- PdfSurf:= TPdfSurf.Create;
- SetLength(PdfSurf.FPoints,Length(Points));
- for Cpt:= 0 to Pred(Length(Points)) do
- begin
- PdfSurf.FPoints[Cpt].X:= Points[Cpt].X;
- PdfSurf.FPoints[Cpt].Y:= Paper.H-Points[Cpt].Y;
- end;
- with PdfSurf do
- begin
- PageId:= NumPage;
- //SetLength(FPoints,Length(Points));
- //for Cpt:= 0 to Pred(Length(Points)) do // weird behaviour: points gets length= 0 inside the with clause !
- // begin
- // FPoints[Cpt].X:= Points[Cpt].X;
- // FPoints[Cpt].Y:= Paper.H-Points[Cpt].Y;
- // end;
- FColor:= Couleur;
- end;
- PdfPage.Add(PdfSurf);
- end;
- end;
-end;
-
-procedure T_Report.PaintImage(PosX,PosY: Single; Column,ImgNum: Integer; Zone: TZone);
-begin
-with T_Section(Sections[Pred(NumSection)]) do
- case FPreparation of
- ppPrepare:
- begin
- if Column> -1
- then
- PosX:= T_Column(Columns[Column]).ColPos+PosX;
- case Zone of
- zHeader:
- begin
- PosY:= FCurrentMargin.T+PosY;
- LoadImgHeader(PosX,PosY,Column,ImgNum);
- end;
- zPage:
- begin
- PosY:= FCurrentMargin.T+FHeaderHeight+PosY;
- LoadImgPage(PosX,PosY,Column,ImgNum);
- end;
- zFooter:
- begin
- PosY:= FCurrentMargin.B-FFooterHeight+PosY;
- LoadImgFooter(PosX,PosY,Column,ImgNum);
- end;
- end;
- end;
- ppVisualize:
- FCanvas.DrawImage(Round(PosX),Round(PosY),TfpgImage(Images[ImgNum]));
- ppPdfFile:
- begin
- PdfImg:= TPdfImg.Create;
- with PdfImg do
- begin
- PageId:= NumPage;
- ImgNumber:= ImgNum;
- ImgLeft:= PosX;
- ImgBottom:= Paper.H-PosY-TfpgImage(Images[ImgNum]).Height;
- ImgWidth:= TfpgImage(Images[ImgNum]).Width;
- ImgHeight:= TfpgImage(Images[ImgNum]).Height;
- end;
- PdfPage.Add(PdfImg);
- end;
- end;
-end;
-
-function T_Report.GetSectionTitle: string;
-begin
-Result:= T_Section(Sections[Pred(Sections.Count)]).Title;
-end;
-
-procedure T_Report.SetSectionTitle(ATitle: string);
-begin
-T_Section(Sections[Pred(Sections.Count)]).Title:= ATitle;
-end;
-
-{ public methods }
-
-constructor T_Report.Create;
-begin
-inherited Create;
-OldSeparator:= DecimalSeparator;
-DecimalSeparator:= '.';
-Sections:= TList.Create;
-Fonts:= TList.Create;
-Columns:= TList.Create;
-LineSpaces:= TList.Create;
-BackColors:= TList.Create;
-LineStyles:= TList.Create;
-Borders:= TList.Create;
-Images:= TList.Create;
-ImageNames:= TStringList.Create;
-Texts:= TStringList.Create;
-VWriteLine:= T_WriteLine.Create;
-PdfPage:= TList.Create;
-Outline:= False;
-end;
-
-destructor T_Report.Destroy;
-var
- Cpt: Integer;
-begin
-if Sections.Count> 0
-then
- for Cpt:= 0 to Pred(Sections.Count) do
- T_Section(Sections[Cpt]).Free;
-Sections.Free;
-if Fonts.Count> 0
-then
- for Cpt:= 0 to Pred(Fonts.Count) do
- T_Font(Fonts[Cpt]).Free;
-Fonts.Free;
-if Columns.Count> 0
-then
- for Cpt:= 0 to Pred(Columns.Count) do
- T_Column(Columns[Cpt]).Free;
-Columns.Free;
-if LineSpaces.Count> 0
-then
- for Cpt:= 0 to Pred(LineSpaces.Count) do
- T_LineSpace(LineSpaces[Cpt]).Free;
-LineSpaces.Free;
-if BackColors.Count> 0
-then
- for Cpt:= 0 to Pred(BackColors.Count) do
- T_BackColor(BackColors[Cpt]).Free;
-BackColors.Free;
-if LineStyles.Count> 0
-then
- for Cpt:= 0 to Pred(LineStyles.Count) do
- T_LineStyle(LineStyles[Cpt]).Free;
-LineStyles.Free;
-if Borders.Count> 0
-then
- for Cpt:= 0 to Pred(Borders.Count) do
- T_Border(Borders[Cpt]).Free;
-Borders.Free;
-if Images.Count> 0
-then
- for Cpt:= 0 to Pred(Images.Count) do
- TfpgImage(Images[Cpt]).Free;
-Images.Free;
-ImageNames.Free;
-Texts.Free;
-VWriteLine.Free;
-if PdfPage.Count> 0
-then
- for Cpt:= 0 to Pred(PdfPage.Count) do
- if TPdfElement(PdfPage[Cpt]) is TPdfTexte
- then
- TPdfTexte(PdfPage[Cpt]).Free
- else
- if TPdfElement(PdfPage[Cpt]) is TPdfRect
- then
- TPdfRect(PdfPage[Cpt]).Free
- else
- if TPdfElement(PdfPage[Cpt]) is TPdfLine
- then
- TPdfLine(PdfPage[Cpt]).Free
- else
- if TPdfElement(PdfPage[Cpt]) is TPdfSurf
- then
- TPdfSurf(PdfPage[Cpt]).Free
- else
- if TPdfElement(PdfPage[Cpt]) is TPdfImg
- then
- TPdfImg(PdfPage[Cpt]).Free;
-PdfPage.Free;
-DecimalSeparator:= OldSeparator;
-inherited;
-end;
-
-procedure T_Report.BeginWrite(IniOrientation: TOrient= oPortrait; IniPaperType: TPaperType= A4;
- IniMeasure: TMeasureUnit= msMM; IniVersion: Char= 'F'; IniVisu: Boolean= True);
-begin
-FVersion:= IniVersion;
-FOrientation:= IniOrientation;
-FPaperType:= IniPaperType;
-FMeasureUnit:= IniMeasure;
-FPreparation:= ppPrepare;
-FVisualization:= IniVisu;
-PrepareFormat;
-if IniVisu
-then
- CreateVisu;
-FCurrentFont:= -1;
-FCurrentLineSpace:= -1;
-FGroup:= False;
-with FPaper do
- VColumn:= T_Column.Create(Printable.L,Printable.R-Printable.L,0,clWhite);
-Columns.Add(VColumn);
-end;
-
-procedure T_Report.EndWrite;
-var
- Cpt: Integer;
-begin
-FPreparation:= ppPdfFile;
-if Sections.Count> 0
-then
- for Cpt:= 1 to Sections.Count do
- begin
- NumSection:= Cpt;
- if T_Section(Sections[Pred(NumSection)]).TotPages> 0
- then
- begin
- NumPageSection:= 1;
- NumPage:= 1;
- end;
- end
-else
- Exit;
-for Cpt:= 1 to T_Section(Sections[Pred(NumSection)]).TotPages do
- PrintPage(Cpt);
-if FVisualization
-then
- begin
- FPreparation:= ppVisualize;
- try
- WriteDocument;
- F_Visu.ShowModal;
- finally
- F_Visu.Free;
- end;
- end;
-end;
-
-procedure T_Report.WriteDocument;
-begin
-if FVisualization
-then
- FCanvas:= Bv_Visu.Canvas;
-end;
-
-procedure T_Report.PagePreview;
-begin
-FVisualization:= not FVisualization;
-if FVisualization
-then
- FCanvas:= Bv_Visu.Canvas;
-end;
-
-procedure T_Report.Section(MgLeft,MgRight,MgTop,MgBottom: Single; BackPos: Single;
- IniOrientation: TOrient= oPortrait);
-var
- CMargin: Single;
-begin
-case FPreparation of
- ppPrepare:
- begin
- FOrientation:= IniOrientation;
- PrepareFormat;
- with FCurrentMargin,FPaper do
- begin
- if Dim2Pixels(MgLeft)> Printable.L
- then
- L:= Dim2Pixels(MgLeft)
- else
- L:= Printable.L;
- if (W-Dim2Pixels(MgRight))< Printable.R
- then
- R:= W-Dim2Pixels(MgRight)
- else
- R:= Printable.R;
- if Dim2Pixels(MgTop)> Printable.T
- then
- T:= Dim2Pixels(MgTop)
- else
- T:= Printable.T;
- if (H-Dim2Pixels(MgBottom))< Printable.B
- then
- B:= H-Dim2Pixels(MgBottom)
- else
- B:= Printable.B;
- end;
- FPosRef.X:= FCurrentMargin.L;
- FHeaderHeight:= 0;
- FPageHeight:= 0;
- FFooterHeight:= 0;
- NumSection:= NumSection+1;
- VSection:= T_Section.Create(FPaper,FCurrentMargin,NumSection);
- Sections.Add(VSection);
- CMargin:= Dim2Pixels(BackPos);
- VColumn:= T_Column.Create(FCurrentMargin.L,FCurrentMargin.R-FCurrentMargin.L,CMargin,clWhite);
- T_Section(Sections[Pred(Sections.Count)]).DefaultCol:= Columns.Add(VColumn);
- end;
- end;
-end;
-
-procedure T_Report.Page;
-begin
-if FPreparation= ppPrepare
-then
- begin
- NumPage:= NumPage+1;
- T_Section(Sections[Pred(Sections.Count)]).LoadPage(NumPage);
- FPosRef.Y:= FCurrentMargin.T+FHeaderHeight;
- FPageHeight:= 0;
- end;
-end;
-
-function T_Report.BackColor(FdColor: TfpgColor): Integer;
-begin
-VBackColor:= T_BackColor.Create(FdColor);
-Result:= BackColors.Add(VBackColor);
-end;
-
-function T_Report.Font(FtNom: string; FtColor: TfpgColor): Integer;
-begin
-VFont:= T_Font.Create(FtNom,FtColor);
-Result:= Fonts.Add(VFont);
-end;
-
-function T_Report.LineStyle(StThick: Single; StColor: Tfpgcolor; StStyle: TfpgLineStyle): Integer;
-begin
-VLineStyle:= T_LineStyle.Create(StThick,StColor,StStyle);
-Result:= LineStyles.Add(VLineStyle);
-end;
-
-function T_Report.Border(BdFlags: TBorderFlags; BdStyle: Integer): Integer;
-begin
-VBorder:= T_Border.Create(BdFlags,BdStyle);
-Result:= Borders.Add(VBorder);
-end;
-
-//function T_Report.Border(BdFlags: TBorderFlags; StFlags: array of Integer): Integer;
-//begin
-//VBorder:= T_Border.Create(BdFlags,BdStyle);
-//Result:= Borders.Add(VBorder);
-//end;
-
-function T_Report.Column(ClnPos,ClnWidth: Single; ClnMargin: Single= 0; ClnColor: TfpgColor= clWhite): Integer;
-var
- CPos,CWidth,CMargin: Single;
-begin
-CPos:= Dim2Pixels(ClnPos);
-CWidth:= Dim2Pixels(ClnWidth);
-CMargin:= Dim2Pixels(ClnMargin);
-VColumn:= T_Column.Create(CPos,CWidth,CMargin,ClnColor);
-Result:= Columns.Add(VColumn);
-end;
-
-procedure T_Report.WriteHeader(Horiz,Verti: Single; Text: string; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1);
-var
- RefText: Integer;
- Flags: TfpgTextFlags;
-begin
-Flags:= [txtWrap];
-if Horiz< 0
-then
- begin
- if Horiz= cnLeft
- then
- Include(Flags,txtLeft);
- if Horiz= cnCenter
- then
- Include(Flags,txtHCenter);
- if Horiz= cnRight
- then
- Include(Flags,txtRight);
- end
-else
- Horiz:= Dim2Pixels(Horiz);
-if Verti> 0
-then
- Verti:= Dim2Pixels(Verti);
-RefText:= Texts.IndexOf(Text);
-if RefText= -1
-then
- RefText:= Texts.Add(Text);
-WriteText(Horiz,Verti,ColNum,RefText,FontNum,BkColorNum,BordNum,LineSpNum,Flags,zHeader);
-end;
-
-function T_Report.WritePage(Horiz,Verti: Single; Text: string; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1): Single;
-var
- RefText: Integer;
- Flags: TfpgTextFlags;
-begin
-Flags:= [txtWrap];
-if Horiz< 0
-then
- begin
- if Horiz= cnLeft
- then
- Include(Flags,txtLeft);
- if Horiz= cnCenter
- then
- Include(Flags,txtHCenter);
- if Horiz= cnRight
- then
- Include(Flags,txtRight);
- end
-else
- Horiz:= Dim2Pixels(Horiz);
-if Verti> 0
-then
- Verti:= Dim2Pixels(Verti);
-RefText:= Texts.IndexOf(Text);
-if RefText= -1
-then
- RefText:= Texts.Add(Text);
-Result:= WriteText(Horiz,Verti,ColNum,RefText,FontNum,BkColorNum,BordNum,LineSpNum,Flags,ZPage);
-end;
-
-procedure T_Report.WriteFooter(Horiz,Verti: Single; Text: string; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1);
-var
- RefText: Integer;
- Flags: TfpgTextFlags;
-begin
-Flags:= [txtWrap];
-if Horiz< 0
-then
- begin
- if Horiz= cnLeft
- then
- Include(Flags,txtLeft);
- if Horiz= cnCenter
- then
- Include(Flags,txtHCenter);
- if Horiz= cnRight
- then
- Include(Flags,txtRight);
- end
-else
- Horiz:= Dim2Pixels(Horiz);
-if Verti> 0
-then
- Verti:= Dim2Pixels(Verti);
-RefText:= Texts.IndexOf(Text);
-if RefText= -1
-then
- RefText:= Texts.Add(Text);
-WriteText(Horiz,Verti,ColNum,RefText,FontNum,BkColorNum,BordNum,LineSpNum,Flags,zFooter);
-end;
-
-procedure T_Report.NumSectionHeader(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= '';
- Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1);
-var
- RefTextPage,RefTextTot: Integer;
- Flags: TfpgTextFlags;
-begin
-Flags:= [];
-if Horiz< 0
-then
- begin
- if Horiz= cnLeft
- then
- Include(Flags,txtLeft);
- if Horiz= cnCenter
- then
- Include(Flags,txtHCenter);
- if Horiz= cnRight
- then
- Include(Flags,txtRight);
- end
-else
- Horiz:= Dim2Pixels(Horiz);
-if Verti> 0
-then
- Verti:= Dim2Pixels(Verti);
-RefTextPage:= Texts.IndexOf(TexteSect);
-if RefTextPage= -1
-then
- RefTextPage:= Texts.Add(TexteSect);
-RefTextTot:= Texts.IndexOf(TextTot);
-if RefTextTot= -1
-then
- RefTextTot:= Texts.Add(TextTot);
-WriteNumber(Horiz,Verti,ColNum,RefTextPage,RefTextTot,FontNum,BkColorNum,BordNum,LineSpNum,Flags,Total,Alpha,zHeader,SectNum);
-end;
-
-procedure T_Report.NumSectionFooter(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= '';
- Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0;BkColorNum: Integer= -1; BordNum: Integer= -1);
-var
- RefTextPage,RefTextTot: Integer;
- Flags: TfpgTextFlags;
-begin
-Flags:= [];
-if Horiz< 0
-then
- begin
- if Horiz= cnLeft
- then
- Include(Flags,txtLeft);
- if Horiz= cnCenter
- then
- Include(Flags,txtHCenter);
- if Horiz= cnRight
- then
- Include(Flags,txtRight);
- end
-else
- Horiz:= Dim2Pixels(Horiz);
-if Verti> 0
-then
- Verti:= Dim2Pixels(Verti);
-RefTextPage:= Texts.IndexOf(TexteSect);
-if RefTextPage= -1
-then
- RefTextPage:= Texts.Add(TexteSect);
-RefTextTot:= Texts.IndexOf(TextTot);
-if RefTextTot= -1
-then
- RefTextTot:= Texts.Add(TextTot);
-WriteNumber(Horiz,Verti,ColNum,RefTextPage,RefTextTot,FontNum,BkColorNum,BordNum,LineSpNum,Flags,Total,Alpha,zFooter,SectNum);
-end;
-
-procedure T_Report.NumPageHeader(Horiz,Verti: Single; TextePage: string= ''; TextTot: string= '';
- Total: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; LineSpNum: Integer= 0;
- BkColorNum: Integer= -1; BordNum: Integer= -1);
-var
- RefTextPage,RefTextTot: Integer;
- Flags: TfpgTextFlags;
-begin
-Flags:= [];
-if Horiz< 0
-then
- begin
- if Horiz= cnLeft
- then
- Include(Flags,txtLeft);
- if Horiz= cnCenter
- then
- Include(Flags,txtHCenter);
- if Horiz= cnRight
- then
- Include(Flags,txtRight);
- end
-else
- Horiz:= Dim2Pixels(Horiz);
-if Verti> 0
-then
- Verti:= Dim2Pixels(Verti);
-RefTextPage:= Texts.IndexOf(TextePage);
-if RefTextPage= -1
-then
- RefTextPage:= Texts.Add(TextePage);
-RefTextTot:= Texts.IndexOf(TextTot);
-if RefTextTot= -1
-then
- RefTextTot:= Texts.Add(TextTot);
-WriteNumber(Horiz,Verti,ColNum,RefTextPage,RefTextTot,FontNum,BkColorNum,BordNum,LineSpNum,Flags,Total,False,zHeader,PageNum);
-end;
-
-procedure T_Report.NumPageFooter(Horiz,Verti: Single; TextePage: string= ''; TextTot: string= '';
- Total: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0; LineSpNum: Integer= 0;
- BkColorNum: Integer= -1; BordNum: Integer= -1);
-var
- RefTextPage,RefTextTot: Integer;
- Flags: TfpgTextFlags;
-begin
-Flags:= [];
-if Horiz< 0
-then
- begin
- if Horiz= cnLeft
- then
- Include(Flags,txtLeft);
- if Horiz= cnCenter
- then
- Include(Flags,txtHCenter);
- if Horiz= cnRight
- then
- Include(Flags,txtRight);
- end
-else
- Horiz:= Dim2Pixels(Horiz);
-if Verti> 0
-then
- Verti:= Dim2Pixels(Verti);
-RefTextPage:= Texts.IndexOf(TextePage);
-if RefTextPage= -1
-then
- RefTextPage:= Texts.Add(TextePage);
-RefTextTot:= Texts.IndexOf(TextTot);
-if RefTextTot= -1
-then
- RefTextTot:= Texts.Add(TextTot);
-WriteNumber(Horiz,Verti,ColNum,RefTextPage,RefTextTot,FontNum,BkColorNum,BordNum,LineSpNum,Flags,Total,False,zFooter,PageNum);
-end;
-
-procedure T_Report.NumPageSectionHeader(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= '';
- Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1);
-var
- RefTextPage,RefTextTot: Integer;
- Flags: TfpgTextFlags;
-begin
-Flags:= [];
-if Horiz< 0
-then
- begin
- if Horiz= cnLeft
- then
- Include(Flags,txtLeft);
- if Horiz= cnCenter
- then
- Include(Flags,txtHCenter);
- if Horiz= cnRight
- then
- Include(Flags,txtRight);
- end
-else
- Horiz:= Dim2Pixels(Horiz);
-if Verti> 0
-then
- Verti:= Dim2Pixels(Verti);
-RefTextPage:= Texts.IndexOf(TexteSect);
-if RefTextPage= -1
-then
- RefTextPage:= Texts.Add(TexteSect);
-RefTextTot:= Texts.IndexOf(TextTot);
-if RefTextTot= -1
-then
- RefTextTot:= Texts.Add(TextTot);
-WriteNumber(Horiz,Verti,ColNum,RefTextPage,RefTextTot,FontNum,BkColorNum,BordNum,LineSpNum,Flags,Total,Alpha,zHeader,PSectNum);
-end;
-
-procedure T_Report.NumPageSectionFooter(Horiz,Verti: Single; TexteSect: string= ''; TextTot: string= '';
- Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FontNum: Integer= 0;
- LineSpNum: Integer= 0; BkColorNum: Integer= -1; BordNum: Integer= -1);
-var
- RefTextPage,RefTextTot: Integer;
- Flags: TfpgTextFlags;
-begin
-Flags:= [];
-if Horiz< 0
-then
- begin
- if Horiz= cnLeft
- then
- Include(Flags,txtLeft);
- if Horiz= cnCenter
- then
- Include(Flags,txtHCenter);
- if Horiz= cnRight
- then
- Include(Flags,txtRight);
- end
-else
- Horiz:= Dim2Pixels(Horiz);
-if Verti> 0
-then
- Verti:= Dim2Pixels(Verti);
-RefTextPage:= Texts.IndexOf(TexteSect);
-if RefTextPage= -1
-then
- RefTextPage:= Texts.Add(TexteSect);
-RefTextTot:= Texts.IndexOf(TextTot);
-if RefTextTot= -1
-then
- RefTextTot:= Texts.Add(TextTot);
-WriteNumber(Horiz,Verti,ColNum,RefTextPage,RefTextTot,FontNum,BkColorNum,BordNum,LineSpNum,Flags,Total,Alpha,zFooter,PSectNum);
-end;
-
-procedure T_Report.HorizLineHeader(SpBefore,SpAfter: Single; ColNum: Integer= 0; StyleNum: Integer= 0);
-begin
-DrawAHorizLine(Dim2Pixels(SpBefore),Dim2Pixels(SpAfter),ColNum,-1,StyleNum,zHeader);
-end;
-
-procedure T_Report.HorizLinePage(SpBefore,SpAfter: Single; ColNum: Integer= 0; StyleNum: Integer= 0);
-begin
-DrawAHorizLine(Dim2Pixels(SpBefore),Dim2Pixels(SpAfter),ColNum,-1,StyleNum,zPage);
-end;
-
-procedure T_Report.HorizLineFooter(SpBefore,SpAfter: Single; ColNum: Integer= 0; StyleNum: Integer= 0);
-begin
-DrawAHorizLine(Dim2Pixels(SpBefore),Dim2Pixels(SpAfter),ColNum,-1,StyleNum,zFooter);
-end;
-
-procedure T_Report.SpaceHeader(Verti: Single; ColNum: Integer= 0; BkColorNum: Integer= -1);
-begin
-InsertSpace(-1,ColNum,Dim2Pixels(Verti),BkColorNum,zHeader);
-end;
-
-procedure T_Report.SpacePage(Verti: Single; ColNum: Integer= 0; BkColorNum: Integer= -1);
-begin
-InsertSpace(-1,ColNum,Dim2Pixels(Verti),BkColorNum,zPage);
-end;
-
-procedure T_Report.SpaceFooter(Verti: Single; ColNum: Integer= 0; BkColorNum: Integer= -1);
-begin
-InsertSpace(-1,ColNum,Dim2Pixels(Verti),BkColorNum,zFooter);
-end;
-
-function T_Report.LineSpace(SpSup,SpInt,SpInf: Single): Integer;
-var
- Sup,Int,Inf: Integer;
-begin
-if SpSup> 0
-then
- Sup:= Round(Dim2Pixels(SpSup))
-else
- Sup:= 0;
-if SpInt> 0
-then
- Int:= Round(Dim2Pixels(SpInt))
-else
- Int:= 0;
-if SpInf> 0
-then
- Inf:= Round(Dim2Pixels(SpInf))
-else
- Inf:= 0;
-VLineSpace:= T_LineSpace.Create(Sup,Int,Inf);
-Result:= LineSpaces.Add(VLineSpace);
-end;
-
-procedure T_Report.BeginGroup(PageJump: Boolean= False);
-begin
-VGroup:= T_Group.Create;
-FGroup:= True;
-if PageJump
-then
- Page;
-end;
-
-procedure T_Report.EndGroup(PageJump: Boolean= False);
-begin
-T_Section(Sections[Pred(Sections.Count)]).LoadCmdGroupToPage;
-FGroup:= False;
-VGroup.Free;
-if PageJump
-then
- Page;
-end;
-
-procedure T_Report.ColorColChange(ColNum: Integer; ColColor: TfpgColor);
-begin
-T_Column(Columns[ColNum]).SetColColor(ColColor);
-end;
-
-procedure T_Report.FrameMargins(AStyle: Integer);
-begin
-DrawAFrame(AStyle,zMargins);
-end;
-
-procedure T_Report.FrameHeader(AStyle: Integer);
-begin
-DrawAFrame(AStyle,zHeader);
-end;
-
-procedure T_Report.FramePage(AStyle: Integer);
-begin
-DrawAFrame(AStyle,zPage);
-end;
-
-procedure T_Report.FrameFooter(AStyle: Integer);
-begin
-DrawAFrame(AStyle,zFooter);
-end;
-
-procedure T_Report.LinePage(XBegin,YBegin,XEnd,YEnd: Single; AStyle: Integer);
-begin
-DrawALine(Dim2Pixels(XBegin),Dim2Pixels(YBegin),Dim2Pixels(XEnd),Dim2Pixels(YEnd),AStyle);
-end;
-
-procedure T_Report.SurfPage(XLimits,YLimits: array of Single; AColor: TfpgColor);
-var
- Size,Cpt: Integer;
- Ends: array of TRefPos;
-begin
-if Length(XLimits)< Length(YLimits)
-then
- Size:= Length(XLimits)
-else
- if Length(XLimits)> Length(YLimits)
- then
- Size:= Length(YLimits)
- else
- Size:= Length(XLimits);
-SetLength(Ends,Size);
-for Cpt:= 0 to Pred(Size) do
- begin
- Ends[Cpt].X:= Dim2Pixels(XLimits[Cpt]);
- Ends[Cpt].Y:= Dim2Pixels(YLimits[Cpt]);
- end;
-PaintSurface(Ends,AColor);
-end;
-
-procedure T_Report.ImageHeader(Horiz,Verti: Single; ImgFileName: string; ColNum,Scale: Integer);
-var
- RefImage: Integer;
- Image: TfpgImage;
-begin
-Horiz:= Dim2Pixels(Horiz);
-Verti:= Dim2Pixels(Verti);
-if FileExists(ImgFileName)
-then
- begin
- RefImage:= ImageNames.IndexOf(IntToStr(Scale)+ImgFileName);
- if RefImage= -1
- then
- begin
- if Copy(ImgFileName,Succ(Pos('.',ImgFileName)),3)= 'bmp'
- then
- begin
- Image:= LoadImage_BMP(ImgFileName);
- Scale:= 1;
- end;
- if (Copy(ImgFileName,Succ(Pos('.',ImgFileName)),3)= 'jpg') or (Copy(ImgFileName,Succ(Pos('.',ImgFileName)),4)= 'jpeg')
- then
- Image:= LoadImage_JPG(ImgFileName,Scale);
- RefImage:= ImageNames.Add(IntToStr(Scale)+ImgFileName);
- Images.Add(Image);
- end;
- PaintImage(Horiz,Verti,ColNum,RefImage,zHeader);
- end
-else
- if fpgImages.GetImage(ImgFileName)<> nil
- then
- begin
- RefImage:= ImageNames.IndexOf(IntToStr(Scale)+ImgFileName);
- if RefImage= -1
- then
- begin
- Image:= fpgImages.GetImage(ImgFileName);
- Scale:= 1;
- RefImage:= ImageNames.Add(IntToStr(Scale)+ImgFileName);
- Images.Add(Image);
- end;
- PaintImage(Horiz,Verti,ColNum,RefImage,zPage);
- end
- else
- ShowMessage('Image '+ImgFileName+' is missing');
-end;
-
-procedure T_Report.ImagePage(Horiz,Verti: Single; ImgFileName: string; ColNum,Scale: Integer);
-var
- RefImage: Integer;
- Image: TfpgImage;
-begin
-Horiz:= Dim2Pixels(Horiz);
-Verti:= Dim2Pixels(Verti);
-if FileExists(ImgFileName)
-then
- begin
- RefImage:= ImageNames.IndexOf(IntToStr(Scale)+ImgFileName);
- if RefImage= -1
- then
- begin
- if Copy(ImgFileName,Succ(Pos('.',ImgFileName)),3)= 'bmp'
- then
- begin
- Image:= LoadImage_BMP(ImgFileName);
- Scale:= 1;
- end;
- if (Copy(ImgFileName,Succ(Pos('.',ImgFileName)),3)= 'jpg') or (Copy(ImgFileName,Succ(Pos('.',ImgFileName)),4)= 'jpeg')
- then
- Image:= LoadImage_JPG(ImgFileName,Scale);
- RefImage:= ImageNames.Add(IntToStr(Scale)+ImgFileName);
- Images.Add(Image);
- end;
- PaintImage(Horiz,Verti,ColNum,RefImage,zPage);
- end
-else
- if fpgImages.GetImage(ImgFileName)<> nil
- then
- begin
- RefImage:= ImageNames.IndexOf(IntToStr(Scale)+ImgFileName);
- if RefImage= -1
- then
- begin
- Image:= fpgImages.GetImage(ImgFileName);
- Scale:= 1;
- RefImage:= ImageNames.Add(IntToStr(Scale)+ImgFileName);
- Images.Add(Image);
- end;
- PaintImage(Horiz,Verti,ColNum,RefImage,zPage);
- end
- else
- ShowMessage('Image '+ImgFileName+' is missing');
-end;
-
-procedure T_Report.ImageFooter(Horiz,Verti: Single; ImgFileName: string; ColNum,Scale: Integer);
-var
- RefImage: Integer;
- Image: TfpgImage;
-begin
-Horiz:= Dim2Pixels(Horiz);
-Verti:= Dim2Pixels(Verti);
-if FileExists(ImgFileName)
-then
- begin
- RefImage:= ImageNames.IndexOf(IntToStr(Scale)+ImgFileName);
- if RefImage= -1
- then
- begin
- if Copy(ImgFileName,Succ(Pos('.',ImgFileName)),3)= 'bmp'
- then
- begin
- Image:= LoadImage_BMP(ImgFileName);
- Scale:= 1;
- end;
- if (Copy(ImgFileName,Succ(Pos('.',ImgFileName)),3)= 'jpg') or (Copy(ImgFileName,Succ(Pos('.',ImgFileName)),4)= 'jpeg')
- then
- Image:= LoadImage_JPG(ImgFileName,Scale);
- RefImage:= ImageNames.Add(IntToStr(Scale)+ImgFileName);
- Images.Add(Image);
- end;
- PaintImage(Horiz,Verti,ColNum,RefImage,zFooter);
- end
-else
- if fpgImages.GetImage(ImgFileName)<> nil
- then
- begin
- RefImage:= ImageNames.IndexOf(IntToStr(Scale)+ImgFileName);
- if RefImage= -1
- then
- begin
- Image:= fpgImages.GetImage(ImgFileName);
- Scale:= 1;
- RefImage:= ImageNames.Add(IntToStr(Scale)+ImgFileName);
- Images.Add(Image);
- end;
- PaintImage(Horiz,Verti,ColNum,RefImage,zPage);
- end
- else
- ShowMessage('Image '+ImgFileName+' is missing');
-end;
-
-end.
-
diff --git a/extras/contributed/report_tool/reportengine/u_reportimages.pas b/extras/contributed/report_tool/reportengine/u_reportimages.pas
deleted file mode 100644
index e7d69b92..00000000
--- a/extras/contributed/report_tool/reportengine/u_reportimages.pas
+++ /dev/null
@@ -1,181 +0,0 @@
-{
- << Impressions >> U_ReportImages.pas
-
- Copyright (C) 2010 - Jean-Marc Levecque <jean-marc.levecque@jmlesite.fr>
-
- 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 contains the images used by the preview dialog
-}
-
-unit U_ReportImages;
-
-{$mode objfpc}
-
-interface
-
-uses
- fpg_main;
-
-procedure CreateReportImages;
-function DeleteReportImages: Boolean;
-
-implementation
-
-const
- repimg_Fin : Array[0..245] of byte = (
- 66, 77,246, 0, 0, 0, 0, 0, 0, 0,118, 0, 0, 0, 40, 0, 0,
- 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 4, 0, 0, 0, 0, 0,
- 128, 0, 0, 0, 18, 11, 0, 0, 18, 11, 0, 0, 0, 0, 0, 0, 16,
- 0, 0, 0, 0, 0, 0, 0, 0, 0,128, 0, 0,128, 0, 0, 0,128,
- 128, 0,128, 0, 0, 0,128, 0,128, 0,128,128, 0, 0,192,192,192,
- 0,128,128,128, 0, 0, 0,255, 0, 0,255, 0, 0, 0,255,255, 0,
- 255, 0, 0, 0,255, 0,255, 0,255,255, 0, 0,255,255,255, 0,119,
- 119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,
- 119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,113,
- 119,119,116, 71,119,119,119,113, 23,119,116, 71,119,119,119,113, 17,
- 119,116, 71,119,119,119,113, 17, 23,116, 71,119,119,119,113, 17, 17,
- 116, 71,119,119,119,113, 17, 23,116, 71,119,119,119,113, 17,119,116,
- 71,119,119,119,113, 23,119,116, 71,119,119,119,113,119,119,116, 71,
- 119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,
- 119,119,119,119,119,119,119,119);
-
-const
- repimg_Imprimante : Array[0..357] of byte = (
- 66, 77,102, 1, 0, 0, 0, 0, 0, 0,118, 0, 0, 0, 40, 0, 0,
- 0, 20, 0, 0, 0, 20, 0, 0, 0, 1, 0, 4, 0, 0, 0, 0, 0,
- 240, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0,128, 0, 0,128, 0, 0, 0,128,
- 128, 0,128, 0, 0, 0,128, 0,128, 0,128,128, 0, 0,192,192,192,
- 0,128,128,128, 0, 0, 0,255, 0, 0,255, 0, 0, 0,255,255, 0,
- 255, 0, 0, 0,255, 0,255, 0,255,255, 0, 0,255,255,255, 0, 51,
- 51, 51, 51, 51, 51, 51, 51, 51, 51, 0, 0, 51, 51, 51, 51, 51, 51,
- 51, 51, 51, 51, 0, 0, 51, 0, 3, 51, 51, 51, 51, 48, 0, 51, 0,
- 0, 48, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 48,247,119,119,
- 119,119,119,119,119, 3, 0, 0, 48,247,119,119,119,119,119,119,119,
- 3, 0, 0, 48,247,119,119,119,119,119,153,119, 3, 0, 0, 48,255,
- 255,255,255,255,255,255,255, 3, 0, 0, 56, 0,136,136,136,136,136,
- 136, 0,131, 0, 0, 51, 48, 0, 0, 0, 0, 0, 0, 3, 51, 0, 0,
- 51, 48,136,136,136,136,136,136, 3, 51, 0, 0, 51, 48, 0, 0, 0,
- 0, 0, 0, 3, 51, 0, 0, 51, 51, 51, 51, 51, 51, 51, 51, 51, 51,
- 0, 0, 51, 51, 51, 51, 51, 51, 56, 0, 8, 51, 0, 0, 51, 51, 51,
- 51, 51, 51, 48,239,224, 51, 0, 0, 51, 56, 0, 0, 0, 0, 14,240,
- 8, 51, 0, 0, 51, 48,224,239,239,239, 63,224, 51, 51, 0, 0, 51,
- 56, 0, 0, 0, 0, 14,240, 8, 51, 0, 0, 51, 51, 51, 51, 51, 51,
- 48,239,224, 51, 0, 0, 51, 51, 51, 51, 51, 51, 56, 0, 8, 51, 0,
- 0);
-
-const
- repimg_Precedent : Array[0..245] of byte = (
- 66, 77,246, 0, 0, 0, 0, 0, 0, 0,118, 0, 0, 0, 40, 0, 0,
- 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 4, 0, 0, 0, 0, 0,
- 128, 0, 0, 0, 18, 11, 0, 0, 18, 11, 0, 0, 16, 0, 0, 0, 16,
- 0, 0, 0, 0, 0, 0, 0, 0, 0,128, 0, 0,128, 0, 0, 0,128,
- 128, 0,128, 0, 0, 0,128, 0,128, 0,128,128, 0, 0,128,128,128,
- 0,192,192,192, 0, 0, 0,255, 0,192,192,192, 0, 0,255,255, 0,
- 255, 0, 0, 0,192,192,192, 0,255,255, 0, 0,255,255,255, 0,218,
- 218,218,218,218,218,218,218,173,173,173,173,173,173,173,173,218,218,
- 218,218,218,218,218,218,173,173,173,173,173,173,173,173,218,218,218,
- 218,209,218,218,218,173,173,173,173, 17,173,173,173,218,218,218,209,
- 17,218,218,218,173,173,173, 17, 17,173,173,173,218,218,209, 17, 17,
- 218,218,218,173,173,173, 17, 17,173,173,173,218,218,218,209, 17,218,
- 218,218,173,173,173,173, 17,173,173,173,218,218,218,218,209,218,218,
- 218,173,173,173,173,173,173,173,173,218,218,218,218,218,218,218,218,
- 173,173,173,173,173,173,173,173);
-
-const
- repimg_Stop : Array[0..245] of byte = (
- 66, 77,246, 0, 0, 0, 0, 0, 0, 0,118, 0, 0, 0, 40, 0, 0,
- 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 4, 0, 0, 0, 0, 0,
- 128, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0,128, 0, 0,128, 0, 0, 0,128,
- 128, 0,128, 0, 0, 0,128, 0,128, 0,128,128, 0, 0,192,192,192,
- 0,128,128,128, 0, 0, 0,255, 0, 0,255, 0, 0, 0,255,255, 0,
- 255, 0, 0, 0,255, 0,255, 0,255,255, 0, 0,255,255,255, 0, 51,
- 35,153,153,153,153, 34, 35, 51, 41,153,153,153,153,147, 51, 50,153,
- 153,153,153,153,153, 51, 41,153,153,153,153,153,153,147,153,255,153,
- 249,159,153,249,153,159,153,249,249,249,249,249,153,153,153,249,249,
- 249,249,249,153,153,159,153,249,249,249,255,153,153,249,153,249,249,
- 249,249,249,159,153,153,249,249,249,249,249,159,153,249,249,249,249,
- 249,249,153,255,159,255,159,153,255,153, 57,153,153,153,153,153,153,
- 147, 51,153,153,153,153,153,153, 51, 51, 57,153,153,153,153,147, 51,
- 51, 51,153,153,153,153, 51, 51);
-
-const
- repimg_Suivant : Array[0..245] of byte = (
- 66, 77,246, 0, 0, 0, 0, 0, 0, 0,118, 0, 0, 0, 40, 0, 0,
- 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 4, 0, 0, 0, 0, 0,
- 128, 0, 0, 0, 18, 11, 0, 0, 18, 11, 0, 0, 16, 0, 0, 0, 16,
- 0, 0, 0, 0, 0, 0, 0, 0, 0,128, 0, 0,128, 0, 0, 0,128,
- 128, 0,128, 0, 0, 0,128, 0,128, 0,128,128, 0, 0,128,128,128,
- 0,192,192,192, 0, 0, 0,255, 0,192,192,192, 0, 0,255,255, 0,
- 255, 0, 0, 0,192,192,192, 0,255,255, 0, 0,255,255,255, 0,218,
- 218,218,218,218,218,218,218,173,173,173,173,173,173,173,173,218,218,
- 218,218,218,218,218,218,173,173,173,173,173,173,173,173,218,218,218,
- 26,218,218,218,218,173,173,173, 17,173,173,173,173,218,218,218, 17,
- 26,218,218,218,173,173,173, 17, 17,173,173,173,218,218,218, 17, 17,
- 26,218,218,173,173,173, 17, 17,173,173,173,218,218,218, 17, 26,218,
- 218,218,173,173,173, 17,173,173,173,173,218,218,218, 26,218,218,218,
- 218,173,173,173,173,173,173,173,173,218,218,218,218,218,218,218,218,
- 173,173,173,173,173,173,173,173);
-
-const
- repimg_Debut : Array[0..245] of byte = (
- 66, 77,246, 0, 0, 0, 0, 0, 0, 0,118, 0, 0, 0, 40, 0, 0,
- 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 4, 0, 0, 0, 0, 0,
- 128, 0, 0, 0, 18, 11, 0, 0, 18, 11, 0, 0, 0, 0, 0, 0, 16,
- 0, 0, 0, 0, 0, 0, 0, 0, 0,128, 0, 0,128, 0, 0, 0,128,
- 128, 0,128, 0, 0, 0,128, 0,128, 0,128,128, 0, 0,192,192,192,
- 0,128,128,128, 0, 0, 0,255, 0, 0,255, 0, 0, 0,255,255, 0,
- 255, 0, 0, 0,255, 0,255, 0,255,255, 0, 0,255,255,255, 0,119,
- 119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,
- 119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119, 68,
- 119,119,113,119,119,119,119, 68,119,119, 17,119,119,119,119, 68,119,
- 113, 17,119,119,119,119, 68,119, 17, 17,119,119,119,119, 68,113, 17,
- 17,119,119,119,119, 68,119, 17, 17,119,119,119,119, 68,119,113, 17,
- 119,119,119,119, 68,119,119, 17,119,119,119,119, 68,119,119,113,119,
- 119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,119,
- 119,119,119,119,119,119,119,119);
-
-procedure CreateReportImages;
-begin
-
- fpgImages.AddMaskedBMP('repimg.Last',@repimg_Fin,sizeof(repimg_Fin),0,0);
-
- fpgImages.AddMaskedBMP('repimg.Printer',@repimg_Imprimante,sizeof(repimg_Imprimante),0,0);
-
- fpgImages.AddMaskedBMP('repimg.Precedent',@repimg_Precedent,sizeof(repimg_Precedent),0,0);
-
- fpgImages.AddMaskedBMP('repimg.Stop',@repimg_Stop,sizeof(repimg_Stop),0,0);
-
- fpgImages.AddMaskedBMP('repimg.Next',@repimg_Suivant,sizeof(repimg_Suivant),0,0);
-
- fpgImages.AddMaskedBMP('repimg.First',@repimg_Debut,sizeof(repimg_Debut),0,0);
-
-end;
-
-function DeleteReportImages: Boolean;
-begin
-
- fpgImages.DeleteImage('repimg.Last',True);
-
- fpgImages.DeleteImage('repimg.Printer',True);
-
- fpgImages.DeleteImage('repimg.Precedent',True);
-
- fpgImages.DeleteImage('repimg.Stop',True);
-
- fpgImages.DeleteImage('repimg.Next',True);
-
- fpgImages.DeleteImage('repimg.First',True);
-
-end;
-
-end.
-
diff --git a/extras/contributed/report_tool/reportengine/u_visu.pas b/extras/contributed/report_tool/reportengine/u_visu.pas
deleted file mode 100644
index 80038a1a..00000000
--- a/extras/contributed/report_tool/reportengine/u_visu.pas
+++ /dev/null
@@ -1,538 +0,0 @@
-{
- << Impressions >> U_Visu.pas
-
- Copyright (C) 2010 - Jean-Marc Levecque <jean-marc.levecque@jmlesite.fr>
-
- 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 is the preview form
-}
-
-unit U_Visu;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Classes, SysUtils,
- {$ifdef win32}
- shellapi,
- {$endif}
- fpg_base, fpg_main,
- fpg_form, fpg_panel, fpg_label, fpg_button, fpg_edit, fpg_dialogs, fpg_utils,
- U_Report;
-
-type
- TF_Visu = class(TfpgForm)
- private
- FReport: T_Report;
- Bv_Command: TfpgBevel;
- Bt_Close: TfpgButton;
- Bt_Print: TfpgButton;
- Bt_Printer: TfpgButton;
- Bt_Stop: TfpgButton;
- Bt_Pdf: TfpgButton;
- Bv_Pages: TfpgBevel;
- L_Pages: TfpgLabel;
- Bt_FirstPage: TfpgButton;
- Bt_PrecPage: TfpgButton;
- E_NumPage: TfpgEditInteger;
- Bt_NextPage: TfpgButton;
- Bt_LastPage: TfpgButton;
- L_FromPage: Tfpglabel;
- L_NbrPages: TfpgLabel;
- Bv_Sections: TfpgBevel;
- L_Sections: TfpgLabel;
- Bt_PrecSect: TfpgButton;
- E_NumSect: TfpgEditInteger;
- Bt_NextSect: TfpgButton;
- L_FromSect: Tfpglabel;
- L_NbrSect: TfpgLabel;
- L_PageSect: Tfpglabel;
- L_NumPageSect: Tfpglabel;
- L_FromPageSect: TfpgLabel;
- L_NbrPageSect: TfpgLabel;
- procedure FormShow(Sender: TObject);
- procedure Bt_CloseClick(Sender: TObject);
- procedure Bt_PrintClick(Sender: TObject);
- procedure Bt_PrinterClick(Sender: TObject);
- procedure Bt_StopClick(Sender: TObject);
- procedure Bt_PdfClick(Sender: TObject);
- procedure Bt_FirstPageClick(Sender: TObject);
- procedure Bt_PrecPageClick(Sender: TObject);
- procedure Bt_NextPageClick(Sender: TObject);
- procedure Bt_LastPageClick(Sender: TObject);
- procedure Bt_PrecSectClick(Sender: TObject);
- procedure Bt_NextSectClick(Sender: TObject);
- procedure E_NumPageKeyPress(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState;
- var Consumed: boolean);
- procedure E_NumSectKeyPress(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState;
- var Consumed: boolean);
- procedure ChangeButtons;
- public
- constructor Create(AOwner: TComponent; AImprime: T_Report); reintroduce;
- destructor Destroy; override;
- end;
-
-var
- F_Visu: TF_Visu;
- Bv_Visu: TfpgBevel;
-
-implementation
-
-uses
- U_Command, U_Pdf, U_ReportImages;
-
-procedure TF_Visu.FormShow(Sender: TObject);
-begin
-L_Pages.Text:= 'Page';
-L_Sections.Text:= 'Section';
-L_PageSect.Text:= 'Page';
-L_FromPage.Text:= 'of';
-with FReport do
- begin
- if Sections.Count= 1
- then
- E_NumSect.Focusable:= False;
- if T_Section(Sections[Pred(Sections.Count)]).TotPages= 1
- then
- E_NumPage.Focusable:= False;
- E_NumPage.Text:= IntToStr(NumPage);
- L_NbrPages.Text:= IntToStr(T_Section(Sections[Pred(Sections.Count)]).TotPages);
- E_NumSect.Text:= IntToStr(NumSection);
- L_NbrSect.Text:= IntToStr(Sections.Count);
- L_NumPageSect.Text:= IntToStr(NumPageSection);
- L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumSection)]).NbPages);
- ChangeButtons;
- end;
-end;
-
-procedure TF_Visu.Bt_CloseClick(Sender: TObject);
-begin
-Close;
-end;
-
-procedure TF_Visu.Bt_PrintClick(Sender: TObject);
-begin
-end;
-
-procedure TF_Visu.Bt_PrinterClick(Sender: TObject);
-begin
-end;
-
-procedure TF_Visu.Bt_StopClick(Sender: TObject);
-begin
-end;
-
-procedure TF_Visu.Bt_PdfClick(Sender: TObject);
-var
- Fd_SavePdf: TfpgFileDialog;
- PdfFile: string;
- PdfFileStream: TFileStream;
-begin
-Fd_SavePdf:= TfpgFileDialog.Create(nil);
-Fd_SavePdf.InitialDir:= ExtractFilePath(Paramstr(0));
-Fd_SavePdf.FontDesc:= 'bitstream vera sans-9';
-Fd_SavePdf.Filter:= 'Fichiers pdf |*.pdf';
-Fd_SavePdf.FileName:= FReport.DefaultFile;
-try
- if Fd_SavePdf.RunSaveFile
- then
- begin
- PdfFile:= Fd_SavePdf.FileName;
- if Lowercase(Copy(PdfFile,Length(PdfFile)-3,4))<> '.pdf'
- then
- PdfFile:= PdfFile+'.pdf';
- Document:= TPdfDocument.CreateDocument;
- with Document do
- begin
- PdfFileStream:= TFileStream.Create(PdfFile,fmCreate);
- WriteDocument(PdfFileStream);
- PdfFileStream.Free;
- Free;
- end;
-{$ifdef linux}
- fpgOpenURL(PdfFile);
-{$endif}
-{$ifdef win32}
- ShellExecute(0,PChar('OPEN'),PChar(PdfFile),PChar(''),PChar(''),1);
-{$endif}
- end;
-finally
- Fd_SavePdf.Free;
- end;
-end;
-
-procedure TF_Visu.Bt_FirstPageClick(Sender: TObject);
-begin
-with FReport do
- begin
- NumPage:= 1;
- NumSection:= 1;
- NumPageSection:= 1;
- E_NumPage.Text:= IntToStr(NumPage);
- Bv_Visu.Visible:= False;
- with T_Section(Sections[Pred(NumSection)]),F_Visu do
- begin
- Bv_Visu.Height:= Paper.H;
- Bv_Visu.Width:= Paper.W;
- Bv_Visu.Top:= 50+(F_Visu.Height-50-Paper.H) div 2;
- Bv_Visu.Left:= (F_Visu.Width-Paper.W) div 2;
- end;
- Bv_Visu.Visible:= True;
- ChangeButtons;
- E_NumSect.Text:= IntToStr(NumSection);
- L_NumPageSect.Text:= IntToStr(NumPageSection);
- L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumSection)]).NbPages);
- end;
-end;
-
-procedure TF_Visu.Bt_PrecPageClick(Sender: TObject);
-begin
-with FReport do
- begin
- NumPage:= NumPage-1;
- if NumPageSection= 1
- then
- begin
- NumSection:= NumSection-1;
- NumPageSection:= T_Section(Sections[Pred(NumSection)]).NbPages;
- Bv_Visu.Visible:= False;
- with T_Section(Sections[Pred(NumSection)]),F_Visu do
- begin
- Bv_Visu.Height:= Paper.H;
- Bv_Visu.Width:= Paper.W;
- Bv_Visu.Top:= 50+(F_Visu.Height-50-Paper.H) div 2;
- Bv_Visu.Left:= (F_Visu.Width-Paper.W) div 2;
- end;
- Bv_Visu.Visible:= True;
- end
- else
- begin
- NumPageSection:= NumPageSection-1;
- Bv_Visu.Invalidate;
- end;
- E_NumPage.Text:= IntToStr(NumPage);
- ChangeButtons;
- E_NumSect.Text:= IntToStr(NumSection);
- L_NumPageSect.Text:= IntToStr(NumPageSection);
- L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumSection)]).NbPages);
- end;
-end;
-
-procedure TF_Visu.Bt_NextPageClick(Sender: TObject);
-begin
-with FReport do
- begin
- NumPage:= NumPage+1;
- if NumPageSection= T_Section(Sections[Pred(NumSection)]).NbPages
- then
- begin
- NumSection:= NumSection+1;
- NumPageSection:= 1;
- Bv_Visu.Visible:= False;
- with T_Section(Sections[Pred(NumSection)]),F_Visu do
- begin
- Bv_Visu.Height:= Paper.H;
- Bv_Visu.Width:= Paper.W;
- Bv_Visu.Top:= 50+(F_Visu.Height-50-Paper.H) div 2;
- Bv_Visu.Left:= (F_Visu.Width-Paper.W) div 2;
- end;
- Bv_Visu.Visible:= True;
- end
- else
- begin
- NumPageSection:= NumPageSection+1;
- Bv_Visu.Invalidate;
- end;
- E_NumPage.Text:= IntToStr(NumPage);
- ChangeButtons;
- E_NumSect.Text:= IntToStr(NumSection);
- L_NumPageSect.Text:= IntToStr(NumPageSection);
- L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumSection)]).NbPages);
- end;
-end;
-
-procedure TF_Visu.Bt_LastPageClick(Sender: TObject);
-begin
-with FReport do
- begin
- NumPage:= T_Section(Sections[Pred(Sections.Count)]).TotPages;
- NumSection:= Sections.Count;
- NumPageSection:= T_Section(Sections[Pred(Sections.Count)]).NbPages;
- E_NumPage.Text:= IntToStr(NumPage);
- Bv_Visu.Visible:= False;
- with T_Section(Sections[Pred(NumSection)]),F_Visu do
- begin
- Bv_Visu.Height:= Paper.H;
- Bv_Visu.Width:= Paper.W;
- Bv_Visu.Top:= 50+(F_Visu.Height-50-Paper.H) div 2;
- Bv_Visu.Left:= (F_Visu.Width-Paper.W) div 2;
- end;
- Bv_Visu.Visible:= True;
- ChangeButtons;
- E_NumSect.Text:= IntToStr(NumSection);
- L_NumPageSect.Text:= IntToStr(NumPageSection);
- L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumSection)]).NbPages);
- end;
-end;
-
-procedure TF_Visu.Bt_PrecSectClick(Sender: TObject);
-begin
-with FReport do
- begin
- NumSection:= NumSection-1;
- NumPage:= T_Section(Sections[Pred(NumSection)]).FirstPage;
- NumPageSection:= 1;
- E_NumPage.Text:= IntToStr(NumPage);
- Bv_Visu.Visible:= False;
- with T_Section(Sections[Pred(NumSection)]),F_Visu do
- begin
- Bv_Visu.Height:= Paper.H;
- Bv_Visu.Width:= Paper.W;
- Bv_Visu.Top:= 50+(F_Visu.Height-50-Paper.H) div 2;
- Bv_Visu.Left:= (F_Visu.Width-Paper.W) div 2;
- end;
- Bv_Visu.Visible:= True;
- ChangeButtons;
- E_NumSect.Text:= IntToStr(NumSection);
- L_NumPageSect.Text:= IntToStr(NumPageSection);
- L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumSection)]).NbPages);
- end;
-end;
-
-procedure TF_Visu.Bt_NextSectClick(Sender: TObject);
-begin
-with FReport do
- begin
- NumSection:= NumSection+1;
- NumPage:= T_Section(Sections[Pred(NumSection)]).FirstPage;
- NumPageSection:= 1;
- E_NumPage.Text:= IntToStr(NumPage);
- Bv_Visu.Visible:= False;
- with T_Section(Sections[Pred(NumSection)]),F_Visu do
- begin
- Bv_Visu.Height:= Paper.H;
- Bv_Visu.Width:= Paper.W;
- Bv_Visu.Top:= 50+(F_Visu.Height-50-Paper.H) div 2;
- Bv_Visu.Left:= (F_Visu.Width-Paper.W) div 2;
- end;
- Bv_Visu.Visible:= True;
- ChangeButtons;
- E_NumSect.Text:= IntToStr(NumSection);
- L_NumPageSect.Text:= IntToStr(NumPageSection);
- L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumSection)]).NbPages);
- end;
-end;
-
-procedure TF_Visu.ChangeButtons;
-begin
-with FReport do
- if T_Section(Sections[Pred(Sections.Count)]).TotPages> 1
- then
- if NumPage= 1
- then
- begin
- Bt_FirstPage.Enabled:= False;
- Bt_PrecPage.Enabled:= False;
- Bt_NextPage.Enabled:= True;
- Bt_LastPage.Enabled:= True;
- Bt_PrecSect.Enabled:= False;
- if Sections.Count> 1
- then
- Bt_NextSect.Enabled:= True
- else
- Bt_NextSect.Enabled:= False;
- end
- else
- if NumPage= T_Section(Sections[Pred(Sections.Count)]).TotPages
- then
- begin
- Bt_FirstPage.Enabled:= True;
- Bt_PrecPage.Enabled:= True;
- Bt_NextPage.Enabled:= False;
- Bt_LastPage.Enabled:= False;
- if Sections.Count> 1
- then
- Bt_PrecSect.Enabled:= True
- else
- Bt_PrecSect.Enabled:= False;
- Bt_NextSect.Enabled:= False;
- end
- else
- begin
- Bt_FirstPage.Enabled:= True;
- Bt_PrecPage.Enabled:= True;
- Bt_NextPage.Enabled:= True;
- Bt_LastPage.Enabled:= True;
- if Sections.Count> 1
- then
- if NumSection= 1
- then
- begin
- Bt_PrecSect.Enabled:= False;
- Bt_NextSect.Enabled:= True;
- end
- else
- if NumSection= Sections.Count
- then
- begin
- Bt_PrecSect.Enabled:= True;
- Bt_NextSect.Enabled:= False;
- end
- else
- begin
- Bt_PrecSect.Enabled:= True;
- Bt_NextSect.Enabled:= True;
- end
- else
- begin
- Bt_PrecSect.Enabled:= False;
- Bt_NextSect.Enabled:= False;
- end;
- end
- else
- begin
- Bt_FirstPage.Enabled:= False;
- Bt_PrecPage.Enabled:= False;
- Bt_NextPage.Enabled:= False;
- Bt_LastPage.Enabled:= False;
- Bt_PrecSect.Enabled:= False;
- Bt_NextSect.Enabled:= False;
- end;
-end;
-
-procedure TF_Visu.E_NumPageKeyPress(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState;
- var Consumed: boolean);
-var
- CptSect,CptPage,CptPageSect: Integer;
-begin
-if (KeyCode= KeyReturn) or (KeyCode= KeyPEnter)
-then
- with FReport do
- begin
- if E_NumPage.Value> T_Section(Sections[Pred(Sections.Count)]).TotPages
- then
- NumPage:= T_Section(Sections[Pred(Sections.Count)]).TotPages
- else
- if E_NumPage.Value= 0
- then
- NumPage:= 1
- else
- NumPage:= E_NumPage.Value;
- E_NumPage.Value:= NumPage;
- CptSect:= 0;
- CptPage:= 0;
- repeat
- Inc(CptSect);
- CptPageSect:= 0;
- repeat
- Inc(CptPage);
- Inc(CptPageSect);
- until (CptPage= NumPage) or (CptPage= T_Section(Sections[Pred(Cptsect)]).NbPages);
- until CptPage= NumPage;
- NumSection:= CptSect;
- NumPageSection:= CptPagesect;
- Bv_Visu.Invalidate;
- ChangeButtons;
- E_NumSect.Text:= IntToStr(NumSection);
- L_NumPageSect.Text:= IntToStr(NumPageSection);
- L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumSection)]).NbPages);
- end;
-end;
-
-procedure TF_Visu.E_NumSectKeyPress(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState;
- var Consumed: boolean);
-begin
-if (KeyCode= KeyReturn) or (KeyCode= KeyPEnter)
-then
- with FReport do
- begin
- if E_NumSect.Value> Sections.Count
- then
- NumSection:= Sections.Count
- else
- if E_NumSect.Value= 0
- then
- NumSection:= 1
- else
- NumSection:= E_NumSect.Value;
- E_NumSect.Value:= NumSection;
- NumPage:= T_Section(Sections[Pred(NumSection)]).FirstPage;
- NumPageSection:= 1;
- E_NumPage.Value:= NumPage;
- Bv_Visu.Invalidate;
- ChangeButtons;
- L_NumPageSect.Text:= IntToStr(NumPageSection);
- L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumSection)]).NbPages);
- end;
-end;
-
-constructor TF_Visu.Create(AOwner: TComponent; AImprime: T_Report);
-begin
-inherited Create(AOwner);
-FReport := AImprime;
-Name := 'F_Visu';
-WindowTitle:= 'Preview';
-WindowPosition:= wpUser;
-SetPosition(0, 0, FpgApplication.ScreenWidth-2, FpgApplication.ScreenHeight-66);
-Sizeable:= False;
-BackgroundColor:= clMediumAquamarine;
-CreateReportImages;
-Bv_Command:= CreateBevel(Self,0,0,Width,50,bsBox,bsRaised);
-Bv_Command.BackgroundColor:= clBisque;
-Bt_Close:= CreateButton(Bv_Command,10,10,26,'',@Bt_CloseClick,'stdimg.exit');
-Bt_Close.BackgroundColor:= clOrangeRed;
-Bt_Print:= CreateButton(Bv_Command,50,10,26,'',@Bt_PrintClick,'stdimg.print');
-Bt_Print.BackgroundColor:= clGreen;
-Bt_Print.Enabled:= False;
-Bt_Printer:= CreateButton(Bv_Command,90,10,26,'',@Bt_PrinterClick,'repimg.Printer');
-Bt_Printer.BackgroundColor:= clSilver;
-Bt_Printer.Enabled:= False;
-Bt_Stop:= CreateButton(Bv_Command,130,10,26,'',@Bt_StopClick,'repimg.Stop');
-Bt_Stop.BackgroundColor:= clRed;
-Bt_Pdf:= CreateButton(Bv_Command,170,10,26,'',@Bt_PdfClick,'stdimg.Adobe_pdf');
-Bt_Pdf.BackgroundColor:= clWhite;
-Bt_Pdf.ImageMargin:= 0;
-Bv_Pages:= CreateBevel(Bv_Command,220,5,300,40,bsBox,bsLowered);
-Bv_Pages.BackgroundColor:= clLinen;
-Bt_FirstPage:= CreateButton(Bv_Pages,54,6,26,'',@Bt_FirstPageClick,'repimg.First');
-Bt_PrecPage:= CreateButton(Bv_Pages,80,6,26,'',@Bt_PrecPageClick,'repimg.Precedent');
-E_NumPage:= CreateEditInteger(Bv_Pages,110,8,60,0);
-E_NumPage.OnKeyPress:= @E_NumPageKeypress;
-Bt_NextPage:= CreateButton(Bv_Pages,174,6,26,'',@Bt_NextPageClick,'repimg.Next');
-Bt_LastPage:= CreateButton(Bv_Pages,200,6,26,'',@Bt_LastPageClick,'repimg.Last');
-L_Pages:= CreateLabel(Bv_Pages,5,E_NumPage.Top,'Page',0,E_NumPage.Height,taLeftJustify,tlcenter);
-L_FromPage:= CreateLabel(Bv_Pages,235,E_NumPage.Top,'of',0,E_NumPage.Height,taLeftJustify,tlcenter);
-L_NbrPages:= CreateLabel(Bv_Pages,265,E_NumPage.Top,' ',30,E_NumPage.Height,taCenter,tlcenter);
-Bv_Sections:= CreateBevel(Bv_Command,540,5,500,40,bsBox,bsLowered);
-Bv_Sections.BackgroundColor:= clLinen;
-Bt_PrecSect:= CreateButton(Bv_Sections,90,6,26,'',@Bt_PrecSectClick,'repimg.Precedent');
-E_NumSect:= CreateEditInteger(Bv_Sections,120,8,60,0);
-E_NumSect.OnKeyPress:= @E_NumSectKeyPress;
-Bt_NextSect:= CreateButton(Bv_Sections,184,6,26,'',@Bt_NextSectClick,'repimg.Next');
-L_Sections:= CreateLabel(Bv_Sections,5,E_NumSect.Top,'Section',0,E_NumSect.Height,taLeftJustify,tlcenter);
-L_FromSect:= CreateLabel(Bv_Sections,250,E_NumSect.Top,'of',0,E_NumSect.Height,taLeftJustify,tlcenter);
-L_NbrSect:= CreateLabel(Bv_Sections,280,E_NumSect.Top,'-',0,E_NumSect.Height,taLeftJustify,tlcenter);
-L_PageSect:= CreateLabel(Bv_Sections,320,E_NumSect.Top,'Page',0,E_NumSect.Height,taLeftJustify,tlcenter);
-L_NumPageSect:= CreateLabel(Bv_Sections,365,E_NumSect.Top,'-',0,E_NumSect.Height,taLeftJustify,tlcenter);
-L_FromPageSect:= CreateLabel(Bv_Sections,410,E_NumSect.Top,'of',0,E_NumSect.Height,taLeftJustify,tlcenter);
-L_NbrPageSect:= CreateLabel(Bv_Sections,440,E_NumSect.Top,'-',0,E_NumSect.Height,taLeftJustify,tlcenter);
-OnShow:= @FormShow;
-end;
-
-destructor TF_Visu.Destroy;
-begin
-DeleteReportImages;
-inherited Destroy;
-end;
-
-end.
-