diff options
Diffstat (limited to 'extras/contributed/report_tool/reportengine')
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 <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 Binary files differdeleted file mode 100644 index ac307f1e..00000000 --- a/extras/contributed/report_tool/reportengine/images/Adobe_pdf.bmp +++ /dev/null diff --git a/extras/contributed/report_tool/reportengine/images/Debut.bmp b/extras/contributed/report_tool/reportengine/images/Debut.bmp Binary files differdeleted file mode 100755 index 9518137b..00000000 --- a/extras/contributed/report_tool/reportengine/images/Debut.bmp +++ /dev/null diff --git a/extras/contributed/report_tool/reportengine/images/Fermer.bmp b/extras/contributed/report_tool/reportengine/images/Fermer.bmp Binary files differdeleted file mode 100755 index 68decf1f..00000000 --- a/extras/contributed/report_tool/reportengine/images/Fermer.bmp +++ /dev/null diff --git a/extras/contributed/report_tool/reportengine/images/Fin.bmp b/extras/contributed/report_tool/reportengine/images/Fin.bmp Binary files differdeleted file mode 100755 index 6e048cf7..00000000 --- a/extras/contributed/report_tool/reportengine/images/Fin.bmp +++ /dev/null diff --git a/extras/contributed/report_tool/reportengine/images/Imprimante.bmp b/extras/contributed/report_tool/reportengine/images/Imprimante.bmp Binary files differdeleted file mode 100755 index 666a7911..00000000 --- a/extras/contributed/report_tool/reportengine/images/Imprimante.bmp +++ /dev/null diff --git a/extras/contributed/report_tool/reportengine/images/Imprimer.bmp b/extras/contributed/report_tool/reportengine/images/Imprimer.bmp Binary files differdeleted file mode 100755 index 51115c5b..00000000 --- a/extras/contributed/report_tool/reportengine/images/Imprimer.bmp +++ /dev/null diff --git a/extras/contributed/report_tool/reportengine/images/Precedent.bmp b/extras/contributed/report_tool/reportengine/images/Precedent.bmp Binary files differdeleted file mode 100755 index cb9a0847..00000000 --- a/extras/contributed/report_tool/reportengine/images/Precedent.bmp +++ /dev/null diff --git a/extras/contributed/report_tool/reportengine/images/Preview.bmp b/extras/contributed/report_tool/reportengine/images/Preview.bmp Binary files differdeleted file mode 100644 index 8fdad55e..00000000 --- a/extras/contributed/report_tool/reportengine/images/Preview.bmp +++ /dev/null diff --git a/extras/contributed/report_tool/reportengine/images/Stop.bmp b/extras/contributed/report_tool/reportengine/images/Stop.bmp Binary files differdeleted file mode 100755 index 55ad2e73..00000000 --- a/extras/contributed/report_tool/reportengine/images/Stop.bmp +++ /dev/null diff --git a/extras/contributed/report_tool/reportengine/images/Suivant.bmp b/extras/contributed/report_tool/reportengine/images/Suivant.bmp Binary files differdeleted file mode 100755 index afe14564..00000000 --- a/extras/contributed/report_tool/reportengine/images/Suivant.bmp +++ /dev/null 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. - |
