diff options
Diffstat (limited to 'extras/contributed')
13 files changed, 6244 insertions, 0 deletions
diff --git a/extras/contributed/report_tool/demo/pdf_demo.lpi b/extras/contributed/report_tool/demo/pdf_demo.lpi new file mode 100644 index 00000000..83f58995 --- /dev/null +++ b/extras/contributed/report_tool/demo/pdf_demo.lpi @@ -0,0 +1,97 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <General> + <Flags> + <SaveOnlyProjectUnits Value="True"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <Language Value=""/> + <CharSet Value=""/> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="impression"/> + </Item1> + <Item2> + <PackageName Value="fpgui_toolkit"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="pdf_demo.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="u_demo.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="U_Demo"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="9"/> + <Target> + <Filename Value="pdf_demo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)/"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <CStyleOperator Value="False"/> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Debugging> + <UseLineInfoUnit Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="2"> + <Item1> + <Name Value="ECodetoolError"/> + </Item1> + <Item2> + <Name Value="EFOpenError"/> + </Item2> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/extras/contributed/report_tool/demo/pdf_demo.lpr b/extras/contributed/report_tool/demo/pdf_demo.lpr new file mode 100644 index 00000000..9593287c --- /dev/null +++ b/extras/contributed/report_tool/demo/pdf_demo.lpr @@ -0,0 +1,29 @@ +{ Demo program for PDF Reporting engine } + +program pdf_demo; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, + fpg_main, + U_Demo; + +procedure MainProc; +begin + fpgApplication.Initialize; + F_Demo:= TF_Demo.Create(nil); + try + F_Demo.Show; + fpgApplication.Run; + finally + F_Demo.Free; + end; +end; + +begin + MainProc; +end. diff --git a/extras/contributed/report_tool/demo/u_demo.pas b/extras/contributed/report_tool/demo/u_demo.pas new file mode 100644 index 00000000..e5cb2e55 --- /dev/null +++ b/extras/contributed/report_tool/demo/u_demo.pas @@ -0,0 +1,1056 @@ +unit U_Demo; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + {$ifdef win32} + ShellApi, + {$endif} + fpg_main, fpg_base, + fpg_form, fpg_button, fpg_label, fpg_dialogs, fpg_utils; + +type + TF_Demo = class(TfpgForm) + private + L_Pdf: TfpgLabel; + Bt_PdfEmptyPage: TfpgButton; + Bt_PdfSimpleText: TfpgButton; + Bt_PdfMultiPages: TfpgButton; + Bt_PdfCadres: TfpgButton; + Bt_PdfColor: TfpgButton; + Bt_PdfLines: TfpgButton; + Bt_PdfGrid: TfpgButton; + Bt_PdfGraph: TfpgButton; + L_Visu: TfpgLabel; + Bt_VisuEmptyPage: TfpgButton; + Bt_VisuSimpleText: TfpgButton; + Bt_VisuMultiPages: TfpgButton; + Bt_VisuCadres: TfpgButton; + Bt_VisuColor: TfpgButton; + Bt_VisuLines: TfpgButton; + Bt_VisuGrid: TfpgButton; + Bt_VisuGraph: TfpgButton; + L_Print: TfpgLabel; + Bt_PrintEmptyPage: TfpgButton; + Bt_PrintSimpleText: TfpgButton; + Bt_PrintMultiPages: TfpgButton; + Bt_PrintCadres: TfpgButton; + Bt_PrintColor: TfpgButton; + Bt_PrintLines: TfpgButton; + Bt_PrintGrid: TfpgButton; + Bt_PrintGraph: TfpgButton; + Bt_Fermer: TfpgButton; + procedure Bt_PdfEmptyPageClick(Sender: TObject); + procedure Bt_PdfSimpleTextClick(Sender: TObject); + procedure Bt_PdfMultiPagesClick(Sender: TObject); + procedure Bt_PdfCadresClick(Sender: TObject); + procedure Bt_PdfColorClick(Sender: TObject); + procedure Bt_PdfLinesClick(Sender: TObject); + procedure Bt_PdfGridClick(Sender: TObject); + procedure Bt_PdfGraphClick(Sender: TObject); + procedure Bt_VisuEmptyPageClick(Sender: TObject); + procedure Bt_VisuSimpleTextClick(Sender: TObject); + procedure Bt_VisuMultiPagesClick(Sender: TObject); + procedure Bt_VisuCadresClick(Sender: TObject); + procedure Bt_VisuColorClick(Sender: TObject); + procedure Bt_VisuLinesClick(Sender: TObject); + procedure Bt_VisuGridClick(Sender: TObject); + procedure Bt_VisuGraphClick(Sender: TObject); + procedure Bt_PrintEmptyPageClick(Sender: TObject); + procedure Bt_PrintSimpleTextClick(Sender: TObject); + procedure Bt_PrintMultiPagesClick(Sender: TObject); + procedure Bt_PrintCadresClick(Sender: TObject); + procedure Bt_PrintColorClick(Sender: TObject); + procedure Bt_PrintLinesClick(Sender: TObject); + procedure Bt_PrintGridClick(Sender: TObject); + procedure Bt_PrintGraphClick(Sender: TObject); + procedure Bt_FermerClick(Sender: TObject); + procedure ImprimeEmptyPage(Preview: Boolean); + procedure ImprimeSimpleText(Preview: Boolean); + procedure ImprimeMultiPages(Preview: Boolean); + procedure ImprimeCadres(Preview: Boolean); + procedure ImprimeColor(Preview: Boolean); + procedure ImprimeLines(Preview: Boolean); + procedure ImprimeGrid(Preview: Boolean); + procedure ImprimeGraph(Preview: Boolean); + public + constructor Create(AOwner: TComponent); override; + end; + +var + F_Demo: TF_Demo; + +implementation + +uses + U_Imprime, U_Commande, U_Pdf; + +var + ChartValues: array[0..18] of Integer; + +const + Langue= 'F'; + +procedure TF_Demo.Bt_PdfEmptyPageClick(Sender: TObject); +var + Fd_SauvePdf: TfpgFileDialog; + FichierPdf: string; + FluxFichier: TFileStream; +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin +// Langue:= Version; + ImprimeEmptyPage(False); + if T_Section(Sections[Pred(Sections.Count)]).TotPages= 0 + then + begin + ShowMessage('There is no file to print'); + Exit; + end; + Fd_SauvePdf:= TfpgFileDialog.Create(nil); + Fd_SauvePdf.InitialDir:= ExtractFilePath(Paramstr(0)); + Fd_SauvePdf.FontDesc:= 'bitstream vera sans-9'; + Fd_SauvePdf.Filter:= 'Fichiers pdf |*.pdf'; + Fd_SauvePdf.FileName:= 'EmptyPage.pdf'; + try + if Fd_SauvePdf.RunSaveFile + then + begin + FichierPdf:= Fd_SauvePdf.FileName; + if Lowercase(Copy(FichierPdf,Length(FichierPdf)-3,4))<> '.pdf' + then + FichierPdf:= FichierPdf+'.pdf'; + Document:= TPdfDocument.CreateDocument; + with Document do + begin + FluxFichier:= TFileStream.Create(FichierPdf,fmCreate); + EcritDocument(FluxFichier); + FluxFichier.Free; + Free; + end; + {$ifdef linux} + fpgOpenURL(FichierPdf); + {$endif} + {$ifdef win32} + ShellExecute(0,PChar('OPEN'),PChar(FichierPdf),PChar(''),PChar(''),1); + {$endif} + end; + finally + Fd_SauvePdf.Free; + end; + Free; + end; +end; + +procedure TF_Demo.Bt_PdfSimpleTextClick(Sender: TObject); +var + Fd_SauvePdf: TfpgFileDialog; + FichierPdf: string; + FluxFichier: TFileStream; +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin +// Langue:= Version; + ImprimeSimpleText(False); + if T_Section(Sections[Pred(Sections.Count)]).TotPages= 0 + then + begin + ShowMessage('There is no file to print'); + Exit; + end; + Fd_SauvePdf:= TfpgFileDialog.Create(nil); + Fd_SauvePdf.InitialDir:= ExtractFilePath(Paramstr(0)); + Fd_SauvePdf.FontDesc:= 'bitstream vera sans-9'; + Fd_SauvePdf.Filter:= 'Fichiers pdf |*.pdf'; + Fd_SauvePdf.FileName:= 'SimpleText.pdf'; + try + if Fd_SauvePdf.RunSaveFile + then + begin + FichierPdf:= Fd_SauvePdf.FileName; + if Lowercase(Copy(FichierPdf,Length(FichierPdf)-3,4))<> '.pdf' + then + FichierPdf:= FichierPdf+'.pdf'; + Document:= TPdfDocument.CreateDocument; + with Document do + begin + FluxFichier:= TFileStream.Create(FichierPdf,fmCreate); + EcritDocument(FluxFichier); + FluxFichier.Free; + Free; + end; + {$ifdef linux} + fpgOpenURL(FichierPdf); + {$endif} + {$ifdef win32} + ShellExecute(0,PChar('OPEN'),PChar(FichierPdf),PChar(''),PChar(''),1); + {$endif} + end; + finally + Fd_SauvePdf.Free; + end; + Free; + end; +end; + +procedure TF_Demo.Bt_PdfMultiPagesClick(Sender: TObject); +var + Fd_SauvePdf: TfpgFileDialog; + FichierPdf: string; + FluxFichier: TFileStream; +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin +// Langue:= Version; + ImprimeMultiPages(False); + if T_Section(Sections[Pred(Sections.Count)]).TotPages= 0 + then + begin + ShowMessage('There is no file to print'); + Exit; + end; + Fd_SauvePdf:= TfpgFileDialog.Create(nil); + Fd_SauvePdf.InitialDir:= ExtractFilePath(Paramstr(0)); + Fd_SauvePdf.FontDesc:= 'bitstream vera sans-9'; + Fd_SauvePdf.Filter:= 'Fichiers pdf |*.pdf'; + Fd_SauvePdf.FileName:= 'MultiPages.pdf'; + try + if Fd_SauvePdf.RunSaveFile + then + begin + FichierPdf:= Fd_SauvePdf.FileName; + if Lowercase(Copy(FichierPdf,Length(FichierPdf)-3,4))<> '.pdf' + then + FichierPdf:= FichierPdf+'.pdf'; + Document:= TPdfDocument.CreateDocument; + with Document do + begin + FluxFichier:= TFileStream.Create(FichierPdf,fmCreate); + EcritDocument(FluxFichier); + FluxFichier.Free; + Free; + end; + {$ifdef linux} + fpgOpenURL(FichierPdf); + {$endif} + {$ifdef win32} + ShellExecute(0,PChar('OPEN'),PChar(FichierPdf),PChar(''),PChar(''),1); + {$endif} + end; + finally + Fd_SauvePdf.Free; + end; + Free; + end; +end; + +procedure TF_Demo.Bt_PdfCadresClick(Sender: TObject); +var + Fd_SauvePdf: TfpgFileDialog; + FichierPdf: string; + FluxFichier: TFileStream; +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin +// Langue:= Version; + ImprimeCadres(False); + if T_Section(Sections[Pred(Sections.Count)]).TotPages= 0 + then + begin + ShowMessage('There is no file to print'); + Exit; + end; + Fd_SauvePdf:= TfpgFileDialog.Create(nil); + Fd_SauvePdf.InitialDir:= ExtractFilePath(Paramstr(0)); + Fd_SauvePdf.FontDesc:= 'bitstream vera sans-9'; + Fd_SauvePdf.Filter:= 'Fichiers pdf |*.pdf'; + Fd_SauvePdf.FileName:= 'Cadres.pdf'; + try + if Fd_SauvePdf.RunSaveFile + then + begin + FichierPdf:= Fd_SauvePdf.FileName; + if Lowercase(Copy(FichierPdf,Length(FichierPdf)-3,4))<> '.pdf' + then + FichierPdf:= FichierPdf+'.pdf'; + Document:= TPdfDocument.CreateDocument; + with Document do + begin + FluxFichier:= TFileStream.Create(FichierPdf,fmCreate); + EcritDocument(FluxFichier); + FluxFichier.Free; + Free; + end; + {$ifdef linux} + fpgOpenURL(FichierPdf); + {$endif} + {$ifdef win32} + ShellExecute(0,PChar('OPEN'),PChar(FichierPdf),PChar(''),PChar(''),1); + {$endif} + end; + finally + Fd_SauvePdf.Free; + end; + Free; + end; +end; + +procedure TF_Demo.Bt_PdfColorClick(Sender: TObject); +var + Fd_SauvePdf: TfpgFileDialog; + FichierPdf: string; + FluxFichier: TFileStream; +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin +// Langue:= Version; + ImprimeColor(False); + if T_Section(Sections[Pred(Sections.Count)]).TotPages= 0 + then + begin + ShowMessage('There is no file to print'); + Exit; + end; + Fd_SauvePdf:= TfpgFileDialog.Create(nil); + Fd_SauvePdf.InitialDir:= ExtractFilePath(Paramstr(0)); + Fd_SauvePdf.FontDesc:= 'bitstream vera sans-9'; + Fd_SauvePdf.Filter:= 'Fichiers pdf |*.pdf'; + Fd_SauvePdf.FileName:= 'Color.pdf'; + try + if Fd_SauvePdf.RunSaveFile + then + begin + FichierPdf:= Fd_SauvePdf.FileName; + if Lowercase(Copy(FichierPdf,Length(FichierPdf)-3,4))<> '.pdf' + then + FichierPdf:= FichierPdf+'.pdf'; + Document:= TPdfDocument.CreateDocument; + with Document do + begin + FluxFichier:= TFileStream.Create(FichierPdf,fmCreate); + EcritDocument(FluxFichier); + FluxFichier.Free; + Free; + end; + {$ifdef linux} + fpgOpenURL(FichierPdf); + {$endif} + {$ifdef win32} + ShellExecute(0,PChar('OPEN'),PChar(FichierPdf),PChar(''),PChar(''),1); + {$endif} + end; + finally + Fd_SauvePdf.Free; + end; + Free; + end; +end; + +procedure TF_Demo.Bt_PdfLinesClick(Sender: TObject); +var + Fd_SauvePdf: TfpgFileDialog; + FichierPdf: string; + FluxFichier: TFileStream; +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin +// Langue:= Version; + ImprimeLines(False); + if T_Section(Sections[Pred(Sections.Count)]).TotPages= 0 + then + begin + ShowMessage('There is no file to print'); + Exit; + end; + Fd_SauvePdf:= TfpgFileDialog.Create(nil); + Fd_SauvePdf.InitialDir:= ExtractFilePath(Paramstr(0)); + Fd_SauvePdf.FontDesc:= 'bitstream vera sans-9'; + Fd_SauvePdf.Filter:= 'Fichiers pdf |*.pdf'; + Fd_SauvePdf.FileName:= 'Lines.pdf'; + try + if Fd_SauvePdf.RunSaveFile + then + begin + FichierPdf:= Fd_SauvePdf.FileName; + if Lowercase(Copy(FichierPdf,Length(FichierPdf)-3,4))<> '.pdf' + then + FichierPdf:= FichierPdf+'.pdf'; + Document:= TPdfDocument.CreateDocument; + with Document do + begin + FluxFichier:= TFileStream.Create(FichierPdf,fmCreate); + EcritDocument(FluxFichier); + FluxFichier.Free; + Free; + end; + {$ifdef linux} + fpgOpenURL(FichierPdf); + {$endif} + {$ifdef win32} + ShellExecute(0,PChar('OPEN'),PChar(FichierPdf),PChar(''),PChar(''),1); + {$endif} + end; + finally + Fd_SauvePdf.Free; + end; + Free; + end; +end; + +procedure TF_Demo.Bt_PdfGridClick(Sender: TObject); +var + Fd_SauvePdf: TfpgFileDialog; + FichierPdf: string; + FluxFichier: TFileStream; +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin +// Langue:= Version; + ImprimeGrid(False); + if T_Section(Sections[Pred(Sections.Count)]).TotPages= 0 + then + begin + ShowMessage('There is no file to print'); + Exit; + end; + Fd_SauvePdf:= TfpgFileDialog.Create(nil); + Fd_SauvePdf.InitialDir:= ExtractFilePath(Paramstr(0)); + Fd_SauvePdf.FontDesc:= 'bitstream vera sans-9'; + Fd_SauvePdf.Filter:= 'Fichiers pdf |*.pdf'; + Fd_SauvePdf.FileName:= 'Grid.pdf'; + try + if Fd_SauvePdf.RunSaveFile + then + begin + FichierPdf:= Fd_SauvePdf.FileName; + if Lowercase(Copy(FichierPdf,Length(FichierPdf)-3,4))<> '.pdf' + then + FichierPdf:= FichierPdf+'.pdf'; + Document:= TPdfDocument.CreateDocument; + with Document do + begin + FluxFichier:= TFileStream.Create(FichierPdf,fmCreate); + EcritDocument(FluxFichier); + FluxFichier.Free; + Free; + end; + {$ifdef linux} + fpgOpenURL(FichierPdf); + {$endif} + {$ifdef win32} + ShellExecute(0,PChar('OPEN'),PChar(FichierPdf),PChar(''),PChar(''),1); + {$endif} + end; + finally + Fd_SauvePdf.Free; + end; + Free; + end; +end; + +procedure TF_Demo.Bt_PdfGraphClick(Sender: TObject); +var + Fd_SauvePdf: TfpgFileDialog; + FichierPdf: string; + FluxFichier: TFileStream; +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin +// Langue:= Version; + ImprimeGraph(False); + if T_Section(Sections[Pred(Sections.Count)]).TotPages= 0 + then + begin + ShowMessage('There is no file to print'); + Exit; + end; + Fd_SauvePdf:= TfpgFileDialog.Create(nil); + Fd_SauvePdf.InitialDir:= ExtractFilePath(Paramstr(0)); + Fd_SauvePdf.FontDesc:= 'bitstream vera sans-9'; + Fd_SauvePdf.Filter:= 'Fichiers pdf |*.pdf'; + Fd_SauvePdf.FileName:= 'Graph.pdf'; + try + if Fd_SauvePdf.RunSaveFile + then + begin + FichierPdf:= Fd_SauvePdf.FileName; + if Lowercase(Copy(FichierPdf,Length(FichierPdf)-3,4))<> '.pdf' + then + FichierPdf:= FichierPdf+'.pdf'; + Document:= TPdfDocument.CreateDocument; + with Document do + begin + FluxFichier:= TFileStream.Create(FichierPdf,fmCreate); + EcritDocument(FluxFichier); + FluxFichier.Free; + Free; + end; + {$ifdef linux} + fpgOpenURL(FichierPdf); + {$endif} + {$ifdef win32} + ShellExecute(0,PChar('OPEN'),PChar(FichierPdf),PChar(''),PChar(''),1); + {$endif} + end; + finally + Fd_SauvePdf.Free; + end; + Free; + end; +end; + +procedure TF_Demo.Bt_VisuEmptyPageClick(Sender: TObject); +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin + //Langue:= Version; + DefaultFile:= 'EmptyPage.pdf'; + ImprimeEmptyPage(True); + Free; + end; +end; + +procedure TF_Demo.Bt_VisuSimpleTextClick(Sender: TObject); +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin + //Langue:= Version; + DefaultFile:= 'SimpleText.pdf'; + ImprimeSimpleText(True); + Free; + end; +end; + +procedure TF_Demo.Bt_VisuMultiPagesClick(Sender: TObject); +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin + //Langue:= Version; + DefaultFile:= 'MultiPages.pdf'; + ImprimeMultiPages(True); + Free; + end; +end; + +procedure TF_Demo.Bt_VisuCadresClick(Sender: TObject); +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin + //Langue:= Version; + DefaultFile:= 'Cadres.pdf'; + ImprimeCadres(True); + Free; + end; +end; + +procedure TF_Demo.Bt_VisuColorClick(Sender: TObject); +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin + //Langue:= Version; + DefaultFile:= 'Color.pdf'; + ImprimeColor(True); + Free; + end; +end; + +procedure TF_Demo.Bt_VisuLinesClick(Sender: TObject); +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin + //Langue:= Version; + DefaultFile:= 'Lines.pdf'; + ImprimeLines(True); + Free; + end; +end; + +procedure TF_Demo.Bt_VisuGridClick(Sender: TObject); +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin + //Langue:= Version; + DefaultFile:= 'Grid.pdf'; + ImprimeGrid(True); + Free; + end; +end; + +procedure TF_Demo.Bt_VisuGraphClick(Sender: TObject); +begin +Imprime:= T_Imprime.Create; +with Imprime do + begin + //Langue:= Version; + DefaultFile:= 'Graph.pdf'; + ImprimeGraph(True); + Free; + end; +end; + +procedure TF_Demo.Bt_PrintEmptyPageClick(Sender: TObject); +begin + +end; + +procedure TF_Demo.Bt_PrintSimpleTextClick(Sender: TObject); +begin + +end; + +procedure TF_Demo.Bt_PrintMultiPagesClick(Sender: TObject); +begin + +end; + +procedure TF_Demo.Bt_PrintCadresClick(Sender: TObject); +begin + +end; + +procedure TF_Demo.Bt_PrintColorClick(Sender: TObject); +begin + +end; + +procedure TF_Demo.Bt_PrintLinesClick(Sender: TObject); +begin + +end; + +procedure TF_Demo.Bt_PrintGridClick(Sender: TObject); +begin + +end; + +procedure TF_Demo.Bt_PrintGraphClick(Sender: TObject); +begin + +end; + +procedure TF_Demo.Bt_FermerClick(Sender: TObject); +begin +Close; +end; + +procedure TF_Demo.ImprimeEmptyPage(Preview: Boolean); +begin +with Imprime do + begin + // define orientation, page format, measurement unit, language, preview (true) or print (false) + Debut(oPortrait,A4,msMM,Langue,Preview); + // create a new section and define the margins + Section(0,0,0,0); + // create an empty page + Page; + // preparation is finished, so create PDF objects + Fin; + end; +end; + +procedure TF_Demo.ImprimeSimpleText(Preview: Boolean); +var + FtTexte1,FtTexte2,FtTexte3: Integer; +begin +with Imprime do + begin + // define orientation, page format, measurement unit, language, preview (true) or print (false) + Debut(oPortrait,A4,msMM,Langue,Preview); + // create a new section and define the margins: 10 mm each side + Section(10,10,10,10); + // create the fonts to be used (use one of the 14 Adobe PDF standard fonts) + FtTexte1:= Fonte('helvetica-15:bold',clBlack); + FtTexte2:= Fonte('helvetica-8',clBlack); + FtTexte3:= Fonte('helvetica-8:italic',clBlack); + // write the text at position 100 mm from left and 120 mm from top + EcritPage(100,120,'Big text at absolute position',-1,FtTexte1); + // write the text aligned to left + EcritPage(cnLeft,50,'Text aligned to left',ColDefaut,FtTexte2); + // write the text aligned to right + EcritPage(cnRight,75,'Text aligned to right',ColDefaut,FtTexte3); + // write the text aligned to center + EcritPage(cnCenter,100,'Text aligned to center',ColDefaut,FtTexte2); + // preparation is finished, so create PDF objects + Fin; + end; +end; + +procedure TF_Demo.ImprimeMultiPages(Preview: Boolean); +var + FtTitre,FtTexte: Integer; + Cpt: Integer; +begin +with Imprime do + begin + // define orientation, page format, measurement unit, language, preview (true) or print (false) + Debut(oPortrait,A4,msMM,Langue,Preview); + // create a new section and define the margins + Section(20,10,10,10); + // create the fonts to be used (use one of the 14 Adobe PDF standard fonts) + FtTitre:= Fonte('helvetica-15:bold',clBlack); + FtTexte:= Fonte('helvetica-8',clBlack); + // write title on each page + EcritEnTete(cnCenter,lnFin,'MULTIPAGE DOCUMENT',ColDefaut,FtTitre); + // write page number and total of pages on each page + NumPagePied(cnRight,lnFin,'Page','of',True,ColDefaut,FtTexte); + // create five new empty pages + for Cpt:= 1 to 5 do + Page; + // preparation is finished, so create PDF objects + Fin; + end; +end; + +procedure TF_Demo.ImprimeCadres(Preview: Boolean); +var + FtTitre,FtTexte: Integer; + TsFin,TsEpais: Integer; + IlTitre,IlTexte: Integer; +begin +with Imprime do + begin + // define orientation, page format, measurement unit, language, preview (true) or print (false) + Debut(oPortrait,A4,msMM,Langue,Preview); + // create a new section and define the margins with an additional one due to frames drawing + Section(20,10,10,10,5); + // create the fonts to be used (use one of the 14 Adobe PDF standard fonts) + FtTitre:= Fonte('helvetica-15:bold',clBlack); + FtTexte:= Fonte('helvetica-8',clBlack); + // create the style of lines to be used + TsFin:= StyleTrait(1,clBlack,lsSolid); + TsEpais:= StyleTrait(2,clBlack,lsSolid); + // create line spacings to be used + IlTitre:= Interligne(3,0,3); + IlTexte:= Interligne(1,0,1); + // write title on each page + EcritEnTete(cnCenter,lnFin,'SHOWING FRAMES',ColDefaut,FtTitre,IlTitre); + // write page number and total of pages on each page + NumPagePied(cnRight,lnFin,'Page','of',True,ColDefaut,FtTexte,IlTexte); + // draw thin frame rectangle at margins + CadreMarges(TsFin); + // draw thick frame rectangle at header + CadreEnTete(TsEpais); + // draw thick frame rectangle at footer + CadrePied(TsEpais); + // preparation is finished, so create PDF objects + Fin; + end; +end; + +procedure TF_Demo.ImprimeColor(Preview: Boolean); +var + FtTitre,FtNormBlack,FtNormRed,FtNormGreen,FtBoldBlue,FtItalGray,FtBoldItalFuchsia: Integer; + TsFinNoir,TsFinBleu,TsFinRouge,TsEpaisNoir,TsEpaisGris,TsEpaisGreen: Integer; + FdBlanc,FdBeige,FdEau,FdVertPale: Integer; + IlTitre,IlTexte: Integer; + Col1,Col2,Col3: Integer; + +begin +with Imprime do + begin + // define orientation, page format, measurement unit, language, preview (true) or print (false) + Debut(oPortrait,A4,msMM,Langue,Preview); + // create a new section and define the margins with an additional one due to frames drawing + Section(20,10,10,10); + // create the filling colors to be used + FdBlanc:= Fond(clWhite); + FdBeige:= Fond(clBeige); + FdEau:= Fond(clAqua); + FdVertPale:= Fond(clPaleGreen); + // create the fonts to be used (use one of the 14 Adobe PDF standard fonts) + FtTitre:= Fonte('helvetica-15:bold',clBlack); + FtNormBlack:= Fonte('helvetica-8',clBlack); + FtNormRed:= Fonte('helvetica-8',clRed); + FtNormGreen:= Fonte('helvetica-8',clGreen); + FtBoldBlue:= Fonte('helvetica-8:bold',clBlue); + FtItalGray:= Fonte('helvetica-8:italic',clGray); + FtBoldItalFuchsia:= Fonte('helvetica-8:bold:italic',clFuchsia); + // create the style of lines to be used + TsFinNoir:= StyleTrait(1,clBlack,lsSolid); + TsFinBleu:= StyleTrait(1,clBlue,lsSolid); + TsFinRouge:= StyleTrait(1,clRed,lsSolid); + TsEpaisNoir:= StyleTrait(3,clBlack,lsSolid); + TsEpaisGris:= StyleTrait(3,clGray,lsdot); + TsEpaisGreen:= StyleTrait(3,clGreen,lsSolid); + // create columns to be used + Col1:= Colonne(20,100,2); + Col2:= Colonne(120,80,1); + Col3:= Colonne(70,100,5); + // create line spacings to be used + IlTitre:= Interligne(5,0,5); + IlTexte:= Interligne(0,0,0); + // write title on each page + EcritEnTete(cnCenter,lnFin,'SHOWING COLORS',ColDefaut,FtTitre,IlTitre); + // write page number and total of pages on each page + NumPagePied(cnRight,lnFin,'Page','of',True,ColDefaut,FtNormRed,IlTexte); + // write some example texts + EcritPage(cnLeft,lnFin,'Bold blue text aligned to left',ColDefaut,FtBoldBlue,IlTexte); + EspacePage(10,ColDefaut,FdVertPale); + EcritPage(cnCenter,lnFin,'followed by centered normal black text after a 1 cm colored space',ColDefaut,FtNormBlack,IlTexte); + EspacePage(15); + EcritPage(cnLeft,lnFin,'text written on colored background after a 1.5 cm colored space',ColDefaut,FtItalGray,IlTexte,FdEau); + EspacePage(10); + EcritPage(cnLeft,lnCourante,'This text starts in column 1',Col1,FtNormGreen,IlTexte,FdBeige); + EcritPage(cnLeft,lnFin,'and ends in column 2',Col2,FtBoldItalFuchsia,IlTexte); + EcritPage(cnCenter,lnFin,'And this one is centered in column 3',Col3,FtNormRed,IlTexte,FdBeige); + // preparation is finished, so create PDF objects + Fin; + end; +end; + +procedure TF_Demo.ImprimeLines(Preview: Boolean); +var + FtTitre,FtTexte: Integer; + TsFinNoir,TsFinBleu,TsEpais,TsFinRouge: Integer; + IlTitre,IlTexte: Integer; + Col1,Col2,Col3: Integer; + BdRect,BdColn,BdFinCol: Integer; +begin +with Imprime do + begin + // define orientation, page format, measurement unit, language, preview (true) or print (false) + Debut(oPortrait,A4,msMM,Langue,Preview); + // create a new section and define the margins with an additional one due to frames drawing + Section(20,10,10,10); + // create the fonts to be used (use one of the 14 Adobe PDF standard fonts) + FtTitre:= Fonte('helvetica-15:bold',clBlack); + FtTexte:= Fonte('helvetica-8',clBlack); + // create the style of lines to be used + TsFinNoir:= StyleTrait(1,clBlack,lsSolid); + TsFinBleu:= StyleTrait(1,clBlue,lsDash); + TsEpais:= StyleTrait(2,clBlack,lsSolid); + TsFinRouge:= StyleTrait(1,clRed,lsDashDot); + // create line spacings to be used + IlTitre:= Interligne(3,0,3); + IlTexte:= Interligne(0,0,0); + // define column borders + BdRect:= Bordure([bcGauche,bcDroite,bcHaut,bcBas],TsEpais); + BdColn:= Bordure([bcGauche,bcDroite,bcHaut],TsFinBleu); + BdFinCol:= Bordure([bcGauche,bcDroite,bcHaut,bcBas],TsFinNoir); + // create columns to be used + Col1:= Colonne(20,60,2); + Col2:= Colonne(80,60,2); + Col3:= Colonne(140,60,2); + // write title on each page + EcritEnTete(cnCenter,lnFin,'SHOWING LINES',ColDefaut,FtTitre,IlTitre); + // write page number and total of pages on each page + NumPagePied(cnRight,lnFin,'Page','of',True,ColDefaut,FtTexte,IlTexte); + // write some example texts with column borders + EcritPage(cnLeft,lnCourante,'Example of lines',Col1,FtTexte,IlTexte,-1,BdColn); + EcritPage(cnLeft,lnCourante,'with column borders',Col2,FtTexte,IlTexte,-1,BdFinCol); + EcritPage(cnLeft,lnFin,'',Col3,FtTexte); + EspacePage(5); + EcritPage(cnLeft,lnFin,'A thick border',Col3,FtTexte,IlTexte,-1,BdRect); + TraitPage(30,100,150,150,tsFinNoir); + TraitPage(50,70,180,100,tsFinBleu); + TraitPage(40,140,160,80,tsFinRouge); + TraitPage(60,50,60,120,tsEpais); + // preparation is finished, so create PDF objects + Fin; + end; +end; + +procedure TF_Demo.ImprimeGrid(Preview: Boolean); +var + FtTitre,FtTexte,FtSTitre: Integer; + TsFinNoir: Integer; + IlTitre,IlTexte: Integer; + Col: array[1..5] of Integer; + BdColn,BdFinCol: Integer; + CptLig,CptCol: Integer; +begin +with Imprime do + begin + // define orientation, page format, measurement unit, language, preview (true) or print (false) + Debut(oPortrait,A4,msMM,Langue,Preview); + // create a new section and define the margins with an additional one due to frames drawing + Section(20,10,10,10); + // create the fonts to be used (use one of the 14 Adobe PDF standard fonts) + FtTitre:= Fonte('helvetica-15:bold',clBlack); + FtTexte:= Fonte('helvetica-7',clBlack); + FtSTitre:= Fonte('helvetica-9:bold:italic',clBlue); + // create the style of lines to be used + TsFinNoir:= StyleTrait(1,clBlack,lsSolid); + // create line spacings to be used + IlTitre:= Interligne(3,0,3); + IlTexte:= Interligne(1,0,0); + // define column borders + BdColn:= Bordure([bcGauche,bcDroite,bcHaut],TsFinNoir); + BdFinCol:= Bordure([bcGauche,bcDroite,bcHaut,bcBas],TsFinNoir); + // create columns to be used + Col[1]:= Colonne(20,40,2); + Col[2]:= Colonne(60,35,2); + Col[3]:= Colonne(95,35,2); + Col[4]:= Colonne(130,35,2); + Col[5]:= Colonne(165,35,2); + // write title on each page + EcritEnTete(cnCenter,lnFin,'SHOWING GRIDS',ColDefaut,FtTitre,IlTitre); + // write page number and total of pages on each page + NumPagePied(cnRight,lnFin,'Page','of',True,ColDefaut,FtTexte,IlTexte); + // write a grid without borders + EcritPage(cnCenter,lnFin,'Grid without borders',ColDefaut,FtSTitre,IlTitre); + for CptLig:= 1 to 10 do + for CptCol:= 1 to 5 do + if CptCol= 5 + then + EcritPage(cnLeft,lnFin,'line '+IntToStr(CptLig)+' ; column '+IntToStr(CptCol),Col[CptCol],FtTexte,IlTexte) + else + EcritPage(cnLeft,lnCourante,'line '+IntToStr(CptLig)+' ; column '+IntToStr(CptCol),Col[CptCol],FtTexte,IlTexte); + EspacePage(5); + // write a grid with borders + EcritPage(cnCenter,lnFin,'Grid with borders',ColDefaut,FtSTitre,IlTitre); + for CptLig:= 1 to 10 do + for CptCol:= 1 to 5 do + if CptCol= 5 + then + if CptLig= 10 + then + EcritPage(cnLeft,lnFin,'line '+IntToStr(CptLig)+' ; column '+IntToStr(CptCol),Col[CptCol],FtTexte,IlTexte,-1,BdFinCol) + else + EcritPage(cnLeft,lnFin,'line '+IntToStr(CptLig)+' ; column '+IntToStr(CptCol),Col[CptCol],FtTexte,IlTexte,-1,BdColn) + else + if CptLig= 10 + then + EcritPage(cnLeft,lnCourante,'line '+IntToStr(CptLig)+' ; column '+IntToStr(CptCol),Col[CptCol],FtTexte,IlTexte,-1,BdFinCol) + else + EcritPage(cnLeft,lnCourante,'line '+IntToStr(CptLig)+' ; column '+IntToStr(CptCol),Col[CptCol],FtTexte,IlTexte,-1,BdColn); + // preparation is finished, so create PDF objects + Fin; + end; +end; + +procedure TF_Demo.ImprimeGraph(Preview: Boolean); +var + FtTitre,FtTexte,FtMax: Integer; + TsNoir,TsGris,TsBleu,TsFuchsia: Integer; + IlTitre,IlTexte: Integer; + Cpt,Max: Integer; +const + Base= 150; +begin +with Imprime do + begin + // define orientation, page format, measurement unit, language, preview (true) or print (false) + Debut(oPortrait,A4,msMM,Langue,Preview); + // create a new section and define the margins with an additional one due to frames drawing + Section(10,10,10,10); + // create the fonts to be used (use one of the 14 Adobe PDF standard fonts) + FtTitre:= Fonte('helvetica-15:bold',clBlack); + FtTexte:= Fonte('helvetica-7',clBlack); + FtMax:= Fonte('helvetica-7',clFuchsia); + // create line spacings to be used + IlTitre:= Interligne(3,0,3); + IlTexte:= Interligne(1,0,0); + // create the style of lines to be used + TsNoir:= StyleTrait(1,clBlack,lsSolid); + TsGris:= StyleTrait(1,clGray,lsDot); + TsBleu:= StyleTrait(1,clBlue,lsSolid); + TsFuchsia:= StyleTrait(1,clFuchsia,lsDot); + EcritEnTete(cnCenter,lnFin,'SHOWING GRAPH',ColDefaut,FtTitre,IlTitre); + // write page number and total of pages on each page + NumPagePied(cnRight,lnFin,'Page','of',True,ColDefaut,FtTexte,IlTexte); + // draw a graph + Max:= 0; + EcritPage(10,Base,'0',-1,FtTexte); + TraitPage(20,Base,200,Base,TsNoir); + for Cpt:= 1 to 5 do + begin + EcritPage(10,Base-Cpt*20,IntToStr(Cpt),-1,FtTexte); + TraitPage(20,Base-Cpt*20,200,Base-Cpt*20,TsGris); + end; + for Cpt:= 0 to 18 do + begin + if ChartValues[Cpt]> Max + then + Max:= ChartValues[Cpt]; + EcritPage(18+Cpt*10,Base+5,IntToStr(Cpt),-1,FtTexte); + TraitPage(20+Cpt*10,Base,20+Cpt*10,Base-ChartValues[Cpt],TsGris); + if Cpt>0 then + TraitPage(20+Pred(Cpt)*10,Base-ChartValues[Pred(Cpt)],20+Cpt*10,Base-ChartValues[Cpt],TsBleu); + end; + EcritPage(16,Base-Max,IntToStr(Max),-1,FtMax); + TraitPage(20,Base-Max,200,Base-Max,TsFuchsia); + // preparation is finished, so create PDF objects + Fin; + end; +end; + +constructor TF_Demo.Create(AOwner: TComponent); +var + Cpt: Integer; +begin +inherited Create(AOwner); +Name := 'F_Demo'; +WindowTitle:= 'PDF demo'; +SetPosition(0, 0, 650, 400); +WindowPosition:= wpScreenCenter; +Sizeable:= False; +fpgSetNamedColor(clWindowBackground,clPaleGreen); +fpgSetNamedColor(clButtonFace,clCyan); +fpgSetNamedColor(clText1,clBlue); +fpgSetNamedColor(clSelection,clSkyBlue); +fpgSetNamedColor(clSelectionText,clDarkBlue); +fpgSetNamedFont('Label1','bitstream vera sans-10'); +fpgSetNamedFont('Edit1','bitstream vera sans-10'); +L_Visu:= CreateLabel(Self,50,5,'Print to PDF',150,20,taCenter); +Bt_PdfEmptyPage:= CreateButton(Self,50,30,150,'Empty page',@Bt_PdfEmptyPageClick,'stdimg.Adobe_pdf'); +Bt_PdfSimpleText:= CreateButton(Self,50,70,150,'Simple text',@Bt_PdfSimpleTextClick,'stdimg.Adobe_pdf'); +Bt_PdfMultiPages:= CreateButton(Self,50,110,150,'Multiple pages',@Bt_PdfMultiPagesClick,'stdimg.Adobe_pdf'); +Bt_PdfCadres:= CreateButton(Self,50,150,150,'Draw frames',@Bt_PdfCadresClick,'stdimg.Adobe_pdf'); +Bt_PdfColor:= CreateButton(Self,50,190,150,'Show colors',@Bt_PdfColorClick,'stdimg.Adobe_pdf'); +Bt_PdfLines:= CreateButton(Self,50,230,150,'Draw lines',@Bt_PdfLinesClick,'stdimg.Adobe_pdf'); +Bt_PdfGrid:= CreateButton(Self,50,270,150,'Show grid',@Bt_PdfGridClick,'stdimg.Adobe_pdf'); +Bt_PdfGraph:= CreateButton(Self,50,310,150,'Show graph',@Bt_PdfGraphClick,'stdimg.Adobe_pdf'); +L_Pdf:= CreateLabel(Self,250,5,'Preview',150,20,taCenter); +Bt_VisuEmptyPage:= CreateButton(Self,250,30,150,'Empty page',@Bt_VisuEmptyPageClick,'stdimg.Preview'); +Bt_VisuSimpleText:= CreateButton(Self,250,70,150,'Simple text',@Bt_VisuSimpleTextClick,'stdimg.Preview'); +Bt_VisuMultiPages:= CreateButton(Self,250,110,150,'Multiple pages',@Bt_VisuMultiPagesClick,'stdimg.Preview'); +Bt_VisuCadres:= CreateButton(Self,250,150,150,'Draw frames',@Bt_VisuCadresClick,'stdimg.Preview'); +Bt_VisuColor:= CreateButton(Self,250,190,150,'Show colors',@Bt_VisuColorClick,'stdimg.Preview'); +Bt_VisuLines:= CreateButton(Self,250,230,150,'Draw lines',@Bt_VisuLinesClick,'stdimg.Preview'); +Bt_VisuGrid:= CreateButton(Self,250,270,150,'Show grid',@Bt_VisuGridClick,'stdimg.Preview'); +Bt_VisuGraph:= CreateButton(Self,250,310,150,'Show graph',@Bt_VisuGraphClick,'stdimg.Preview'); +L_Print:= CreateLabel(Self,450,5,'Print to printer',150,20,taCenter); +Bt_PrintEmptyPage:= CreateButton(Self,450,30,150,'Empty page',@Bt_PrintEmptyPageClick,'stdimg.Imprimer'); +Bt_PrintEmptyPage.Enabled:= False; +Bt_PrintSimpleText:= CreateButton(Self,450,70,150,'Simple text',@Bt_PrintSimpleTextClick,'stdimg.Imprimer'); +Bt_PrintSimpleText.Enabled:= False; +Bt_PrintMultiPages:= CreateButton(Self,450,110,150,'Multiple pages',@Bt_PrintMultiPagesClick,'stdimg.Imprimer'); +Bt_PrintMultiPages.Enabled:= False; +Bt_PrintCadres:= CreateButton(Self,450,150,150,'Draw frames',@Bt_PrintCadresClick,'stdimg.Imprimer'); +Bt_PrintCadres.Enabled:= False; +Bt_PrintColor:= CreateButton(Self,450,190,150,'Show colors',@Bt_PrintColorClick,'stdimg.Imprimer'); +Bt_PrintColor.Enabled:= False; +Bt_PrintLines:= CreateButton(Self,450,230,150,'Draw lines',@Bt_PrintLinesClick,'stdimg.Imprimer'); +Bt_PrintLines.Enabled:= False; +Bt_PrintGrid:= CreateButton(Self,450,270,150,'Show grid',@Bt_PrintGridClick,'stdimg.Imprimer'); +Bt_PrintGrid.Enabled:= False; +Bt_PrintGraph:= CreateButton(Self,450,310,150,'Show graph',@Bt_PrintGraphClick,'stdimg.Imprimer'); +Bt_PrintGraph.Enabled:= False; +Bt_Fermer:= CreateButton(Self,450,350,150,'Fermer',@Bt_FermerClick,'stdimg.Fermer'); +Bt_Fermer.BackgroundColor:= clTomato; +Randomize; +for Cpt:= 0 to 18 do + ChartValues[Cpt]:= Round(Random*100); +end; + +end. + diff --git a/extras/contributed/report_tool/readme.txt b/extras/contributed/report_tool/readme.txt new file mode 100644 index 00000000..0cfed170 --- /dev/null +++ b/extras/contributed/report_tool/readme.txt @@ -0,0 +1,10 @@ + +Name: PDF Reporting Engine and Demo +Author: Jean-Marc Levecque <jmarc.levecque@dbmail.com> +Date: November 2010 +Description: +This project implements a PDF reporting engine that supports many PDF +functionality like multiple-pages, headers and footors, different text colors, +graphs, grids etc. The report can be generated and viewed with any PDF viewer. +It can also be previewed in it's own report preview screen. + diff --git a/extras/contributed/report_tool/reportengine/impression.lpk b/extras/contributed/report_tool/reportengine/impression.lpk new file mode 100644 index 00000000..682ffe71 --- /dev/null +++ b/extras/contributed/report_tool/reportengine/impression.lpk @@ -0,0 +1,67 @@ +<?xml version="1.0"?> +<CONFIG> + <Package Version="3"> + <Name Value="impression"/> + <AddToProjectUsesSection Value="False"/> + <Author Value=""Jean-Marc Levecque" <jmarc.levecque@dbmail.com>"/> + <CompilerOptions> + <Version Value="9"/> + <SearchPaths> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + <LCLWidgetType Value="fpgui"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <CStyleOperator Value="False"/> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Debugging> + <UseLineInfoUnit Value="False"/> + </Debugging> + </Linking> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Description Value="PDF reporting engine"/> + <Version Minor="1"/> + <Files Count="4"> + <Item1> + <Filename Value="u_commande.pas"/> + <UnitName Value="U_Commande"/> + </Item1> + <Item2> + <Filename Value="u_imprime.pas"/> + <UnitName Value="U_Imprime"/> + </Item2> + <Item3> + <Filename Value="u_pdf.pas"/> + <UnitName Value="U_Pdf"/> + </Item3> + <Item4> + <Filename Value="u_visu.pas"/> + <UnitName Value="U_Visu"/> + </Item4> + </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/impression.pas b/extras/contributed/report_tool/reportengine/impression.pas new file mode 100644 index 00000000..76c36510 --- /dev/null +++ b/extras/contributed/report_tool/reportengine/impression.pas @@ -0,0 +1,14 @@ +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit impression; + +interface + +uses + U_Commande, U_Imprime, U_Pdf, U_Visu; + +implementation + +end. diff --git a/extras/contributed/report_tool/reportengine/lib/i386-linux/placeholder.txt b/extras/contributed/report_tool/reportengine/lib/i386-linux/placeholder.txt new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/extras/contributed/report_tool/reportengine/lib/i386-linux/placeholder.txt diff --git a/extras/contributed/report_tool/reportengine/lib/i386-win32/placeholder.txt b/extras/contributed/report_tool/reportengine/lib/i386-win32/placeholder.txt new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/extras/contributed/report_tool/reportengine/lib/i386-win32/placeholder.txt 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 new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/extras/contributed/report_tool/reportengine/lib/x86_64-linux/placeholder.txt diff --git a/extras/contributed/report_tool/reportengine/u_commande.pas b/extras/contributed/report_tool/reportengine/u_commande.pas new file mode 100644 index 00000000..a8e3e5e7 --- /dev/null +++ b/extras/contributed/report_tool/reportengine/u_commande.pas @@ -0,0 +1,682 @@ +{ + << 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 builds the objects in memory to produce either the preview or pdf file +} + +unit U_Commande; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + fpg_base, fpg_main; + +type + TZone = (zEnTete,zPied,zPage,zMarges); + TSectPageNum = (PageNum,SectNum,PSectNum); + TFBordFlags= set of (bcGauche,bcDroite,bcHaut,bcBas); + + TDimensions= record + T: Integer; + L: Integer; + R: Integer; + B: Integer; + end; + + TPapier= record + H: Integer; + W: Integer; + Imprimable: TDimensions; + end; + + T_Section = class + private + FNumSect: Integer; + FNbPages: Integer; + FMarges: TDimensions; + FBasEnTete: Integer; + FHautPied: Integer; + FPages: TList; + FEnTete: TList; + FPied: TList; + FCadres: TList; + function FirstPage: Integer; + function TotalPages: Integer; + public + constructor Create(AMarges: TDimensions; ANum: Integer); virtual; + destructor Destroy; override; + procedure LoadPage(APageNum: Integer); + procedure LoadCmdEnTete; + procedure LoadCmdPage; + procedure LoadCmdPied; + procedure LoadCmdGroupe; + procedure LoadCmdGroupeToPage; + procedure LoadEspaceEnTete(APosY,AColonne,AHeight,AFond: Integer); + procedure LoadEspacePage(APosY,AColonne,AHeight,AFond: Integer); + procedure LoadEspacePied(APosY,AColonne,AHeight,AFond: Integer); + procedure LoadCadre(AStyle: Integer; AZone: TZone); + procedure LoadTrait(APosXDeb,APosYDeb,AColonne,APosXFin,APosYFin,AStyle: Integer); + function GetCmdPage(NumPage: Integer): TList; + property GetCmdEnTete: TList read FEntete; + property GetCmdPied: TList read FPied; + property GetNbPages: Integer read FNbPages; + property GetFirstPage: Integer read FirstPage; + property Pages: TList read FPages; + property TotPages: Integer read TotalPages; + property GetMarges: TDimensions read FMarges; + property GetCmdCadres: TList read FCadres; + end; + + T_Page = class + private + FNumPageTot: Integer; + FNumPageSect: Integer; + FCommandes: TList; + public + constructor Create(ANumSec,ANumTot: Integer); virtual; + destructor Destroy; override; + property Commandes: TList read FCommandes write FCommandes; + property PagesTot: Integer read FNumPageTot; + property PagesSect: Integer read FNumPageSect; + end; + + T_Groupe = class + private + FLineHeight: Integer; + FGroupeHeight: Integer; + FCommandes: TList; + public + constructor Create; virtual; + destructor Destroy; override; + property Commandes: TList read FCommandes write FCommandes; + property GetLineHeight: Integer read FLineHeight; + property GetGroupeHeight: Integer read FGroupeHeight; + end; + + T_Ligne = class + private + FHeight: Integer; + FCommandes: TList; + public + constructor Create; virtual; + destructor Destroy; override; + procedure LoadTexte(APosX,APosY,AColonne,ATexte,AFonte,AHeight,AFond,ABord,AInterL: Integer; + ACurFont: Boolean; AFlags: TFTextFlags); + procedure LoadNumero(APosX,APosY,AColonne,ATexteNum,ATexteTot,AFonte,AHeight,AFond,ABord,AInterL: Integer; + ACurFont: Boolean; AFlags: TFTextFlags; ATotal,AAlpha: Boolean; ATypeNum: TSectPageNum); + property Commandes: TList read FCommandes; + property GetHeight: Integer read FHeight; + end; + + T_Commande = class + end; + + PSection = ^T_Section; + PPage = ^T_Page; + PLigne = ^T_Ligne; + PCommande = ^T_Commande; + PFont = ^TfpgFont; + + T_EcritTexte = class(T_Commande) + private + FPosX: Integer; + FPosY: Integer; + FColonne: Integer; + FTexte: Integer; + FFonte: Integer; + FFond: Integer; + FBord: Integer; + FInterL: Integer; + FCurFont: Boolean; + FFlags: TFTextFlags; + public + constructor Create(APosX,APosY,AColonne,ATexte,AFonte,AFond,ABord,AInterL: Integer; ACurFont: Boolean; AFlags: TFTextFlags); virtual; + procedure SetPosY(const AValue: Integer); + property GetPosX: Integer read FPosX; + property GetPosY: Integer read FPosY; + property GetColonne: Integer read FColonne; + property GetTexte: Integer read FTexte; + property GetFonte: Integer read FFonte; + property GetFond: Integer read FFond; + property GetBord: Integer read FBord; + property GetInterL: Integer read FInterL; + property GetCurFont: Boolean read FCurFont; + property GetFlags: TFTextFlags read FFlags; + end; + + T_Numero = class(T_Commande) + private + FPosX: Integer; + FPosY: Integer; + FColonne: Integer; + FTexteNum: Integer; + FTexteTot: Integer; + FFonte: Integer; + FFond: Integer; + FBord: Integer; + FInterL: Integer; + FCurFont: Boolean; + FFlags: TFTextFlags; + FTotal: Boolean; + FAlpha: Boolean; + FTypeNum: TSectPageNum; + public + constructor Create(APosX,APosY,AColonne,ATexteNum,ATexteTot,AFonte,AFond,ABord,AInterL: Integer; + ACurFont: Boolean; AFlags: TFTextFlags; ATotal,AAlpha: Boolean; ATypeNum: TSectPageNum); virtual; + procedure SetPosY(const AValue: Integer); + property GetPosX: Integer read FPosX; + property GetPosY: Integer read FPosY; + property GetColonne: Integer read FColonne; + property GetTexteNum: Integer read FTexteNum; + property GetTexteTot: Integer read FTexteTot; + property GetFonte: Integer read FFonte; + property GetFond: Integer read FFond; + property GetBord: Integer read FBord; + property GetInterL: Integer read FInterL; + property GetCurFont: Boolean read FCurFont; + property GetFlags: TFTextFlags read FFlags; + property GetTotal: Boolean read FTotal; + property GetAlpha: Boolean read FAlpha; + property GetTypeNum: TSectPageNum read FTypeNum; + end; + + T_Trait = class(T_Commande) + private + FPosX: Integer; + FPosY: Integer; + FColonne: Integer; + FStyle: Integer; + FEndX: Integer; + FEndY: Integer; + public + constructor Create(APosX,APosY,AColonne,AStyle,AEndX,AEndY: Integer); virtual; + property GetPosX: Integer read FPosX; + property GetPosY: Integer read FPosY; + property GetColonne: Integer read FColonne; + property GetStyle: Integer read FStyle; + property GetEndX: Integer read FEndX; + property GetEndY: Integer read FEndY; + end; + + T_Colonne = class(T_Commande) + private + FPos: Integer; + FWidth: Integer; + FMargin: Integer; + FColor: TfpgColor; + public + constructor Create(APos,AWidth,AMargin: Integer; AColor: TfpgColor); virtual; + function GetTextPos: Integer; + function GetTextWidth: Integer; + procedure SetColColor(AColor: TfpgColor); + property GetColPos: Integer read FPos; + property GetColWidth: Integer read FWidth; + property GetColMargin: Integer read FMargin; + property GetColor: TfpgColor read FColor; + end; + + T_Fonte = class(T_Commande) + private + FFonte: TfpgFont; + FColor: TfpgColor; + FSize: string; + public + constructor Create(AFonte: string; AColor: TfpgColor); virtual; + function GetHeight: Integer; + property GetFonte: TfpgFont read FFonte; + property GetColor: TfpgColor read FColor; + property GetSize: string read FSize; + end; + + T_Interligne = class(T_Commande) + private + FSup: Integer; + FInt: Integer; + FInf: Integer; + public + constructor Create(ASup,AInt,AInf: Integer); virtual; + property GetSup: Integer read FSup; + property GetInt: Integer read FInt; + property GetInf: Integer read FInf; + end; + + T_Espace = class(T_Commande) + private + FPosY: Integer; + FColonne: Integer; + FHeight: Integer; + FFond: Integer; + public + constructor Create(APosY,AColonne,AHeight,AFond: Integer); virtual; + procedure SetPosY(const AValue: Integer); + property GetPosY: Integer read FPosY; + property GetColonne: Integer read FColonne; + property GetHeight: Integer read FHeight; + property GetFond: Integer read FFond; + end; + + T_Fond = class(T_Commande) + private + FColor: TfpgColor; + public + constructor Create(AColor: TfpgColor); virtual; + property GetColor: TfpgColor read FColor; + end; + + T_TraitStyle = class(T_Commande) + private + FEpais: Integer; + FColor: TfpgColor; + FStyle: TfpgLineStyle; + public + constructor Create(AEpais: Integer; AColor: Tfpgcolor; AStyle: TfpgLineStyle); virtual; + property GetEpais: Integer read FEpais; + property GetColor: TfpgColor read FColor; + property GetStyle: TfpgLineStyle read FStyle; + end; + + T_Bord = class(T_Commande) + private + FFlags: TFBordFlags; + FStyle: Integer; + public + constructor Create(AFlags: TFBordFlags; AStyle: Integer); + property GetFlags: TFBordFlags read FFlags; + property GetStyle: Integer read FStyle; + end; + + T_Cadre = class(T_Commande) + private + FStyle: Integer; + FZone: TZone; + public + constructor Create(AStyle: Integer; AZone: TZone); + property GetStyle: Integer read FStyle; + property GetZone: TZone read FZone; + end; + +var + Sections: TList; + Colonnes: TList; + Textes: TStringList; + Fontes: TList; + Interlignes: TList; + Fonds: TList; + TraitStyles: TList; + Bords: TList; + ASection: T_Section; + APage: T_Page; + AGroupe: T_Groupe; + ALigne: T_Ligne; + ACommande: T_Commande; + AColonne: T_Colonne; + AFond: T_Fond; + AFonte: T_Fonte; + AInterligne: T_Interligne; + ATraitStyle: T_TraitStyle; + ABord: T_Bord; + +implementation + +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; + +function T_Section.FirstPage: Integer; +begin +Result:= T_Page(Pages[0]).PagesTot; +end; + +function T_Section.TotalPages: Integer; +begin +if Pages.Count> 0 +then + Result:= T_Page(Pages[Pred(Pages.Count)]).PagesTot +else + Result:= 0; +end; + +constructor T_Section.Create(AMarges: TDimensions; ANum: Integer); +begin +FNumSect:= ANum; +FNbPages:= 0; +FMarges:= AMarges; +FBasEnTete:= FMarges.T; +FHautPied:= FMarges.B; +FPages:= TList.Create; +FEnTete:= TList.Create; +FPied:= TList.Create; +FCadres:= TList.Create; +end; + +destructor T_Section.Destroy; +begin +FPages.Free; +FEnTete.Free; +FPied.Free; +FCadres.Free; +inherited Destroy; +end; + +procedure T_Section.LoadPage(APageNum: Integer); +begin +Inc(FNbPages); +APage:= T_Page.Create(FNbPages,APageNum); +Pages.Add(APage); +end; + +procedure T_Section.LoadCmdEnTete; +var + Cpt: Integer; +begin +for Cpt:= 0 to Pred(ALigne.Commandes.Count) do + FEnTete.Add(ALigne.Commandes.Items[Cpt]); +ALigne.FHeight:= 0; +ALigne.Commandes.Clear; +end; + +procedure T_Section.LoadCmdPage; +var + Cpt: Integer; +begin +for Cpt:= 0 to Pred(ALigne.Commandes.Count) do + T_Page(Pages[Pred(Pages.Count)]).Commandes.Add(ALigne.Commandes.Items[Cpt]); +ALigne.FHeight:= 0; +ALigne.Commandes.Clear; +end; + +procedure T_Section.LoadCmdPied; +var + Cpt: Integer; +begin +for Cpt:= 0 to Pred(ALigne.Commandes.Count) do + FPied.Add(ALigne.Commandes.Items[Cpt]); +ALigne.FHeight:= 0; +ALigne.Commandes.Clear; +end; + +procedure T_Section.LoadCmdGroupe; +var + Cpt: Integer; +begin +for Cpt:= 0 to Pred(ALigne.Commandes.Count) do + AGroupe.Commandes.Add(ALigne.Commandes.Items[Cpt]); +with AGroupe do + begin + FLineHeight:= ALigne.FHeight; + FGroupeHeight:= FGroupeHeight+FLineHeight; + end; +ALigne.FHeight:= 0; +ALigne.Commandes.Clear; +end; + +procedure T_Section.LoadCmdGroupeToPage; +var + Cpt: Integer; +begin +for Cpt:= 0 to Pred(AGroupe.Commandes.Count) do + T_Page(Pages[Pred(Pages.Count)]).Commandes.Add(AGroupe.Commandes.Items[Cpt]); +AGroupe.FGroupeHeight:= 0; +AGroupe.Commandes.Clear; +end; + +procedure T_Section.LoadEspaceEnTete(APosY,AColonne,AHeight,AFond: Integer); +begin +ACommande:= T_Espace.Create(APosY,AColonne,AHeight,AFond); +FEnTete.Add(ACommande); +end; + +procedure T_Section.LoadEspacePage(APosY,AColonne,AHeight,AFond: Integer); +begin +ACommande:= T_Espace.Create(APosY,AColonne,AHeight,AFond); +T_Page(Pages[Pred(Pages.Count)]).Commandes.Add(ACommande); +end; + +procedure T_Section.LoadEspacePied(APosY,AColonne,AHeight,AFond: Integer); +begin +ACommande:= T_Espace.Create(APosY,AColonne,AHeight,AFond); +FPied.Add(ACommande); +end; + +procedure T_Section.LoadCadre(AStyle: Integer; AZone: TZone); +begin +ACommande:= T_Cadre.Create(AStyle,AZone); +FCadres.Add(ACommande); +end; + +procedure T_Section.LoadTrait(APosXDeb,APosYDeb,AColonne,APosXFin,APosYFin,AStyle: Integer); +begin +ACommande:= T_Trait.Create(APosXDeb,APosYDeb,AColonne,AStyle,APosXFin,APosYFin); +T_Page(Pages[Pred(Pages.Count)]).Commandes.Add(ACommande); +end; + +function T_Section.GetCmdPage(NumPage: Integer): TList; +begin +Result:= T_Page(Pages[Pred(NumPage)]).Commandes; +end; + +constructor T_Page.Create(ANumSec,ANumTot: Integer); +begin +FNumPageTot:= ANumTot; +FNumPageSect:= ANumSec; +FCommandes:= TList.Create; +end; + +destructor T_Page.Destroy; +begin +FCommandes.Free; +inherited Destroy; +end; + +constructor T_Groupe.Create; +begin +FLineHeight:= 0; +FGroupeHeight:= 0; +Commandes:= TList.Create; +end; + +destructor T_Groupe.Destroy; +begin +Commandes.Free; +inherited Destroy; +end; + +constructor T_Ligne.Create; +begin +FHeight:= 0; +FCommandes:= TList.Create; +end; + +destructor T_Ligne.Destroy; +begin +FCommandes.Free; +inherited Destroy; +end; + +procedure T_Ligne.LoadTexte(APosX,APosY,AColonne,ATexte,AFonte,AHeight,AFond,ABord,AInterL: Integer; + ACurFont: Boolean; AFlags: TFTextFlags); +begin +if FHeight< AHeight +then + FHeight:= AHeight; +ACommande:= T_EcritTexte.Create(APosX,APosY,AColonne,ATexte,AFonte,AFond,ABord,AInterL,ACurFont,AFlags); +Commandes.Add(ACommande); +end; + +procedure T_Ligne.LoadNumero(APosX,APosY,AColonne,ATexteNum,ATexteTot,AFonte,AHeight,AFond,ABord,AInterL: Integer; + ACurFont: Boolean; AFlags: TFTextFlags; ATotal,AAlpha: Boolean; ATypeNum: TSectPageNum); +begin +if FHeight< AHeight +then + FHeight:= AHeight; +ACommande:= T_Numero.Create(APosX,APosY,AColonne,ATexteNum,ATexteTot,AFonte,AFond,ABord,AInterL,ACurFont,AFlags,ATotal,AAlpha,ATypeNum); +Commandes.Add(ACommande); +end; + +procedure T_EcritTexte.SetPosY(const AValue: Integer); +begin +if FPosY<> AValue +then + FPosY:= AValue; +end; + +constructor T_EcritTexte.Create(APosX,APosY,AColonne,ATexte,AFonte,AFond,ABord,AInterL: Integer; ACurFont: Boolean; AFlags: TFTextFlags); +begin +inherited Create; +FPosX:= APosX; +FPosY:= APosY; +FColonne:= AColonne; +FTexte:= ATexte; +FFonte:= AFonte; +FFond:= AFond; +FBord:= ABord; +FInterL:= AInterL; +FCurFont:= ACurFont; +FFlags:= AFlags; +end; + +procedure T_Numero.SetPosY(const AValue: Integer); +begin +if FPosY<> AValue +then + FPosY:= AValue; +end; + +constructor T_Numero.Create(APosX,APosY,AColonne,ATexteNum,ATexteTot,AFonte,AFond,ABord,AInterL: Integer; + ACurFont: Boolean; AFlags: TFTextFlags; ATotal,AAlpha: Boolean; ATypeNum: TSectPageNum); +begin +inherited Create; +FPosX:= APosX; +FPosY:= APosY; +FColonne:= AColonne; +FTexteNum:= ATexteNum; +FTexteTot:= ATexteTot; +FFonte:= AFonte; +FFond:= AFond; +FBord:= ABord; +FInterL:= AInterL; +FCurFont:= ACurFont; +FFlags:= AFlags; +FTotal:= ATotal; +FAlpha:= AAlpha; +FTypeNum:= ATypeNum; +end; + +constructor T_Trait.Create(APosX,APosY,AColonne,AStyle,AEndX,AEndY: Integer); +begin +FPosX:= APosX; +FPosY:= APosY; +FColonne:= AColonne; +FStyle:= AStyle; +FEndX:= AEndX; +FEndY:= AEndY; +end; + +constructor T_Colonne.Create(APos,AWidth,AMargin: Integer; AColor: TfpgColor); +begin +inherited Create; +FPos:= APos; +FWidth:= AWidth; +FMargin:= AMargin; +FColor:= AColor; +end; + +function T_Colonne.GetTextPos: Integer; +begin +Result:= FPos+FMargin; +end; + +function T_Colonne.GetTextWidth: Integer; +begin +Result:= FWidth-(FMargin*2); +end; + +procedure T_Colonne.SetColColor(AColor: TfpgColor); +begin +if FColor<> AColor +then + FColor:= AColor; +end; + +constructor T_Fonte.Create(AFonte: string; AColor: TfpgColor); +begin +inherited Create; +FFonte:= fpgApplication.GetFont(AFonte); +FColor:= AColor; +FSize:= ExtractFontSize(AFonte); +end; + +function T_Fonte.GetHeight: Integer; +begin +Result:= TfpgFont(FFonte).Height; +end; + +constructor T_Interligne.Create(ASup,AInt,AInf: Integer); +begin +inherited Create; +FSup:= ASup; +FInt:= AInt; +FInf:= AInf; +end; + +constructor T_Espace.Create(APosY,AColonne,AHeight,AFond: Integer); +begin +inherited Create; +FPosY:= APosY; +FColonne:= AColonne; +FHeight:= AHeight; +FFond:= AFond; +end; + +procedure T_Espace.SetPosY(const AValue: Integer); +begin +if FPosY<> AValue +then + FPosY:= AValue; +end; + +constructor T_Fond.Create(AColor: TfpgColor); +begin +FColor:= AColor; +end; + +constructor T_TraitStyle.Create(AEpais: Integer; AColor: Tfpgcolor; AStyle: TfpgLineStyle); +begin +inherited Create; +FEpais:= AEpais; +FColor:= AColor; +FStyle:= AStyle; +end; + +constructor T_Bord.Create(AFlags: TFBordFlags; AStyle: Integer); +begin +FFlags:= AFlags; +FStyle:= AStyle; +end; + +constructor T_Cadre.Create(AStyle: Integer; AZone: TZone); +begin +FStyle:= AStyle; +FZone:= AZone; +end; + +end. + diff --git a/extras/contributed/report_tool/reportengine/u_imprime.pas b/extras/contributed/report_tool/reportengine/u_imprime.pas new file mode 100644 index 00000000..96141e76 --- /dev/null +++ b/extras/contributed/report_tool/reportengine/u_imprime.pas @@ -0,0 +1,2508 @@ +{ + << 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 interfaces with the user program +} + +unit U_Imprime; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, StrUtils, + fpg_base, fpg_main, + fpg_panel, + U_Commande, U_Pdf; + +type + TTypePapier= (A4,Letter,Legal,Executive,Comm10,Monarch,DL,C5,B5); + TOrient= (oPortrait,oLandscape); + TMesure = (msMM,msInch); + TPreparation= (ppPrepare,ppVisualise,ppFichierPDF); + + T_Imprime = class(TObject) + private + FVersion: Char; + FPapier: TPapier; + FTypePapier: TTypePapier; + FOrientation: TOrient; + FMargeCourante: TDimensions; + FMesure: TMesure; + FPreparation: TPreparation; + FVisualisation: Boolean; + FCanevas: TfpgCanvas; + FFonteCourante: Integer; + FInterLCourante: Integer; + FColorCourante: Integer; + FNmSection: Integer; + FNmPage: Integer; + FNmPageSect: Integer; + FPosRef: TPoint; // position absolue d'écriture + FEnTeteHeight: Integer; // position verticale de fin de texte en zone entete + FPageHeight: Integer; // position verticale de fin de texte en zone page + FPiedHeight: Integer; // position verticale de début de texte en zone pied + FGroupe: Boolean; + FDefaultFile: string; + function Dim2Pixels(Value: Single): Integer; + function AddLineBreaks(const Txt: TfpgString; AMaxLineWidth: integer; AFnt: TfpgFont): string; + function TxtHeight(AWid: Integer; const ATxt: TfpgString; AFnt: TfpgFont; ALSpace: Integer= 2): Integer; + function ConvertitEnAlpha(Valeur: Integer): string; + function GetHauteurPapier: Integer; + function GetLargeurPapier: Integer; + procedure Bv_VisuPaint(Sender: TObject); + procedure PrepareVisu; + procedure ImprimePage(PageNumero: Integer); + procedure DecaleLignesPied(Decalage: Integer); + procedure DecaleLigne(Decalage: Integer); + procedure DecaleGroupe(Decalage: Integer); + procedure EcritLigne(PosX,PosY,Colonne,Texte,FonteNum,FondNum,BordNum,InterL: Integer; + TxtFlags: TFTextFlags; Zone: TZone); + procedure EcritNum(PosX,PosY,Colonne,TexteNum,TexteTot,FonteNum,FondNum,BordNum,InterL: Integer; + TxtFlags: TFTextFlags; Total,Alpha: Boolean; Zone: TZone; SPNum: TSectPageNum); + procedure InsereEspace(PosY,Colonne,EspHeight,FondNum: Integer; Zone: TZone); + procedure FinLigne(Zone: TZone); + procedure TraceCadre(StTrait: Integer; Zone: TZone); + procedure TraceTrait(XDebut,YDebut,XFin,YFin,StTrait: Integer); + public + constructor Create; + destructor Destroy; override; + procedure Debut(IniOriente: TOrient= oPortrait; IniTypePapier: TTypePapier= A4; + IniMesure: TMesure= msMM; IniVersion: Char= 'F'; IniVisu: Boolean= True); + // début d'impression avec initialisations + // IniOriente = orientation du papier >> oPortrait ou oLandscape + // IniTypePapier = (A4, Letter,Legal,Executive,Comm10,Monarch,DL,C5,B5) + // IniMesure = millimètres (msMM) ou inches (msInches) + // IniVersion = version française 'F' ou version anglaise 'E', ou autre, à venir + // IniVisu = True (visualisation) ou False (impression directe + procedure Fin; + procedure ImprimeDocument; + procedure Visualisation; + procedure Section(MgGauche,MgDroite,MgHaute,MgBasse: Single; Retrait: Single= 0); + // nouvelle section avec initialisation des marges + procedure Page; + // nouvelle page dans la section courante + function Fond(FdColor: TfpgColor): Integer; + // retourne le numéro alloué à la couleur créée + // FdColor = couleur de fond + function Fonte(FtNom: string; FtColor: TfpgColor): Integer; + // retourne le numéro alloué à la fonte créée + // FtNom = FontDesc définissant la fonte + // FtColor = couleur d'écriture + function StyleTrait(StEpais: Integer; StColor: Tfpgcolor; StStyle: TfpgLineStyle): Integer; + // retourne le numéro alloué au style de trait + // StEpais = épaisseur de trait en pixels + // StColor = couleur de trait + // StStyle = style de trait + function Bordure(BdFlags: TFBordFlags; BdStyle: Integer): Integer; + // retourne le numéro alloué à la bordure + // BdFlags = position de la bordure (bdTop,bdBottom,bdLeft,bdRight) + // BdStyle = caractéristiques du trait: épaisseur, couleur, style + function Colonne(ClnPos,ClnWidth: Single; ClnMargin: Single= 0; ClnColor: TfpgColor= clWhite): Integer; + // retourne le numero alloué à la colonne créée + // ClnPos = position gauche en valeur numérique dans l'unité de mesure + // ClnWidth = largeur en valeur numérique dans l'unité de mesure + // ClnMargin = marges gauche et droite + // ClnColor = couleur de fond de la colonne + procedure EcritEnTete(Horiz,Verti: Single; Texte: string; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); + // Horiz = cadrage (cnLeft,cnCenter,cnRight) + // ou valeur numérique dans l'unité de mesure + // Verti = ligne (lnCourante,lnFin) ou valeur numérique dans l'unité de mesure + // Texte = texte à écrire + // ColNum = colonne, par défaut: entre les marges gauche et droite + // FonteNum = fonte applicable au texte + // InterNum = interlignes applicables au texte + // CoulFdNum = couleur de fond, si > -1, remplace la couleur de colonne éventuelle + // BordNum = bordure applicable, si> -1 + procedure EcritPage(Horiz,Verti: Single; Texte: string; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); + // Horiz = cadrage (cnLeft,cnCenter,cnRight) + // ou valeur numérique dans l'unité de mesure + // Verti = ligne (lnCourante,lnFin) ou valeur numérique dans l'unité de mesure + // Texte = texte à écrire + // ColNum = colonne, par défaut: entre les marges gauche et droite + // FonteNum = fonte applicable au texte + // InterNum = interlignes applicables au texte + // CoulFdNum = couleur de fond, si > -1, remplace la couleur de colonne éventuelle + // BordNum = bordure applicable, si> -1 + procedure EcritPied(Horiz,Verti: Single; Texte: string; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); + // Horiz = cadrage (cnLeft,cnCenter,cnRight) + // ou valeur numérique dans l'unité de mesure + // Verti = ligne (lnCourante,lnFin) ou valeur numérique dans l'unité de mesure + // Texte = texte à écrire + // ColNum = colonne, par défaut: entre les marges gauche et droite + // FonteNum = fonte applicable au texte + // InterNum = interlignes applicables au texte + // CoulFdNum = couleur de fond, si > -1, remplace la couleur de colonne éventuelle + // BordNum = bordure applicable, si> -1 + procedure NumSectionEnTete(Horiz,Verti: Single; TexteSect: string= ''; TexteTot: string= ''; + Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); + // Horiz = cadrage (cnLeft,cnCenter,cnRight) + // ou valeur numérique dans l'unité de mesure + // Verti = ligne (lgCourante,lgFin) ou valeur numérique dans l'unité de mesure + // TexteSection = texte à écrire devant le numéro de section + // TexteTotal = texte à écrire devant le nombre de sections + // Total= True > affiche le nombre total de sections + // Alpha= True > affiche le nombre total de sections en lettres en ordre alphabétique + // ColNum = colonne, par défaut: entre les marges gauche et droite + // FonteNum = fonte applicable au texte + // InterNum = interlignes applicables au texte + // CoulFdNum = couleur de fond, si > -1, remplace la couleur de colonne éventuelle + // BordNum = bordure applicable, si> -1 + procedure NumSectionPied(Horiz,Verti: Single; TexteSect: string= ''; TexteTot: string= ''; + Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); + // Horiz = cadrage (cnLeft,cnCenter,cnRight) + // ou valeur numérique dans l'unité de mesure + // Verti = ligne (lgCourante,lgFin) ou valeur numérique dans l'unité de mesure + // TexteSection = texte à écrire devant le numéro de section + // TexteTotal = texte à écrire devant le nombre de sections + // Total= True > affiche le nombre total de sections + // Alpha= True > affiche le nombre total de sections en lettres en ordre alphabétique + // ColNum = colonne, par défaut: entre les marges gauche et droite + // FonteNum = fonte applicable au texte + // InterNum = interlignes applicables au texte + // CoulFdNum = couleur de fond, si > -1, remplace la couleur de colonne éventuelle + // BordNum = bordure applicable, si> -1 + procedure NumPageEnTete(Horiz,Verti: Single; TextePage: string= ''; TexteTotal: string= ''; + Total: Boolean= False; ColNum: Integer= 0; FonteNum: Integer= 0; InterNum: Integer= 0; + CoulFdNum: Integer= -1; BordNum: Integer= -1); + // Horiz = cadrage (cnLeft,cnCenter,cnRight) + // ou valeur numérique dans l'unité de mesure + // Verti = ligne (lnCourante,lnFin) ou valeur numérique dans l'unité de mesure + // TextePage = texte à écrire devant le numéro de page + // TexteTotal = texte à écrire devant le nombre de pages + // Total= True > affiche le nombre total de pages + // ColNum = colonne, par défaut: entre les marges gauche et droite + // FonteNum = fonte applicable au texte + // InterNum = interlignes applicables au texte + // CoulFdNum = couleur de fond, si > -1, remplace la couleur de colonne éventuelle + // BordNum = bordure applicable, si> -1 + procedure NumPagePied(Horiz,Verti: Single; TextePage: string= ''; TexteTotal: string= ''; + Total: Boolean= False; ColNum: Integer= 0; FonteNum: Integer= 0; InterNum: Integer= 0; + CoulFdNum: Integer= -1; BordNum: Integer= -1); + // Horiz = cadrage (cnLeft,cnCenter,cnRight) + // ou valeur numérique dans l'unité de mesure + // Verti = ligne (lnCourante,lnFin) ou valeur numérique dans l'unité de mesure + // TextePage = texte à écrire devant le numéro de page + // TexteTotal = texte à écrire devant le nombre de pages + // Total= True > affiche le nombre total de pages + // ColNum = colonne, par défaut: entre les marges gauche et droite + // FonteNum = fonte applicable au texte + // InterNum = interlignes applicables au texte + // CoulFdNum = couleur de fond, si > -1, remplace la couleur de colonne éventuelle + // BordNum = bordure applicable, si> -1 + procedure NumPageSectionEnTete(Horiz,Verti: Single; TexteSect: string= ''; TexteTot: string= ''; + Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); + // Horiz = cadrage (cnLeft,cnCenter,cnRight) + // ou valeur numérique dans l'unité de mesure + // Verti = ligne (lnCourante,lnFin) ou valeur numérique dans l'unité de mesure + // TextePage = texte à écrire devant le numéro de page dans la section + // TexteTotal = texte à écrire devant le nombre de pages de la section + // Total= True > affiche le nombre total de pages de la section + // ColNum = colonne, par défaut: entre les marges gauche et droite + // FonteNum = fonte applicable au texte + // InterNum = interlignes applicables au texte + // CoulFdNum = couleur de fond, si > -1, remplce la couleur de colonne éventuelle + // BordNum = bordure applicable, si> -1 + procedure NumPageSectionPied(Horiz,Verti: Single; TexteSect: string= ''; TexteTot: string= ''; + Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); + // Horiz = cadrage (cnLeft,cnCenter,cnRight) + // ou valeur numérique dans l'unité de mesure + // Verti = ligne (lnCourante,lnFin) ou valeur numérique dans l'unité de mesure + // TextePage = texte à écrire devant le numéro de page dans la section + // TexteTotal = texte à écrire devant le nombre de pages de la section + // Total= True > affiche le nombre total de pages de la section + // ColNum = colonne, par défaut: entre les marges gauche et droite + // FonteNum = fonte applicable au texte + // InterNum = interlignes applicables au texte + // CoulFdNum = couleur de fond, si > -1, remplace la couleur de colonne éventuelle + // BordNum = bordure applicable, si> -1 + //procedure TraitEnTete(Horiz,Verti: Single; ColNum: Integer= 0; StyleNum: Integer= 0; FinH: Integer= -1; + //FinV: Integer= -1); + //procedure TraitPage(Horiz,Verti: Single; ColNum: Integer= 0; StyleNum: Integer= 0; FinH: Integer= -1; + //FinV: Integer= -1); + //procedure TraitPied(Horiz,Verti: Single; ColNum: Integer= 0; StyleNum: Integer= 0; FinH: Integer= -1; + //FinV: Integer= -1); + procedure EspaceEnTete(Verti: Single; ColNum: Integer=0; CoulFdNum: Integer= -1); + // Verti = hauteur de l'espace vide : valeur numérique dans l'unité de mesure + // ColNum = colonne, par défaut: entre les marges gauche et droite + // CoulFdNum = couleur de fond, si > -1, remplace la couleur de colonne éventuelle + procedure EspacePage(Verti: Single; ColNum: Integer=0; CoulFdNum: Integer= -1); + // Verti = hauteur de l'espace vide : valeur numérique dans l'unité de mesure + // ColNum = colonne, par défaut: entre les marges gauche et droite + // CoulFdNum = couleur de fond, si > -1, remplace la couleur de colonne éventuelle + procedure EspacePied(Verti: Single; ColNum: Integer=0; CoulFdNum: Integer= -1); + // Verti = hauteur de l'espace vide : valeur numérique dans l'unité de mesure + // ColNum = colonne, par défaut: entre les marges gauche et droite + // CoulFdNum = couleur de fond, si > -1, remplace la couleur de colonne éventuelle + function Interligne(ItlSup,ItlInt,ItlInf: Single): Integer; + // IntSup = interligne supérieure dans l'unité de mesure + // IntInf = interligne inférieure dans l'unité de mesure + procedure Groupe(SautPage: Boolean= False); + // SautPage = True >> force nouvelle page avant le groupe + // = False >> sur la page active si le groupe peut y être entièrement inclus + procedure FinGroupe(SautPage: Boolean= False); + // SautPage = True >> force nouvelle page après le groupe + // = False >> continue sur la page active après le groupe + procedure ColorColChange(ColNum: Integer; ColColor: TfpgColor); + // Change la couleur d'une colonne + // ColNum = numéro de la colonne + // ColColor = nouvelle couleur de fond de la colonne + procedure CadreMarges(AStyle: Integer); + // Trace un cadre aux marges de la page + // AStyle = style de trait + procedure CadreEnTete(AStyle: Integer); + // trace un cadre aux dimensions de l'entête + // AStyle = style de trait + procedure CadrePage(AStyle: Integer); + // trace un care aux dimensions de la page + // AStyle = style de trait + procedure CadrePied(AStyle: Integer); + // trace un cadre aux dimensions du pied de page + // AStyle = style de trait + procedure TraitPage(XDebut,YDebut,XFin,YFin: Single; AStyle: Integer); + // XDebut = abscisse du point initial dans l'unité de mesure + // YDebut = ordonnée du point initial dans l'unité de mesure + // XFin = abscisse du point final dans l'unité de mesure + // YFin = ordonnée du point final dans l'unité de mesure + // AStyle = style de trait + property Langue: Char read FVersion write FVersion; + property Visualiser: Boolean read FVisualisation write FVisualisation; + property NumeroSection: Integer read FNmSection write FNmSection; + property NumeroPage: Integer read FNmPage write FNmPage; + property NumeroPageSection: Integer read FNmPageSect write FNmPageSect; + property HauteurPapier: Integer read GetHauteurPapier; + property LargeurPapier: Integer read GetLargeurPapier; + property DefaultFile: string read FDefaultFile write FDefaultFile; + property CouleurCourante: Integer read FColorCourante write FColorCourante; + end; + + TPdfElement = class + end; + + TPdfTexte= class(TPdfElement) + private + FPage: Integer; + FFont: Integer; + FSize: string; + FPosX: Integer; + FPosY: Integer; + FLarg: Integer; + 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: Integer read FPosX write FPosX; + property TextPosY: Integer read FPosY write FPosY; + property TextLarg: Integer read FLarg write FLarg; + property Ecriture: string read FText write FText; + property Couleur: TfpgColor read FColor write FColor; + end; + + TPdfRect = class(TPdfElement) + private + FPage: Integer; + FEpais: Integer; + FGauche: Integer; + FBas: Integer; + FHaut: Integer; + FLarg: Integer; + FColor: Integer; + FFill: Boolean; + FStroke: Boolean; + FLineStyle: TfpgLineStyle; + protected + public + property PageId: Integer read FPage write FPage; + property RectEpais: Integer read FEpais write FEpais; + property RectGauche: Integer read FGauche write FGauche; + property RectBas: Integer read FBas write FBas; + property RectHaut: Integer read FHaut write FBas; + property RectLarg: Integer read FLarg write FLarg; + property RectCouleur: Integer read FColor write FColor; + property RectEmplit: Boolean read FFill write FFill; + property RectTrace: Boolean read FStroke write FStroke; + property RectLineStyle: TfpgLineStyle read FLineStyle write FLineStyle; + end; + + TPdfLine = class(TPdfElement) + private + FPage: Integer; + FEpais: Integer; + FStartX: Integer; + FStartY: Integer; + FEndX: Integer; + FEndY: Integer; + FColor: Integer; + FStyle: TfpgLineStyle; + protected + public + property PageId: Integer read FPage write FPage; + property LineEpais: Integer read FEpais write FEpais; + property LineStartX: Integer read FSTartX write FStartX; + property LineStartY: Integer read FStartY write FStartY; + property LineEndX: Integer read FEndX write FEndX; + property LineEndY: Integer read FEndY write FEndY; + property LineColor: Integer read FColor write FColor; + property LineStyle: TfpgLineStyle read FStyle write FStyle; + end; + +var + Imprime: T_Imprime; + + Infos: record + Titre: string; + Auteur: string; + end; + + PdfPage: TList; + PdfTexte: TPdfTexte; + PdfRect: TPdfRect; + PdfLine: TPdfLine; + +const + FontDefaut= 0; + ColDefaut= 0; + lnCourante= -1; + lnFin= -2; +// cnSuite= -1; + cnLeft= -2; + cnCenter= -3; + cnRight= -4; + +implementation + +uses + U_Visu; + +const + InchToMM= 25.4; + PPI= 72; + Cent= 100; + +function T_Imprime.Dim2Pixels(Value: Single): Integer; +begin +if FMesure= msMM +then + Result:= Round(Value*PPI/InchToMM) +else + Result:= Trunc(Value*PPI); +end; + +function T_Imprime.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_Imprime.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_Imprime.ConvertitEnAlpha(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_Imprime.GetHauteurPapier: Integer; +begin +Result:= FPapier.H; +end; + +function T_Imprime.GetLargeurPapier: Integer; +begin +Result:= FPapier.W; +end; + +procedure T_Imprime.Bv_VisuPaint(Sender: TObject); +begin +ImprimePage(NumeroPage); +end; + +procedure T_Imprime.PrepareVisu; +var + TempH,TempW,TempT,TempL,TempR,TempB: Integer; +begin +with FPapier do + begin + case FTypePapier of + A4: + begin + H:= 842; + W:= 595; + with Imprimable do + begin + T:= 10; + L:= 11; + R:= 586; + B:= 822; + end; + end; + Letter: + begin + H:= 792; + W:= 612; + with Imprimable do + begin + T:= 13; + L:= 13; + R:= 599; + B:= 780; + end; + end; + Legal: + begin + H:= 1008; + W:= 612; + with Imprimable do + begin + T:= 13; + L:= 13; + R:= 599; + B:= 996; + end; + end; + Executive: + begin + H:= 756; + W:= 522; + with Imprimable do + begin + T:= 14; + L:= 13; + R:= 508; + B:= 744; + end; + end; + Comm10: + begin + H:= 684; + W:= 297; + with Imprimable do + begin + T:= 13; + L:= 13; + R:= 284; + B:= 672; + end; + end; + Monarch: + begin + H:= 540; + W:= 279; + with Imprimable do + begin + T:= 13; + L:= 13; + R:= 266; + B:= 528; + end; + end; + DL: + begin + H:= 624; + W:= 312; + with Imprimable do + begin + T:= 14; + L:= 13; + R:= 297; + B:= 611; + end; + end; + C5: + begin + H:= 649; + W:= 459; + with Imprimable do + begin + T:= 13; + L:= 13; + R:= 446; + B:= 637; + end; + end; + B5: + begin + H:= 708; + W:= 499; + with Imprimable 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 Imprimable do + begin + TempT:= T; + TempL:= L; + TempR:= R; + TempB:= B; + T:= TempL; + L:= TempT; + R:= TempB; + B:= TempR; + end; + end; + end; +F_Visu:= TF_Visu.Create(nil); +with F_Visu do + begin + Bv_Visu:= CreateBevel(F_Visu,(F_Visu.Width-FPapier.W) div 2,50+(F_Visu.Height-50-FPapier.H) div 2, + FPapier.W,FPapier.H,bsBox,bsRaised); + Bv_Visu.BackgroundColor:= clWhite; + Bv_Visu.OnPaint:= @Bv_VisuPaint; + end; +end; + +procedure LibereCommandesPages(ACommandes: PPage); +var + Cpt: Integer; +begin +with T_Page(ACommandes) do + if Commandes.Count> 0 + then + begin + for Cpt:= 0 to Pred(Commandes.Count) do + T_Commande(Commandes[Cpt]).Free; + Commandes.Free; + end; +end; + +procedure LiberePages(APageSect: PSection); +var + Cpt: Integer; +begin +with T_Section(APageSect) do + if Pages.Count> 0 + then + begin + for Cpt:= 0 to Pred(Pages.Count) do + LibereCommandesPages(Pages[Cpt]); + Pages.Free; + end; +end; + +procedure T_Imprime.ImprimePage(PageNumero: Integer); +var + CptSect,CptPage,CptCmd: Integer; + LaPage: T_Page; + Cmd: T_Commande; +begin +CptSect:= 0; +repeat + Inc(CptSect); + CptPage:= 0; + with T_Section(Sections[Pred(CptSect)]) do + repeat + Inc(CptPage); + LaPage:= T_Page(Pages.Items[Pred(CptPage)]); + until (LaPage.PagesTot= PageNumero) or (CptPage= Pages.Count); +until (LaPage.PagesTot= PageNumero) or (CptSect= Sections.Count); +NumeroPage:= PageNumero; +NumeroSection:= CptSect; +NumeroPageSection:= LaPage.PagesSect; +with T_Section(Sections[Pred(NumeroSection)]) do + begin + if GetCmdEnTete.Count> 0 + then + for CptCmd:= 0 to Pred(GetCmdEnTete.Count) do + begin + Cmd:= T_Commande(GetCmdEnTete.Items[CptCmd]); + if Cmd is T_EcritTexte + then + with Cmd as T_EcritTexte do + EcritLigne(GetPosX,GetPosY,GetColonne,GetTexte,GetFonte,GetFond,GetBord,GetInterL,GetFlags,ZEnTete); + if Cmd is T_Numero + then + with Cmd as T_Numero do + EcritNum(GetPosX,GetPosY,GetColonne,GetTexteNum,GetTexteTot,GetFonte,GetFond,GetBord,GetInterL, + GetFlags,GetTotal,GetAlpha,zEnTete,GetTypeNum); + if Cmd is T_Espace + then + with Cmd as T_Espace do + InsereEspace(GetPosY,GetColonne,GetHeight,GetFond,zEnTete); + end; + if GetCmdPage(NumeroPageSection).Count> 0 + then + for CptCmd:= 0 to Pred(GetCmdPage(NumeroPageSection).Count) do + begin + Cmd:= T_Commande(GetCmdPage(NumeroPageSection).Items[CptCmd]); + if Cmd is T_EcritTexte + then + with Cmd as T_EcritTexte do + EcritLigne(GetPosX,GetPosY,GetColonne,GetTexte,GetFonte,GetFond,GetBord,GetInterL,GetFlags,ZPage); + if Cmd is T_Espace + then + with Cmd as T_Espace do + InsereEspace(GetPosY,GetColonne,GetHeight,GetFond,zPage); + if Cmd is T_Trait + then + with Cmd as T_Trait do + TraceTrait(GetPosX,GetPosY,GetEndX,GetEndY,GetStyle); + end; + if GetCmdPied.Count> 0 + then + for CptCmd:= 0 to Pred(GetCmdPied.Count) do + begin + Cmd:= T_Commande(GetCmdPied.Items[CptCmd]); + if Cmd is T_EcritTexte + then + with Cmd as T_EcritTexte do + EcritLigne(GetPosX,GetPosY,GetColonne,GetTexte,GetFonte,GetFond,GetBord,GetInterL,GetFlags,ZPied); + if Cmd is T_Numero + then + with Cmd as T_Numero do + EcritNum(GetPosX,GetPosY,GetColonne,GetTexteNum,GetTexteTot,GetFonte,GetFond,GetBord,GetInterL, + GetFlags,GetTotal,GetAlpha,zPied,GetTypeNum); + if Cmd is T_Espace + then + with Cmd as T_Espace do + InsereEspace(GetPosY,GetColonne,GetHeight,GetFond,zPied); + end; + if GetCmdCadres.Count> 0 + then + for CptCmd:= 0 to Pred(GetCmdCadres.Count) do + begin + Cmd:= T_Commande(GetCmdCadres.Items[CptCmd]); + if Cmd is T_Cadre + then + with Cmd as T_Cadre do + TraceCadre(GetStyle,GetZone); + end; + end; +end; + +procedure T_Imprime.DecaleLignesPied(Decalage: Integer); +var + Cpt: Integer; + Cmd: T_Commande; +begin +with T_Section(Sections[Pred(NumeroSection)]) do + if GetCmdPied.Count> 0 + then + for Cpt:= 0 to Pred(GetCmdPied.Count) do + begin + Cmd:= T_Commande(GetCmdPied.Items[Cpt]); + if Cmd is T_EcritTexte + then + with Cmd as T_EcritTexte do + SetPosY(GetPosY-Decalage); + if Cmd is T_Numero + then + with Cmd as T_Numero do + SetPosY(GetPosY-Decalage); + if Cmd is T_Espace + then + with Cmd as T_Espace do + SetPosY(GetPosY-Decalage); + end; +end; + +procedure T_Imprime.DecaleLigne(Decalage: Integer); +var + Cpt: Integer; + Cmd: T_Commande; +begin +with ALigne do + for Cpt:= 0 to Pred(Commandes.Count) do + begin + Cmd:= T_Commande(Commandes.Items[Cpt]); + if Cmd is T_EcritTexte + then + with Cmd as T_EcritTexte do + SetPosY(GetPosY-Decalage); + end; +end; + +procedure T_Imprime.DecaleGroupe(Decalage: Integer); +var + Cpt: Integer; + Cmd: T_Commande; +begin +with AGroupe do + for Cpt:= 0 to Pred(Commandes.Count) do + begin + Cmd:= T_Commande(Commandes.Items[Cpt]); + if Cmd is T_EcritTexte + then + with Cmd as T_EcritTexte do + SetPosY(GetPosY-Decalage); + end; +end; + +procedure T_Imprime.EcritLigne(PosX,PosY,Colonne,Texte,FonteNum,FondNum,BordNum,InterL: Integer; + TxtFlags: TFTextFlags; Zone: TZone); +var + PosH,PosV,HTxt,HautTxt,IntlInt,IntLSup,IntLInf,Half,CoulTrait,EpaisTrait: Integer; + FinDeLigne,UseCurFont: Boolean; + Fnt: TfpgFont; + StylTrait: TfpgLineStyle; +begin +FinDeLigne:= False; +if FPreparation= ppPrepare +then + if FFonteCourante<> FonteNum + then + begin + FFonteCourante:= FonteNum; + UseCurFont:= False; + end + else + UseCurFont:= True; +Fnt:= T_Fonte(Fontes[FonteNum]).GetFonte; +if Interlignes.Count= 0 +then + Interligne(0,0,0); +if FInterLCourante<> InterL +then + FInterLCourante:= InterL; +IntLSup:= T_Interligne(Interlignes[FInterLCourante]).GetSup; +IntlInt:= T_Interligne(Interlignes[FInterLCourante]).GetInt; +IntLInf:= T_Interligne(Interlignes[FInterLCourante]).GetInf; +if Colonne> -1 +then + HautTxt:= TxtHeight(T_Colonne(Colonnes[Colonne]).GetTextWidth,Textes[Texte],Fnt,IntlInt)+IntLSup+IntLInf +else + HautTxt:= TxtHeight(FPapier.W,Textes[Texte],Fnt,IntlInt)+IntLSup+IntLInf; +if (Colonne> -1) and (BordNum> -1) +then + Half:= T_TraitStyle(TraitStyles[T_Bord(Bords[BordNum]).GetStyle]).GetEpais div 2 +else + Half:= 0; +case FPreparation of + ppPrepare: + begin + if T_Section(Sections[Pred(NumeroSection)]).GetNbPages= 0 + then + Page; + if Colonne> -1 + then + begin + HTxt:= ALigne.GetHeight; + if HTxt< HautTxt + then + HTxt:= HautTxt; + end + else + if HTxt< Fnt.Height + then + HTxt:= Fnt.Height; + case Zone of + zEntete: + FPosRef.Y:= FMargeCourante.T+FEnTeteHeight; + zPage: + FPosRef.Y:= FMargeCourante.T+FEnTeteHeight+FPageHeight; + zPied: + begin + FPosRef.Y:= FMargeCourante.B-HTxt; + FPiedHeight:= FPiedHeight+HTxt; + DecaleLignesPied(HTxt); + end; + end; + if PosY= lnCourante + then + PosV:= FPosRef.Y+IntLSup + else + begin + FinDeLigne:= True; + if PosY= lnFin + then + begin + PosV:= FPosRef.Y+IntLSup; + case Zone of + zEnTete: + FPosRef.Y:= FPosRef.Y+HTxt; + zPage: + begin + if FPosRef.Y+HTxt> FMargeCourante.B-FPiedHeight + then + if FGroupe + then + begin + if AGroupe.GetGroupeHeight+HTxt< FMargeCourante.B-FMargeCourante.T-FEnTeteHeight-FPiedHeight + then + begin + Page; + if AGroupe.Commandes.Count> 0 + then + begin + FPosRef.Y:= FMargeCourante.T+FEnTeteHeight; + DecaleGroupe(T_EcritTexte(AGroupe.Commandes[0]).GetPosY-FPosRef.Y); + FPosRef.Y:= FPosRef.Y+AGroupe.GetGroupeHeight+Succ(Half); + if ALigne.Commandes.Count> 0 + then + DecaleLigne(T_EcritTexte(ALigne.Commandes[0]).GetPosY-FPosRef.Y); + PosV:= FPosRef.Y+IntLSup; + FPosRef.Y:= FPosRef.Y+HTxt+Succ(Half); + end + else + begin + if ALigne.Commandes.Count> 0 + then + DecaleLigne(T_EcritTexte(ALigne.Commandes[0]).GetPosY-FPosRef.Y); + PosV:= FPosRef.Y+IntLSup; + FPosRef.Y:= FPosRef.Y+HTxt+Succ(Half); + end; + end + else + begin + T_Section(Sections[Pred(Sections.Count)]).LoadCmdGroupeToPage; + AGroupe.Commandes.Clear; + Page; + FPosRef.Y:= FMargeCourante.T+FEnTeteHeight; + if ALigne.Commandes.Count> 0 + then + DecaleLigne(T_EcritTexte(ALigne.Commandes[0]).GetPosY-FPosRef.Y); + PosV:= FPosRef.Y+IntLSup; + FPosRef.Y:= FPosRef.Y+HTxt+Succ(Half); + end; + end + else + begin + Page; + FPosRef.Y:= FMargeCourante.T+FEnTeteHeight; + if ALigne.Commandes.Count> 0 + then + DecaleLigne(T_EcritTexte(ALigne.Commandes[0]).GetPosY-FPosRef.Y); + PosV:= FPosRef.Y+IntLSup; + FPosRef.Y:= FPosRef.Y+HTxt+Succ(Half); + end + else + FPosRef.Y:= FPosRef.Y+HTxt; + end; + end; + if BordNum> -1 + then + with T_Bord(Bords[BordNum]) do + if bcBas in GetFlags + then + FPosRef.Y:= FPosRef.Y+1; + end + else + begin + PosV:= PosY; + FPosRef.Y:= PosV+IntLInf; + end; + case Zone of + zEnTete: + FEnTeteHeight:= FPosRef.Y-FMargeCourante.T; + zPage: + FPageHeight:= FPosRef.Y-FEnTeteHeight-FMargeCourante.T; + end; + end; + //if PosX= cnSuite + //then + //PosH:= FPosRef.X + //else + if Colonne= -1 + then + if PosX> 0 + then + PosH:= PosX + else + begin + PosH:= T_Colonne(Colonnes[0]).GetTextPos; + if (txtRight in TxtFlags) + then + PosH:= PosH+T_Colonne(Colonnes[0]).GetColWidth-Fnt.TextWidth(Textes[Texte])-T_Colonne(Colonnes[0]).GetColMargin; + if (txtHCenter in TxtFlags) + then + PosH:= PosH+(T_Colonne(Colonnes[0]).GetColWidth-Fnt.TextWidth(Textes[Texte])) div 2; + end + else + if PosX> 0 + then + begin + if (PosX< T_Colonne(Colonnes[Colonne]).GetTextPos) + or (PosX> (T_Colonne(Colonnes[Colonne]).GetTextPos+T_Colonne(Colonnes[Colonne]).GetTextWidth)) + then + PosH:= T_Colonne(Colonnes[Colonne]).GetTextPos + else + PosH:= PosX; + end + else + begin + PosH:= T_Colonne(Colonnes[Colonne]).GetTextPos; + if (txtRight in TxtFlags) + then + PosH:= PosH+T_Colonne(Colonnes[0]).GetColWidth-Fnt.TextWidth(Textes[Texte])-T_Colonne(Colonnes[0]).GetColMargin; + if (txtHCenter in TxtFlags) + then + PosH:= PosH+(T_Colonne(Colonnes[0]).GetColWidth-Fnt.TextWidth(Textes[Texte])) div 2; + end; + FPosRef.X:= PosH+Fnt.TextWidth(Textes[Texte]+' '); + ALigne.LoadTexte(PosH,PosV,Colonne,Texte,FonteNum,HTxt,FondNum,BordNum,InterL,UseCurFont,TxtFlags); + if FinDeLigne + then + begin + HTxt:= 0; + FinLigne(Zone); + end; + end; + ppVisualise: + with FCanevas do + begin + Font:= T_Fonte(Fontes[FonteNum]).GetFonte; + SetTextColor(T_Fonte(Fontes[FonteNum]).GetColor); + if Colonne> -1 + then + with T_Colonne(Colonnes[Colonne]) do + begin + if FondNum> -1 + then + SetColor(T_Fond(Fonds[FondNum]).GetColor) + else + SetColor(GetColor); + FillRectangle(GetColPos,PosY-IntLSup,GetColWidth,HautTxt); + if BordNum> -1 + then + with T_Bord(Bords[BordNum]) do + begin + SetLineStyle(T_TraitStyle(TraitStyles[GetStyle]).GetEpais,T_TraitStyle(TraitStyles[GetStyle]).GetStyle); + SetColor(T_TraitStyle(TraitStyles[GetStyle]).GetColor); + if bcGauche in GetFlags + then + DrawLine(GetColPos+Half,PosY-IntLSup,GetColPos+Half,PosY-IntLSup+HautTxt); + if bcDroite in GetFlags + then + DrawLine(GetColPos+GetColWidth-Succ(Half),PosY-IntLSup,GetColPos+GetColWidth-Succ(Half),PosY-IntLSup+HautTxt); + if bcHaut in GetFlags + then + DrawLine(GetColPos,PosY-IntLSup+Half,GetColPos+GetColWidth,PosY-IntLSup+Half); + if bcBas in GetFlags + then + DrawLine(GetColPos,PosY-IntLSup+HautTxt-Half,GetColPos+GetColWidth,PosY-IntLSup+HautTxt-Half); + end; + DrawText(GetTextPos,PosY,GetTextWidth,0,Textes[Texte],TxtFlags,IntlInt); + end + else + DrawText(PosX,PosY-Fnt.Ascent,Textes[Texte],TxtFlags); + end; + ppFichierPDF: + if Colonne> -1 + then + with T_Colonne(Colonnes[Colonne]) do + begin + if (GetColor<> clWhite) or (FondNum> -1) + then + begin + PdfRect:= TPdfRect.Create; + with PdfRect do + begin + PageId:= NumeroPage; + FGauche:= GetColPos; + FBas:= FPapier.H-PosY+IntLSup-HautTxt; + FHaut:= HautTxt; + FLarg:= GetColWidth; + if FondNum> -1 + then + FColor:= T_Fond(Fonds[FondNum]).GetColor + else + FColor:= GetColor; + FFill:= True; + FStroke:= False; + end; + PdfPage.Add(PdfRect); + end; + if BordNum> -1 + then + with T_Bord(Bords[BordNum]) do + begin + StylTrait:= T_TraitStyle(TraitStyles[T_Bord(Bords[BordNum]).GetStyle]).GetStyle; + CoulTrait:= T_TraitStyle(TraitStyles[T_Bord(Bords[BordNum]).GetStyle]).GetColor; + EpaisTrait:= T_TraitStyle(TraitStyles[T_Bord(Bords[BordNum]).GetStyle]).GetEpais; + if bcGauche in GetFlags + then + begin + PdfLine:= TPdfLine.Create; + with PdfLine do + begin + PageId:= NumeroPage; + FStartX:= GetColPos; + FStartY:= FPapier.H-PosY+IntLSup; + FEndX:= GetColPos; + FEndY:= FPapier.H-PosY+IntLSup-HautTxt; + FStyle:= StylTrait; + FColor:= CoulTrait; + FEpais:= EpaisTrait; + end; + PdfPage.Add(PdfLine); + end; + if bcDroite in GetFlags + then + begin + PdfLine:= TPdfLine.Create; + with PdfLine do + begin + PageId:= NumeroPage; + FStartX:= GetColPos+GetColWidth; + FStartY:= FPapier.H-PosY+IntLSup; + FEndX:= GetColPos+GetColWidth; + FEndY:= FPapier.H-PosY+IntLSup-HautTxt; + FStyle:= StylTrait; + FColor:= CoulTrait; + FEpais:= EpaisTrait; + end; + PdfPage.Add(PdfLine); + end; + if bcHaut in GetFlags + then + begin + PdfLine:= TPdfLine.Create; + with PdfLine do + begin + PageId:= NumeroPage; + FStartX:= GetColPos; + FStartY:= FPapier.H-PosY+IntLSup; + FEndX:= GetColPos+GetColWidth; + FEndY:= FPapier.H-PosY+IntLSup; + FStyle:= StylTrait; + FColor:= CoulTrait; + FEpais:= EpaisTrait; + end; + PdfPage.Add(PdfLine); + end; + if bcBas in GetFlags + then + begin + PdfLine:= TPdfLine.Create; + with PdfLine do + begin + PageId:= NumeroPage; + FStartX:= GetColPos; + FStartY:= FPapier.H-PosY+IntLSup-HautTxt; + FEndX:= GetColPos+GetColWidth; + FEndY:= FPapier.H-PosY+IntLSup-HautTxt; + FStyle:= StylTrait; + FColor:= CoulTrait; + FEpais:= EpaisTrait; + end; + PdfPage.Add(PdfLine); + end; + end; + PdfTexte:= TPdfTexte.Create; + with PdfTexte do + begin + PageId:= NumeroPage; + FFont:= FonteNum; + FSize:= T_Fonte(Fontes[FonteNum]).GetSize; + FColor:= T_Fonte(Fontes[FonteNum]).GetColor; + TextPosX:= GetTextPos; + if (txtRight in TxtFlags) + then + TextPosX:= GetColPos+GetColWidth-GetColMargin-Fnt.TextWidth(Textes[Texte]); + if (txtHCenter in TxtFlags) + then + TextPosX:= GetTextPos+(GetColWidth-Fnt.TextWidth(Textes[Texte])) div 2; + TextPosY:= FPapier.H-PosY-Fnt.Ascent; + TextLarg:= GetColWidth; + Ecriture:= Textes[Texte]; + end; + PdfPage.Add(PdfTexte); + end + else + begin + PdfTexte:= TPdfTexte.Create; + with PdfTexte do + begin + PageId:= NumeroPage; + FFont:= FonteNum; + FSize:= T_Fonte(Fontes[FonteNum]).GetSize; + FColor:= T_Fonte(Fontes[FonteNum]).GetColor; + FPosX:= PosX; + FPosY:= FPapier.H-PosY; + FLarg:= FPapier.W; + FText:= Textes[Texte]; + end; + PdfPage.Add(PdfTexte); + end; + end; +end; + +procedure T_Imprime.EcritNum(PosX,PosY,Colonne,TexteNum,TexteTot,FonteNum,FondNum,BordNum,InterL: Integer; + TxtFlags: TFTextFlags; Total,Alpha: Boolean; Zone: TZone; SPNum: TSectPageNum); + + function BuildChaine: string; + var + NumAlpha: string; + begin + case SPNum of + PageNum: + if Total + then + Result:= Textes[TexteNum]+' '+IntToStr(NumeroPage)+' '+Textes[TexteTot]+' ' + +IntToStr(T_Section(Sections[Pred(Sections.Count)]).TotPages) + else + Result:= Textes[TexteNum]+' '+IntToStr(NumeroPage); + SectNum: + begin + if Alpha + then + NumAlpha:= ConvertitEnAlpha(NumeroSection) + else + NumAlpha:= IntToStr(NumeroSection); + if Total + then + Result:= Textes[TexteNum]+' '+NumAlpha+' '+Textes[TexteTot]+' '+IntToStr(Sections.Count) + else + Result:= Textes[TexteNum]+' '+NumAlpha; + end; + PSectNum: + begin + if Alpha + then + NumAlpha:= ConvertitEnAlpha(NumeroPageSection) + else + NumAlpha:= IntToStr(NumeroPageSection); + if Total + then + Result:= Textes[TexteNum]+' '+NumAlpha+' '+Textes[TexteTot]+' ' + +IntToStr(T_Section(Sections[Pred(NumeroSection)]).GetNbPages) + else + Result:= Textes[TexteNum]+' '+NumAlpha; + end; + end; + end; + +var + PosH,PosV,HTxt,HautTxt,IntlInt,IntLSup,IntLInf,Half,CoulTrait,EpaisTrait: Integer; + FinDeLigne,UseCurFont: Boolean; + Fnt: TfpgFont; + StylTrait: TfpgLineStyle; + Chaine: string; +begin +FinDeLigne:= False; +if FPreparation= ppPrepare +then + if FFonteCourante<> FonteNum + then + begin + FFonteCourante:= FonteNum; + UseCurFont:= False; + end + else + UseCurFont:= True; +Fnt:= T_Fonte(Fontes[FonteNum]).GetFonte; +if Interlignes.Count= 0 +then + Interligne(0,0,0); +if FInterLCourante<> InterL +then + FInterLCourante:= InterL; +IntLSup:= T_Interligne(Interlignes[FInterLCourante]).GetSup; +IntlInt:= T_Interligne(Interlignes[FInterLCourante]).GetInt; +IntLInf:= T_Interligne(Interlignes[FInterLCourante]).GetInf; +HautTxt:= TxtHeight(T_Colonne(Colonnes[Colonne]).GetTextWidth,Textes[TexteNum]+' 0 '+Textes[TexteTot]+' 0',Fnt,IntlInt)+IntLSup+IntLInf; +if (Colonne> -1) and (BordNum> -1) +then + Half:= T_TraitStyle(TraitStyles[T_Bord(Bords[BordNum]).GetStyle]).GetEpais div 2; +case FPreparation of + ppPrepare: + begin + if T_Section(Sections[Pred(NumeroSection)]).GetNbPages= 0 + then + Page; + if Colonne> -1 + then + begin + HTxt:= ALigne.GetHeight; + if HTxt< HautTxt + then + HTxt:= HautTxt; + end + else + if HTxt< Fnt.Height + then + HTxt:= Fnt.Height; + case Zone of + zEntete: + FPosRef.Y:= FMargeCourante.T+FEnTeteHeight; + zPied: + begin + FPosRef.Y:= FMargeCourante.B-HTxt; + FPiedHeight:= FPiedHeight+HTxt; + DecaleLignesPied(HTxt); + end; + end; + if PosY= lnCourante + then + PosV:= FPosRef.Y+IntLSup + else + begin + FinDeLigne:= True; + if PosY= lnFin + then + begin + PosV:= FPosRef.Y+IntLSup; + case Zone of + zEnTete: + FPosRef.Y:= FPosRef.Y+HTxt; + end; + if BordNum> -1 + then + with T_Bord(Bords[BordNum]) do + if bcBas in GetFlags + then + FPosRef.Y:= FPosRef.Y+1; + end + else + begin + PosV:= PosY; + FPosRef.Y:= PosV+IntLInf; + end; + case Zone of + zEnTete: + FEnTeteHeight:= FPosRef.Y-FMargeCourante.T; + //zPied: //////////// + // PosV:= FPosRef.Y; //////////// + end; + end; + if Colonne= -1 + then + if PosX> 0 + then + PosH:= PosX + else + begin + PosH:= T_Colonne(Colonnes[0]).GetTextPos-T_Colonne(Colonnes[0]).GetColMargin; + if (txtRight in TxtFlags) + then + if Total + then + PosH:= PosH+T_Colonne(Colonnes[0]).GetColWidth-Fnt.TextWidth(Textes[TexteNum]+' 0 '+Textes[TexteTot]+' 0 ')-T_Colonne(Colonnes[0]).GetColMargin + else + PosH:= PosH+T_Colonne(Colonnes[0]).GetColWidth-Fnt.TextWidth(Textes[TexteNum]+' 0 ')-T_Colonne(Colonnes[0]).GetColMargin; + if (txtHCenter in TxtFlags) + then + if Total + then + PosH:= PosH+(T_Colonne(Colonnes[0]).GetColWidth-Fnt.TextWidth(Textes[TexteNum]+' 0 '+Textes[TexteTot]+' 0 ')) div 2 + else + PosH:= PosH+(T_Colonne(Colonnes[0]).GetColWidth-Fnt.TextWidth(Textes[TexteNum]+' 0 ')) div 2; + end + else + if PosX> 0 + then + if (PosX< T_Colonne(Colonnes[Colonne]).GetTextPos) + or (PosX> (T_Colonne(Colonnes[Colonne]).GetTextPos+T_Colonne(Colonnes[Colonne]).GetTextWidth)) + then + PosH:= T_Colonne(Colonnes[Colonne]).GetTextPos + else + PosH:= PosX + else + begin + PosH:= T_Colonne(Colonnes[Colonne]).GetTextPos-T_Colonne(Colonnes[0]).GetColMargin; + if (txtRight in TxtFlags) + then + if Total + then + PosH:= PosH+T_Colonne(Colonnes[0]).GetColWidth-Fnt.TextWidth(Textes[TexteNum]+' 0 '+Textes[TexteTot]+' 0 ')-T_Colonne(Colonnes[0]).GetColMargin + else + PosH:= PosH+T_Colonne(Colonnes[0]).GetColWidth-Fnt.TextWidth(Textes[TexteNum]+' 0 ')-T_Colonne(Colonnes[0]).GetColMargin; + if (txtHCenter in TxtFlags) + then + if Total + then + PosH:= PosH+(T_Colonne(Colonnes[0]).GetColWidth-Fnt.TextWidth(Textes[TexteNum]+' 0 '+Textes[TexteTot]+' 0 ')) div 2 + else + PosH:= PosH+(T_Colonne(Colonnes[0]).GetColWidth-Fnt.TextWidth(Textes[TexteNum]+' 0 ')) div 2; + end; + FPosRef.X:= PosH+Fnt.TextWidth(Textes[TexteNum]+' 0 '+Textes[TexteTot]+' 0 '); + ALigne.LoadNumero(PosH,PosV,Colonne,TexteNum,TexteTot,FonteNum,HTxt,FondNum,BordNum,InterL,UseCurFont,TxtFlags,Total,Alpha,SPNum); + if FinDeLigne + then + begin + HTxt:= 0; + FinLigne(Zone); + end; + end; + ppVisualise: + with FCanevas do + begin + Chaine:= BuildChaine; + Font:= T_Fonte(Fontes[FonteNum]).GetFonte; + SetTextColor(T_Fonte(Fontes[FonteNum]).GetColor); + if Colonne> -1 + then + with T_Colonne(Colonnes[Colonne]) do + begin + if FondNum> -1 + then + SetColor(T_Fond(Fonds[FondNum]).GetColor) + else + SetColor(GetColor); + FillRectangle(GetColPos,PosY-IntLSup,GetColWidth,HautTxt); + if BordNum> -1 + then + with T_Bord(Bords[BordNum]) do + begin + SetLineStyle(T_TraitStyle(TraitStyles[GetStyle]).GetEpais,T_TraitStyle(TraitStyles[GetStyle]).GetStyle); + SetColor(T_TraitStyle(TraitStyles[GetStyle]).GetColor); + if bcGauche in GetFlags + then + DrawLine(GetColPos+Half,PosY-IntLSup,GetColPos+Half,PosY-IntLSup+HautTxt); + if bcDroite in GetFlags + then + DrawLine(GetColPos+GetColWidth-Half,PosY-IntLSup,GetColPos+GetColWidth-Half,PosY-IntLSup+HautTxt); + if bcHaut in GetFlags + then + DrawLine(GetColPos,PosY-IntLSup+Half,GetColPos+GetColWidth,PosY-IntLSup+Half); + if bcBas in GetFlags + then + DrawLine(GetColPos,PosY-IntLSup+HautTxt-Succ(Half),GetColPos+GetColWidth,PosY-IntLSup+HautTxt-Succ(Half)); + end; + DrawText(GetTextPos,PosY,GetTextWidth,0,Chaine,TxtFlags,IntlInt); + end + else + DrawText(PosX,PosY,Chaine,TxtFlags); + end; + ppFichierPDF: + begin + Chaine:= BuildChaine; + if Colonne> -1 + then + with T_Colonne(Colonnes[Colonne]) do + begin + if (GetColor<> clWhite) or (FondNum> -1) + then + begin + PdfRect:= TPdfRect.Create; + with PdfRect do + begin + PageId:= NumeroPage; + FGauche:= GetColPos; + FBas:= FPapier.H-PosY+IntLSup-HautTxt; + FHaut:= HautTxt; + FLarg:= GetColWidth; + if FondNum> -1 + then + FColor:= T_Fond(Fonds[FondNum]).GetColor + else + FColor:= GetColor; + FFill:= True; + FStroke:= False; + end; + PdfPage.Add(PdfRect); + end; + if BordNum> -1 + then + with T_Bord(Bords[BordNum]) do + begin + StylTrait:= T_TraitStyle(TraitStyles[T_Bord(Bords[BordNum]).GetStyle]).GetStyle; + CoulTrait:= T_TraitStyle(TraitStyles[T_Bord(Bords[BordNum]).GetStyle]).GetColor; + EpaisTrait:= T_TraitStyle(TraitStyles[T_Bord(Bords[BordNum]).GetStyle]).GetEpais; + if bcGauche in GetFlags + then + begin + PdfLine:= TPdfLine.Create; + with PdfLine do + begin + PageId:= NumeroPage; + FStartX:= GetColPos; + FStartY:= FPapier.H-PosY+IntLSup; + FEndX:= GetColPos; + FEndY:= FPapier.H-PosY+IntLSup-HautTxt; + FStyle:= StylTrait; + FColor:= CoulTrait; + FEpais:= EpaisTrait; + end; + PdfPage.Add(PdfLine); + end; + if bcDroite in GetFlags + then + begin + PdfLine:= TPdfLine.Create; + with PdfLine do + begin + PageId:= NumeroPage; + FStartX:= GetColPos+GetColWidth; + FStartY:= FPapier.H-PosY+IntLSup; + FEndX:= GetColPos+GetColWidth; + FEndY:= FPapier.H-PosY+IntLSup-HautTxt; + FStyle:= StylTrait; + FColor:= CoulTrait; + FEpais:= EpaisTrait; + end; + PdfPage.Add(PdfLine); + end; + if bcHaut in GetFlags + then + begin + PdfLine:= TPdfLine.Create; + with PdfLine do + begin + PageId:= NumeroPage; + FStartX:= GetColPos; + FStartY:= FPapier.H-PosY+IntLSup; + FEndX:= GetColPos+GetColWidth; + FEndY:= FPapier.H-PosY+IntLSup; + FStyle:= StylTrait; + FColor:= CoulTrait; + FEpais:= EpaisTrait; + end; + PdfPage.Add(PdfLine); + end; + if bcBas in GetFlags + then + begin + PdfLine:= TPdfLine.Create; + with PdfLine do + begin + PageId:= NumeroPage; + FStartX:= GetColPos; + FStartY:= FPapier.H-PosY+IntLSup-HautTxt; + FEndX:= GetColPos+GetColWidth; + FEndY:= FPapier.H-PosY+IntLSup-HautTxt; + FStyle:= StylTrait; + FColor:= CoulTrait; + FEpais:= EpaisTrait; + end; + PdfPage.Add(PdfLine); + end; + end; + PdfTexte:= TPdfTexte.Create; + with PdfTexte do + begin + PageId:= NumeroPage; + FFont:= FonteNum; + FSize:= T_Fonte(Fontes[FonteNum]).GetSize; + FColor:= T_Fonte(Fontes[FonteNum]).GetColor; + TextPosX:= GetTextPos; + if (txtRight in TxtFlags) + then + TextPosX:= GetColPos+GetColWidth-GetColMargin-Fnt.TextWidth(Chaine); + if (txtHCenter in TxtFlags) + then + TextPosX:= GetTextPos+(GetColWidth-Fnt.TextWidth(Chaine)) div 2; + TextPosY:= FPapier.H-PosY-Fnt.Ascent; + TextLarg:= GetColWidth; + Ecriture:= Chaine; + end; + PdfPage.Add(PdfTexte); + end + else + begin + PdfTexte:= TPdfTexte.Create; + with PdfTexte do + begin + PageId:= NumeroPage; + FFont:= FonteNum; + FSize:= T_Fonte(Fontes[FonteNum]).GetSize; + FColor:= T_Fonte(Fontes[FonteNum]).GetColor; + FPosX:= PosX; + FPosY:= PosY-Fnt.Ascent; + FLarg:= FPapier.W; + FText:= Chaine; + end; + PdfPage.Add(PdfTexte); + end; + end; + end; +end; + +procedure T_Imprime.InsereEspace(PosY,Colonne,EspHeight,FondNum: Integer; Zone: TZone); +var + PosV: Integer; +begin +if PosY> -1 +then + PosV:= PosY +else + PosV:= FPosRef.Y; +case FPreparation of + ppPrepare: + begin + case Zone of + zEnTete: + begin + FPosRef.Y:= FMargeCourante.T+FEnTeteHeight; + FPosRef.Y:= FPosRef.Y+EspHeight; + FEnTeteHeight:= FPosRef.Y-FMargeCourante.T; + T_Section(Sections[Pred(NumeroSection)]).LoadEspaceEnTete(PosV,Colonne,EspHeight,FondNum); + end; + zPage: + begin + FPosRef.Y:= FMargeCourante.T+FEnTeteHeight+FPageHeight; + if FPosRef.Y+EspHeight> FMargeCourante.B-FPiedHeight + then + begin + FPosRef.Y:= FMargeCourante.T+FEnTeteHeight; + Page; + end + else + FPosRef.Y:= FPosRef.Y+EspHeight; + FPageHeight:= FPosRef.Y-FEnTeteHeight-FMargeCourante.T; + T_Section(Sections[Pred(NumeroSection)]).LoadEspacePage(PosV,Colonne,EspHeight,FondNum); + end; + zPied: + begin + FPosRef.Y:= FMargeCourante.B-EspHeight; + FPiedHeight:= FPiedHeight+EspHeight; + PosV:= FPosRef.Y; + DecaleLignesPied(EspHeight); + T_Section(Sections[Pred(NumeroSection)]).LoadEspacePied(PosV,Colonne,EspHeight,FondNum); + end; + end; + FinLigne(Zone); + end; + ppVisualise: + with FCanevas,T_Colonne(Colonnes[Colonne]) do + begin + if FondNum> -1 + then + SetColor(T_Fond(Fonds[FondNum]).GetColor) + else + SetColor(GetColor); + FillRectangle(GetColPos,PosV,GetColWidth,EspHeight); + end; + ppFichierPDF: + begin + if Colonne> -1 + then + with T_Colonne(Colonnes[Colonne]) do + begin + if (GetColor<> clWhite) or (FondNum> -1) + then + begin + PdfRect:= TPdfRect.Create; + with PdfRect do + begin + PageId:= NumeroPage; + FGauche:= GetColPos; + FBas:= FPapier.H-PosY-EspHeight; + FHaut:= EspHeight; + FLarg:= GetColWidth; + if FondNum> -1 + then + FColor:= T_Fond(Fonds[FondNum]).GetColor + else + FColor:= GetColor; + FFill:= True; + FStroke:= False; + end; + PdfPage.Add(PdfRect); + end; + end; + end; + end; +end; + +procedure T_Imprime.FinLigne(Zone: TZone); +begin +case Zone of + zEnTete: + T_Section(Sections[Pred(NumeroSection)]).LoadCmdEnTete; + zPage: + if FGroupe + then + T_Section(Sections[Pred(NumeroSection)]).LoadCmdGroupe + else + T_Section(Sections[Pred(NumeroSection)]).LoadCmdPage; + zPied: + T_Section(Sections[Pred(NumeroSection)]).LoadCmdPied; + end; +end; + +procedure T_Imprime.TraceCadre(StTrait: Integer; Zone: TZone); +var + Half: Integer; +begin +case FPreparation of + ppPrepare: + T_Section(Sections[Pred(NumeroSection)]).LoadCadre(StTrait,Zone); + ppVisualise: + with FCanevas do + begin + with T_TraitStyle(TraitStyles[StTrait]) do + begin + SetLineStyle(GetEpais,GetStyle); + Half:= GetEpais div 2; + SetColor(GetColor); + end; + with FMargeCourante do + case Zone of + zEnTete: + begin + DrawLine(L+Half,T,L+Half,T+FEnTeteHeight); // gauche + DrawLine(R-Half,T,R-Half,T+FEnTeteHeight); // droite + DrawLine(L,T+Half,R,T+Half); // haute + DrawLine(L,T+FEnTeteHeight-Half,R,T+FEnTeteHeight-Half); // basse + end; + zPage: + begin + DrawLine(L+Half,T+FEnTeteHeight,L+Half,B-FPiedHeight); // gauche + DrawLine(R-Half,T+FEnTeteHeight,R-Half,B-FPiedHeight); // droite + DrawLine(L,T+FEnTeteHeight+Half,R,T+FEnTeteHeight+Half); // haute + DrawLine(L,B-FPiedHeight-Half,R,B-FPiedHeight-Half); // basse + end; + zPied: + begin + DrawLine(L+Half,B-FPiedHeight,L+Half,B); // gauche + DrawLine(R-Half,B-FPiedHeight,R-Half,B); // droite + DrawLine(L,B-FPiedHeight+Half,R,B-FPiedHeight+Half); // haute + DrawLine(L,B-Half,R,B-Half); // basse + end; + zMarges: + begin + DrawLine(L+Half,T,L+Half,B-Succ(Half)); // gauche + DrawLine(R-Half,T,R-Half,B-Succ(Half)); // droite + DrawLine(L,T+Half,R,T+Half); // haute + DrawLine(L,B-Half,R,B-Half); // basse + end; + end; + end; + ppFichierPDF: + begin + PdfRect:= TPdfRect.Create; + with PdfRect do + begin + PageId:= NumeroPage; + with T_TraitStyle(TraitStyles[StTrait]) do + begin + FEpais:= GetEpais; + FColor:= GetColor; + FLineStyle:= GetStyle; + end; + with FMargeCourante do + case Zone of + zEnTete: + begin + FGauche:= L; + FBas:= FPapier.H-T-FEnTeteHeight; + FHaut:= FEnTeteHeight; + FLarg:= R-L; + end; + zPage: + begin + FGauche:= L; + FBas:= FPapier.H-B-FPiedHeight; + FHaut:= FPapier.H-T-FEnTeteHeight-B-FPiedHeight; + FLarg:= R-L; + end; + zPied: + begin + FGauche:= L; + FBas:= FPapier.H-B; + FHaut:= FPiedHeight; + FLarg:= R-L; + end; + zMarges: + begin + FGauche:= L; + FBas:= FPapier.H-B; + FHaut:= B-T; + FLarg:= R-L; + end; + end; + FFill:= False; + FStroke:= True; + PdfPage.Add(PdfRect); + end; + end; + end; +end; + +procedure T_Imprime.TraceTrait(XDebut,YDebut,XFin,YFin,StTrait: Integer); +begin +case FPreparation of + ppPrepare: + T_Section(Sections[Pred(NumeroSection)]).LoadTrait(XDebut,YDebut,ColDefaut,XFin,YFin,StTrait); + ppVisualise: + begin + with FCanevas do + begin + with T_TraitStyle(TraitStyles[StTrait]) do + begin + SetLineStyle(GetEpais,GetStyle); + SetColor(GetColor); + end; + DrawLine(XDebut,YDebut,XFin,YFin); + end; + end; + ppFichierPdf: + begin + PdfLine:= TPdfLine.Create; + with PdfLine do + begin + PageId:= NumeroPage; + FStartX:= XDebut; + FStartY:= FPapier.H-YDebut; + FEndX:= XFin; + FEndY:= FPapier.H-YFin; + FStyle:= T_TraitStyle(TraitStyles[StTrait]).GetStyle;; + FColor:= T_TraitStyle(TraitStyles[StTrait]).GetColor; + FEpais:= T_TraitStyle(TraitStyles[StTrait]).GetEpais; + end; + PdfPage.Add(PdfLine); + end; + end; +end; + +{ Commandes publiques } + +constructor T_Imprime.Create; +begin +inherited Create; +Sections:= TList.Create; +Colonnes:= TList.Create; +Fontes:= TList.Create; +Interlignes:= TList.Create; +Fonds:= TList.Create; +TraitStyles:= TList.Create; +Bords:= TList.Create; +Textes:= TStringList.Create; +ALigne:= T_Ligne.Create; +PdfPage:= TList.Create; +OldDecSeparator:= DecimalSeparator; +DecimalSeparator:= '.'; +end; + +destructor T_Imprime.Destroy; +var + Cpt: Integer; +begin +DecimalSeparator:= OldDecSeparator; +if Sections.Count> 0 +then + for Cpt:= 0 to Pred(Sections.Count) do + LiberePages(Sections[Cpt]); +Sections.Free; +if Colonnes.Count> 0 +then + for Cpt:= 0 to Pred(Colonnes.Count) do + T_Colonne(Colonnes[Cpt]).Free; +Colonnes.Free; +if Fontes.Count> 0 +then + for Cpt:= 0 to Pred(Fontes.Count) do + T_Fonte(Fontes[Cpt]).Free; +Fontes.Free; +if Interlignes.Count> 0 +then + for Cpt:= 0 to Pred(Interlignes.Count) do + T_Interligne(Interlignes[Cpt]).Free; +Interlignes.Free; +if Fonds.Count> 0 +then + for Cpt:= 0 to Pred(Fonds.Count) do + T_Fond(Fonds[Cpt]).Free; +Fonds.Free; +if TraitStyles.Count> 0 +then + for Cpt:= 0 to Pred(TraitStyles.Count) do + T_TraitStyle(TraitStyles[Cpt]).Free; +TraitStyles.Free; +if Bords.Count> 0 +then + for Cpt:= 0 to Pred(Bords.Count) do + T_Bord(Bords[Cpt]).Free; +Bords.Free; +Textes.Free; +ALigne.Free; +inherited; +end; + +procedure T_Imprime.Debut(IniOriente: TOrient= oPortrait; IniTypePapier: TTypePapier= A4; + IniMesure: TMesure= msMM; IniVersion: Char= 'F'; IniVisu: Boolean= True); +begin +FVersion:= IniVersion; +FOrientation:= IniOriente; +FTypepapier:= IniTypePapier; +FMesure:= IniMesure; +FPreparation:= ppPrepare; +FVisualisation:= IniVisu; +PrepareVisu; +FFonteCourante:= -1; +FInterLCourante:= -1; +FGroupe:= False; +end; + +procedure T_Imprime.Fin; +var + Cpt: Integer; +begin +FPreparation:= ppFichierPDF; +if Sections.Count> 0 +then + for Cpt:= 1 to Sections.Count do + begin + NumeroSection:= Cpt; + if T_Section(Sections[Pred(NumeroSection)]).TotPages> 0 + then + begin + NumeroPageSection:= 1; + NumeroPage:= 1; + end; + end +else + Exit; +for Cpt:= 1 to T_Section(Sections[Pred(NumeroSection)]).TotPages do + ImprimePage(Cpt); +if FVisualisation +then + begin + FPreparation:= ppVisualise; + try + ImprimeDocument; + if FVisualisation + then + F_Visu.ShowModal; + finally + F_Visu.Free; + end; + end; +//Libere; +end; + +procedure T_Imprime.ImprimeDocument; +begin +if FVisualisation +then + FCanevas:= Bv_Visu.Canvas; +end; + +procedure T_Imprime.Visualisation; +begin +FVisualisation:= not FVisualisation; +if FVisualisation +then + FCanevas:= Bv_Visu.Canvas; +end; + +procedure T_Imprime.Section(MgGauche,MgDroite,MgHaute,MgBasse: Single; Retrait: Single); +var + CMargin: Integer; +begin +if FPreparation= ppPrepare +then + begin + with FMargeCourante,FPapier do + begin + if Dim2Pixels(MgGauche)> Imprimable.L + then + L:= Dim2Pixels(MgGauche) + else + L:= Imprimable.L; + if (W-Dim2Pixels(MgDroite))< Imprimable.R + then + R:= W-Dim2Pixels(MgDroite) + else + R:= Imprimable.R; + if Dim2Pixels(MgHaute)> Imprimable.T + then + T:= Dim2Pixels(MgHaute) + else + T:= Imprimable.T; + if (H-Dim2Pixels(MgBasse))< Imprimable.B + then + B:= H-Dim2Pixels(MgBasse) + else + B:= Imprimable.B; + end; + FPosRef.X:= FMargeCourante.L; + FEnTeteHeight:= 0; + FPageHeight:= 0; + FPiedHeight:= 0; + NumeroSection:= NumeroSection+1; + ASection:= T_Section.Create(FMargeCourante,NumeroSection); + Sections.Add(ASection); + if Sections.Count= 1 + then + begin + CMargin:= Dim2Pixels(Retrait); + AColonne:= T_Colonne.Create(FMargeCourante.L,FMargeCourante.R-FMargeCourante.L,CMargin,clWhite); + Colonnes.Add(AColonne); + end; + end; +end; + +procedure T_Imprime.Page; +begin +if FPreparation= ppPrepare +then + begin + NumeroPage:= NumeroPage+1; + T_Section(Sections[Pred(Sections.Count)]).LoadPage(NumeroPage); + FPosRef.Y:= FMargeCourante.T+FEnTeteHeight; + FPageHeight:= 0; + end; +end; + +function T_Imprime.Fond(FdColor: TfpgColor): Integer; +begin +AFond:= T_Fond.Create(FdColor); +Result:= Fonds.Add(AFond); +end; + +function T_Imprime.Fonte(FtNom: string; FtColor: TfpgColor): Integer; +begin +AFonte:= T_Fonte.Create(FtNom,FtColor); +Result:= Fontes.Add(AFonte); +end; + +function T_Imprime.StyleTrait(StEpais: Integer; StColor: Tfpgcolor; StStyle: TfpgLineStyle): Integer; +begin +ATraitStyle:= T_TraitStyle.Create(StEpais,StColor,StStyle); +Result:= TraitStyles.Add(ATraitStyle); +end; + +function T_Imprime.Bordure(BdFlags: TFBordFlags; BdStyle: Integer): Integer; +begin +ABord:= T_Bord.Create(BdFlags,BdStyle); +Result:= Bords.Add(ABord); +end; + +function T_Imprime.Colonne(ClnPos,ClnWidth: Single; ClnMargin: Single= 0; ClnColor: TfpgColor= clWhite): Integer; +var + CPos,CWidth,CMargin: Integer; +begin +CPos:= Dim2Pixels(ClnPos); +with T_Section(Sections[Pred(NumeroSection)]) do + begin + if CPos< GetMarges.L + then + CPos:= GetMarges.L; + CWidth:= Dim2Pixels(ClnWidth); + if CWidth> (GetMarges.R-GetMarges.L) + then + CWidth:= GetMarges.R-GetMarges.L; + end; +CMargin:= Dim2Pixels(ClnMargin); +AColonne:= T_Colonne.Create(CPos,CWidth,CMargin,ClnColor); +Result:= Colonnes.Add(AColonne); +end; + +procedure T_Imprime.EcritEnTete(Horiz,Verti: Single; Texte: string; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); +var + X,Y,RefTexte: Integer; + Flags: TFTextFlags; +begin +Flags:= []; +if Horiz< 0 +then + begin + X:= Round(Horiz); + case X of + cnLeft: + Include(Flags,txtLeft); + cnCenter: + Include(Flags,txtHCenter); + cnRight: + Include(Flags,txtRight); + end; + end +else + X:= Dim2Pixels(Horiz); +if Verti< 0 +then + Y:= Round(Verti) +else + Y:= Dim2Pixels(Verti); +RefTexte:= Textes.IndexOf(Texte); +if RefTexte= -1 +then + RefTexte:= Textes.Add(Texte); +EcritLigne(X,Y,ColNum,RefTexte,FonteNum,CoulFdNum,BordNum,InterNum,Flags,ZEnTete); +end; + +procedure T_Imprime.EcritPage(Horiz,Verti: Single; Texte: string; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); +var + X,Y,RefTexte: Integer; + Flags: TFTextFlags; +begin +Flags:= []; +if Horiz< 0 +then + begin + X:= Round(Horiz); + Include(Flags,txtWrap); + case X of + cnLeft: + Include(Flags,txtLeft); + cnCenter: + Include(Flags,txtHCenter); + cnRight: + Include(Flags,txtRight); + end; + end +else + X:= Dim2Pixels(Horiz); +if Verti< 0 +then + Y:= Round(Verti) +else + Y:= Dim2Pixels(Verti); +RefTexte:= Textes.IndexOf(Texte); +if RefTexte= -1 +then + RefTexte:= Textes.Add(Texte); +EcritLigne(X,Y,ColNum,RefTexte,FonteNum,CoulFdNum,BordNum,InterNum,Flags,ZPage); +end; + +procedure T_Imprime.EcritPied(Horiz,Verti: Single; Texte: string; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); +var + X,Y,RefTexte: Integer; + Flags: TFTextFlags; +begin +Flags:= []; +if Horiz< 0 +then + begin + X:= Round(Horiz); + case X of + cnLeft: + Include(Flags,txtLeft); + cnCenter: + Include(Flags,txtHCenter); + cnRight: + Include(Flags,txtRight); + end; + end +else + X:= Dim2Pixels(Horiz); +if Verti< 0 +then + Y:= Round(Verti) +else + Y:= Dim2Pixels(Verti); +RefTexte:= Textes.IndexOf(Texte); +if RefTexte= -1 +then + RefTexte:= Textes.Add(Texte); +EcritLigne(X,Y,ColNum,RefTexte,FonteNum,CoulFdNum,BordNum,InterNum,Flags,ZPied); +end; + +procedure T_Imprime.NumSectionEnTete(Horiz,Verti: Single; TexteSect: string= ''; TexteTot: string= ''; + Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); +var + X,Y,RefTextePage,RefTexteTot: Integer; + Flags: TFTextFlags; +begin +Flags:= []; +if Horiz< 0 +then + begin + X:= Round(Horiz); + case X of + cnLeft: + Include(Flags,txtLeft); + cnCenter: + Include(Flags,txtHCenter); + cnRight: + Include(Flags,txtRight); + end; + end +else + X:= Dim2Pixels(Horiz); +if Verti< 0 +then + Y:= Round(Verti) +else + Y:= Dim2Pixels(Verti); +RefTextePage:= Textes.IndexOf(TexteSect); +if RefTextePage= -1 +then + RefTextePage:= Textes.Add(TexteSect); +RefTexteTot:= Textes.IndexOf(TexteTot); +if RefTexteTot= -1 +then + RefTexteTot:= Textes.Add(TexteTot); +EcritNum(X,Y,ColNum,RefTextePage,RefTexteTot,FonteNum,CoulFdNum,BordNum,InterNum,Flags,Total,Alpha,ZEnTete,SectNum); +end; + +procedure T_Imprime.NumSectionPied(Horiz,Verti: Single; TexteSect: string= ''; TexteTot: string= ''; + Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0;CoulFdNum: Integer= -1; BordNum: Integer= -1); +var + X,Y,RefTextePage,RefTexteTot: Integer; + Flags: TFTextFlags; +begin +Flags:= []; +if Horiz< 0 +then + begin + X:= Round(Horiz); + case X of + cnLeft: + Include(Flags,txtLeft); + cnCenter: + Include(Flags,txtHCenter); + cnRight: + Include(Flags,txtRight); + end; + end +else + X:= Dim2Pixels(Horiz); +if Verti< 0 +then + Y:= Round(Verti) +else + Y:= Dim2Pixels(Verti); +RefTextePage:= Textes.IndexOf(TexteSect); +if RefTextePage= -1 +then + RefTextePage:= Textes.Add(TexteSect); +RefTexteTot:= Textes.IndexOf(TexteTot); +if RefTexteTot= -1 +then + RefTexteTot:= Textes.Add(TexteTot); +EcritNum(X,Y,ColNum,RefTextePage,RefTexteTot,FonteNum,CoulFdNum,BordNum,InterNum,Flags,Total,Alpha,ZPied,SectNum); +end; + +procedure T_Imprime.NumPageEnTete(Horiz,Verti: Single; TextePage: string= ''; TexteTotal: string= ''; + Total: Boolean= False; ColNum: Integer= 0; FonteNum: Integer= 0; InterNum: Integer= 0; + CoulFdNum: Integer= -1; BordNum: Integer= -1); +var + X,Y,RefTextePage,RefTexteTot: Integer; + Flags: TFTextFlags; +begin +Flags:= []; +if Horiz< 0 +then + begin + X:= Round(Horiz); + case X of + cnLeft: + Include(Flags,txtLeft); + cnCenter: + Include(Flags,txtHCenter); + cnRight: + Include(Flags,txtRight); + end; + end +else + X:= Dim2Pixels(Horiz); +if Verti< 0 +then + Y:= Round(Verti) +else + Y:= Dim2Pixels(Verti); +RefTextePage:= Textes.IndexOf(TextePage); +if RefTextePage= -1 +then + RefTextePage:= Textes.Add(TextePage); +RefTexteTot:= Textes.IndexOf(TexteTotal); +if RefTexteTot= -1 +then + RefTexteTot:= Textes.Add(TexteTotal); +EcritNum(X,Y,ColNum,RefTextePage,RefTexteTot,FonteNum,CoulFdNum,BordNum,InterNum,Flags,Total,False,ZEnTete,PageNum); +end; + +procedure T_Imprime.NumPagePied(Horiz,Verti: Single; TextePage: string= ''; TexteTotal: string= ''; + Total: Boolean= False; ColNum: Integer= 0; FonteNum: Integer= 0; InterNum: Integer= 0; + CoulFdNum: Integer= -1; BordNum: Integer= -1); +var + X,Y,RefTextePage,RefTexteTot: Integer; + Flags: TFTextFlags; +begin +Flags:= []; +if Horiz< 0 +then + begin + X:= Round(Horiz); + case X of + cnLeft: + Include(Flags,txtLeft); + cnCenter: + Include(Flags,txtHCenter); + cnRight: + Include(Flags,txtRight); + end; + end +else + X:= Dim2Pixels(Horiz); +if Verti< 0 +then + Y:= Round(Verti) +else + Y:= Dim2Pixels(Verti); +RefTextePage:= Textes.IndexOf(TextePage); +if RefTextePage= -1 +then + RefTextePage:= Textes.Add(TextePage); +RefTexteTot:= Textes.IndexOf(TexteTotal); +if RefTexteTot= -1 +then + RefTexteTot:= Textes.Add(TexteTotal); +EcritNum(X,Y,ColNum,RefTextePage,RefTexteTot,FonteNum,CoulFdNum,BordNum,InterNum,Flags,Total,False,ZPied,PageNum); +end; + +procedure T_Imprime.NumPageSectionEnTete(Horiz,Verti: Single; TexteSect: string= ''; TexteTot: string= ''; + Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); +var + X,Y,RefTextePage,RefTexteTot: Integer; + Flags: TFTextFlags; +begin +Flags:= []; +if Horiz< 0 +then + begin + X:= Round(Horiz); + case X of + cnLeft: + Include(Flags,txtLeft); + cnCenter: + Include(Flags,txtHCenter); + cnRight: + Include(Flags,txtRight); + end; + end +else + X:= Dim2Pixels(Horiz); +if Verti< 0 +then + Y:= Round(Verti) +else + Y:= Dim2Pixels(Verti); +RefTextePage:= Textes.IndexOf(TexteSect); +if RefTextePage= -1 +then + RefTextePage:= Textes.Add(TexteSect); +RefTexteTot:= Textes.IndexOf(TexteTot); +if RefTexteTot= -1 +then + RefTexteTot:= Textes.Add(TexteTot); +EcritNum(X,Y,ColNum,RefTextePage,RefTexteTot,FonteNum,CoulFdNum,BordNum,InterNum,Flags,Total,Alpha,ZEnTete,PSectNum); +end; + +procedure T_Imprime.NumPageSectionPied(Horiz,Verti: Single; TexteSect: string= ''; TexteTot: string= ''; + Total: Boolean= False; Alpha: Boolean= False; ColNum: Integer= 0; FonteNum: Integer= 0; + InterNum: Integer= 0; CoulFdNum: Integer= -1; BordNum: Integer= -1); +var + X,Y,RefTextePage,RefTexteTot: Integer; + Flags: TFTextFlags; +begin +Flags:= []; +if Horiz< 0 +then + begin + X:= Round(Horiz); + case X of + cnLeft: + Include(Flags,txtLeft); + cnCenter: + Include(Flags,txtHCenter); + cnRight: + Include(Flags,txtRight); + end; + end +else + X:= Dim2Pixels(Horiz); +if Verti< 0 +then + Y:= Round(Verti) +else + Y:= Dim2Pixels(Verti); +RefTextePage:= Textes.IndexOf(TexteSect); +if RefTextePage= -1 +then + RefTextePage:= Textes.Add(TexteSect); +RefTexteTot:= Textes.IndexOf(TexteTot); +if RefTexteTot= -1 +then + RefTexteTot:= Textes.Add(TexteTot); +EcritNum(X,Y,ColNum,RefTextePage,RefTexteTot,FonteNum,CoulFdNum,BordNum,InterNum,Flags,Total,Alpha,ZPied,PSectNum); +end; + +procedure T_Imprime.EspaceEnTete(Verti: Single; ColNum: Integer=0; CoulFdNum: Integer= -1); +var + H: Integer; +begin +H:= Dim2Pixels(Verti); +InsereEspace(-1,ColNum,H,CoulFdNum,zEntete); +end; + +procedure T_Imprime.EspacePage(Verti: Single; ColNum: Integer=0; CoulFdNum: Integer= -1); +var + H: Integer; +begin +H:= Dim2Pixels(Verti); +InsereEspace(-1,ColNum,H,CoulFdNum,zPage); +end; + +procedure T_Imprime.EspacePied(Verti: Single; ColNum: Integer=0; CoulFdNum: Integer= -1); +var + H: Integer; +begin +H:= Dim2Pixels(Verti); +InsereEspace(-1,ColNum,H,CoulFdNum,zPied); +end; + +function T_Imprime.Interligne(ItlSup,ItlInt,ItlInf: Single): Integer; +var + Sup,Int,Inf: Integer; +begin +if ItlSup> 0 +then + Sup:= Dim2Pixels(ItlSup) +else + Sup:= 0; +if ItlInt> 0 +then + Int:= Dim2Pixels(ItlInt) +else + Int:= 0; +if ItlInf> 0 +then + Inf:= Dim2Pixels(ItlInf) +else + Inf:= 0; +AInterligne:= T_Interligne.Create(Sup,Int,Inf); +Result:= Interlignes.Add(AInterligne); +end; + +procedure T_Imprime.Groupe(SautPage: Boolean= False); +begin +AGroupe:= T_Groupe.Create; +FGroupe:= True; +if SautPage +then + Page; +end; + +procedure T_Imprime.FinGroupe(SautPage: Boolean= False); +var + Cpt: Integer; +begin +T_Section(Sections[Pred(Sections.Count)]).LoadCmdGroupeToPage; +FGroupe:= False; +AGroupe.Free; +if SautPage +then + Page; +end; + +procedure T_Imprime.ColorColChange(ColNum: Integer; ColColor: TfpgColor); +begin +T_Colonne(Colonnes[ColNum]).SetColColor(ColColor); +end; + +procedure T_Imprime.CadreMarges(AStyle: Integer); +begin +TraceCadre(AStyle,zMarges); +end; + +procedure T_Imprime.CadreEnTete(AStyle: Integer); +begin +TraceCadre(AStyle,zEntete); +end; + +procedure T_Imprime.CadrePage(AStyle: Integer); +begin +TraceCadre(AStyle,zPage); +end; + +procedure T_Imprime.CadrePied(AStyle: Integer); +begin +TraceCadre(AStyle,zPied); +end; + +procedure T_Imprime.TraitPage(XDebut,YDebut,XFin,YFin: Single; AStyle: Integer); +var + XDeb,YDeb,XEnd,YEnd: Integer; +begin +XDeb:= Dim2Pixels(XDebut); +YDeb:= Dim2Pixels(YDebut); +XEnd:= Dim2Pixels(XFin); +YEnd:= Dim2Pixels(YFin); +TraceTrait(XDeb,YDeb,XEnd,YEnd,AStyle); +end; + +end. + diff --git a/extras/contributed/report_tool/reportengine/u_pdf.pas b/extras/contributed/report_tool/reportengine/u_pdf.pas new file mode 100644 index 00000000..72d12ac6 --- /dev/null +++ b/extras/contributed/report_tool/reportengine/u_pdf.pas @@ -0,0 +1,1281 @@ +{ + << 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, + fpg_main, fpg_base; + +type + TPdfObjet = class(TObject) + private + protected + public + constructor Create; virtual; + destructor Destroy; override; + end; + + TPdfBoolean = class(TPdfObjet) + private + FValue: Boolean; + protected + procedure EcritBoolean(const AFlux: TStream); + public + constructor CreateBoolean(const AValue: Boolean); + destructor Destroy; override; + end; + + TPdfInteger = class(TPdfObjet) + private + FValue: Integer; + protected + procedure EcritInteger(const AFlux: TStream); + procedure IncrementeInteger; + public + constructor CreateInteger(const AValue: Integer); + destructor Destroy; override; + end; + + TPdfReference = class(TPdfObjet) + private + FValue: Integer; + protected + procedure EcritReference(const AFlux: TStream); + public + constructor CreateReference(const AValue: Integer); + destructor Destroy; override; + end; + + TPdfName = class(TPdfObjet) + private + FValue: string; + protected + procedure EcritName(const AFlux: TStream); + public + constructor CreateName(const AValue: string); + destructor Destroy; override; + end; + + TPdfString = class(TPdfObjet) + private + FValue: string; + protected + procedure EcritString(const AFlux: TStream); + public + constructor CreateString(const AValue: string); + destructor Destroy; override; + end; + + TPdfArray = class(TPdfObjet) + private + FArray: TList; + protected + procedure EcritArray(const AFlux: TStream); + procedure AddItem(const AValue: TPdfObjet); + public + constructor CreateArray; + destructor Destroy; override; + end; + + TPdfStream = class(TPdfObjet) + private + FStream: TList; + protected + procedure EcritStream(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 EcritFonte(const AFlux: TStream); + public + constructor CreateFonte(const AFont: Integer; const ASize: string); + destructor Destroy; override; + end; + + TPdfText = class(TPdfObjet) + private + FTxtPosX: Integer; + FTxtPosY: Integer; + FTxtText: TPdfString; + protected + procedure EcritText(const AFlux: TStream); + public + constructor CreateText(const APosX,APosY: Integer; const AText: string); + destructor Destroy; override; + end; + + TPdfLigne = class(TPdfObjet) + private + FEpais: Integer; + FStaX: Integer; + FStaY: Integer; + FEndX: Integer; + FEndY: Integer; + protected + procedure EcritLigne(const AFlux: TStream); + public + constructor CreateLigne(const AEpais,AStaX,AStaY,AEndX,AEndY: Integer); + destructor Destroy; override; + end; + + TPdfRectangle = class(TPdfObjet) + private + FEpais: Integer; + FRecX: Integer; + FRecY: Integer; + FRecW: Integer; + FRecH: Integer; + FFill: Boolean; + FStroke: Boolean; + protected + procedure EcritRectangle(const AFlux: TStream); + public + constructor CreateRectangle(const AEpais,APosX,APosY,AWidth,AHeight: Integer; const AFill,AStroke: Boolean); + destructor Destroy; override; + end; + + TPdfLineStyle = class(TPdfObjet) + private + FDash: TfpgLineStyle; + FPhase: Integer; + protected + procedure EcritLineStyle(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 EcritColor(const AFlux: TStream); + public + constructor CreateColor(const AStroke: Boolean; Couleur: LongInt); + destructor Destroy; override; + end; + + TPdfDicElement = class(TObject) + private + FKey: TPdfName; + FValue: TPdfObjet; + protected + procedure EcritDicElement(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 EcritDictionary(AFlux: TStream); + public + constructor CreateDictionary; + destructor Destroy; override; + end; + + TPdfXRef = class(TObject) + private + FOffset: Integer; + FObjet: TPdfDictionary; + FStream: TPdfStream; + protected + procedure EcritXRef(const AFlux: TStream); + public + constructor CreateXRef; + destructor Destroy; override; + property Offset: Integer read FOffset write FOffset; + end; + + TPdfDocument = class(TObject) + private + FXRefObjets: TList; // list of TPdfXRef + protected + function ElementParNom(const AValue: string): Integer; + procedure EcritXRefTable(const AFlux: TStream); + procedure EcritObjet(const AObjet: Integer; const AFlux: TStream); + procedure CreateRefTable; + procedure CreateTrailer; + procedure CreateCatalog; + procedure CreateInfo; + procedure CreatePreferences; + function CreatePages(Parent: Integer): Integer; + procedure CreatePage(Parent: Integer); + procedure CreateFont(NomFonte: string; NumFonte: Integer); + function CreateContents: Integer; + procedure CreateStream(NumeroPage,PageNum: Integer); + public + constructor CreateDocument; + destructor Destroy; override; + procedure EcritDocument(const AFlux: TStream); + end; + +const + CRLF= #13#10; + PDF_VERSION= '%PDF-1.3'; + PDF_FILE_END= '%%EOF'; + PDF_MAX_GEN_NUM= 65535; + PDF_UNICODE_HEADER = 'FEFF001B%s001B'; + PDF_LANG_STRING = 'fr'; + +var + Document: TPdfDocument; + OldDecSeparator: Char; + +implementation + +uses + U_Imprime, U_Commande; + +var + Trailer: TPdfDictionary; + CurrentColor: string; + CurrentWidth: string; + +procedure EcritChaine(const Valeur: string; AFlux: TStream); +begin +AFlux.Write(PChar(Valeur)^,Length(Valeur)); +end; + +function IntToChaine(const Valeur: Integer; const Long: Integer): string; +var + Chaine: string; + Cpt: Integer; +begin +Result:= ''; +Chaine:= IntToStr(Valeur); +if Length(Chaine)< Long +then + for Cpt:= Succ(Length(Chaine)) to Long do + Result:= Result+'0'; +Result:= Result+Chaine; +end; + +function DateToPdfDate(const ADate: TDateTime): string; +begin +Result:= FormatDateTime('"D:"yyyymmddhhnnss',ADate); +end; + +function ExtractBaseFontName(const AValue: string): string; +var + FontName,Chaine1,Chaine2: string; +begin +FontName:= Uppercase(AValue[1])+Copy(AValue,2,Pos('-',AValue)-2); +if Pos(':',AValue)> 0 +then + begin + Chaine1:= Copy(AValue,Succ(Pos(':',AValue)),Length(AValue)-Pos(':',AValue)); + Chaine1:= Uppercase(Chaine1[1])+Copy(Chaine1,2,Pred(Length(Chaine1))); + if Pos(':',Chaine1)> 0 + then + begin + Chaine2:= Copy(Chaine1,Succ(Pos(':',Chaine1)),Length(Chaine1)-Pos(':',Chaine1)); + Chaine2:= Uppercase(Chaine2[1])+Copy(Chaine2,2,Pred(Length(Chaine2))); + if (FontName= 'Helvetica') or (FontName= 'Courier') + then + if Chaine2= 'Italic' + then + Chaine2:= 'Oblique'; + Chaine1:= Copy(Chaine1,1,Pred(Pos(':',Chaine1))); + Chaine1:= Uppercase(Chaine1[1])+Copy(Chaine1,2,Pred(Length(Chaine1))); + if (FontName= 'Helvetica') or (FontName= 'Courier') + then + if Chaine1= 'Italic' + then + Chaine1:= 'Oblique'; + Chaine1:= Chaine1+Chaine2; + end + else + if (FontName= 'Helvetica') or (FontName= 'Courier') + then + if Chaine1= 'Italic' + then + Chaine1:= 'Oblique'; + Chaine1:= '-'+Chaine1; + end; +Result:= FontName+Chaine1; +end; + +function ColorToString(Couleur: Integer): string; +var + Red,Green,Blue: Integer; +begin +Red:= Couleur div 65535; +Couleur:= Couleur mod 65535; +Green:= Couleur div 255; +Blue:= Couleur mod 255; +end; + +constructor TPdfObjet.Create; +begin + // implementation dans les descendants +end; + +destructor TPdfObjet.Destroy; +begin +inherited; +end; + +procedure TPdfBoolean.EcritBoolean(const AFlux: TStream); +begin +if FValue +then + EcritChaine('true',AFlux) +else + EcritChaine('false',AFlux); +end; + +constructor TPdfBoolean.CreateBoolean(const AValue: Boolean); +begin +inherited Create; +FValue:= AValue; +end; + +destructor TPdfBoolean.Destroy; +begin +inherited; +end; + +procedure TPdfInteger.EcritInteger(const AFlux: TStream); +begin +EcritChaine(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.EcritReference(const AFlux: TStream); +begin +EcritChaine(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.EcritName(const AFlux: TStream); +begin +if FValue<> '' +then + EcritChaine('/'+FValue,AFlux); +end; + +constructor TPdfName.CreateName(const AValue: string); +begin +inherited Create; +FValue:= AValue; +end; + +destructor TPdfName.Destroy; +begin +inherited; +end; + +procedure TPdfString.EcritString(const AFlux: TStream); +begin +EcritChaine('('+Utf8ToAnsi(FValue)+')',AFlux); +end; + +constructor TPdfString.CreateString(const AValue: string); +begin +inherited Create; +FValue:= AValue; +end; + +destructor TPdfString.Destroy; +begin +inherited; +end; + +procedure TPdfArray.EcritArray(const AFlux: TStream); +var + Cpt: Integer; +begin +EcritChaine('[',AFlux); +for Cpt:= 0 to Pred(FArray.Count) do + begin + if Cpt> 0 + then + EcritChaine(' ',AFlux); + if TPdfObjet(FArray[Cpt]) is TPdfInteger + then + TPdfInteger(FArray[Cpt]).EcritInteger(AFlux); + if TPdfObjet(FArray[Cpt]) is TPdfReference + then + TPdfReference(FArray[Cpt]).EcritReference(AFlux); + if TPdfObjet(FArray[Cpt]) is TPdfName + then + TPdfName(FArray[Cpt]).EcritName(AFlux); + end; +EcritChaine(']',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; +begin +FArray.Free; +inherited; +end; + +procedure TPdfStream.EcritStream(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]).EcritFonte(AFlux); + if TPdfColor(FStream[Cpt]) is TPdfColor + then + TPdfColor(FStream[Cpt]).EcritColor(AFlux); + if TPdfObjet(FStream[Cpt]) is TPdfText + then + TPdfText(FStream[Cpt]).EcritText(AFlux); + if TPdfObjet(FStream[Cpt]) is TPdfRectangle + then + TPdfRectangle(FStream[Cpt]).EcritRectangle(AFlux); + if TPdfObjet(FStream[Cpt]) is TPdfLigne + then + TPdfLigne(FStream[Cpt]).EcritLigne(AFlux); + if TPdfObjet(FStream[Cpt]) is TPdfLineStyle + then + TPdfLineStyle(FStream[Cpt]).EcritLineStyle(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; +begin +FStream.Free; +inherited; +end; + +procedure TPdfFonte.EcritFonte(const AFlux: TStream); +begin +EcritChaine('/F'+IntToStr(FTxtFont)+' '+FTxtSize+' Tf'+CRLF,AFlux); +end; + +constructor TPdfFonte.CreateFonte(const AFont: Integer; const ASize: string); +begin +inherited Create; +FTxtFont:= AFont; +FTxtSize:= ASize; +end; + +destructor TPdfFonte.Destroy; +begin +inherited; +end; + +procedure TPdfText.EcritText(const AFlux: TStream); +begin +EcritChaine('BT'+CRLF,AFlux); +EcritChaine(IntToStr(FTxtPosX)+' '+IntToStr(FTxtPosY)+' Td'+CRLF,AFlux); +TPdfString(FTxtText).EcritString(AFlux); +EcritChaine(' Tj'+CRLF,AFlux); +EcritChaine('ET'+CRLF,AFlux); +end; + +constructor TPdfText.CreateText(const APosX,APosY: Integer; 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.EcritLigne(const AFlux: TStream); +begin +if (IntToStr(FEpais)+' w')<> CurrentWidth +then + begin + EcritChaine('1 J'+CRLF,AFlux); + EcritChaine(IntToStr(FEpais)+' w'+CRLF,AFlux); + CurrentWidth:= IntToStr(FEpais)+' w'; + end; +EcritChaine(IntToStr(FStaX)+' '+IntToStr(FStaY)+' m'+CRLF,AFlux); +EcritChaine(IntToStr(FEndX)+' '+IntToStr(FEndY)+' l'+CRLF,AFlux); +EcritChaine('S'+CRLF,AFlux); +end; + +constructor TPdfLigne.CreateLigne(const AEpais,AStaX,AStaY,AEndX,AEndY: Integer); +begin +inherited Create; +FEpais:= AEpais; +FStaX:= AStaX; +FStaY:= AStaY; +FEndX:= AEndX; +FEndY:= AEndY; +end; + +destructor TPdfLigne.Destroy; +begin +inherited; +end; + +procedure TPdfRectangle.EcritRectangle(const AFlux: TStream); +begin +if FStroke +then + if (IntToStr(FEpais)+' w')<> CurrentWidth + then + begin + EcritChaine('1 J'+CRLF,AFlux); + EcritChaine(IntToStr(FEpais)+' w'+CRLF,AFlux); + CurrentWidth:= IntToStr(FEpais)+' w'; + end; +EcritChaine(IntToStr(FRecX)+' '+IntToStr(FRecY)+' '+IntToStr(FRecW)+' '+IntToStr(FRecH)+' re'+CRLF,AFlux); +if FStroke +then + EcritChaine('S'+CRLF,AFlux); +if FFill +then + EcritChaine('f'+CRLF,AFlux); +end; + +constructor TPdfRectangle.CreateRectangle(const AEpais,APosX,APosY,AWidth,AHeight: Integer; 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 TPdfLineStyle.EcritLineStyle(const AFlux: TStream); +begin +EcritChaine('[',AFlux); +case FDash of + lsDash: + EcritChaine('5 5',AFlux); + lsDot: + EcritChaine('2 2',AFlux); + lsDashDot: + EcritChaine('5 2 2 2',AFlux); + lsDashDotDot: + EcritChaine('5 2 2 2 2 2',AFlux); + end; +EcritChaine('] '+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.EcritColor(const AFlux: TStream); +begin +if FStroke +then + begin + if (FRed+' '+FGreen+' '+FBlue+' rg')<> CurrentColor + then + begin + EcritChaine(FRed+' '+FGreen+' '+FBlue+' rg'+CRLF,AFlux); + CurrentColor:= FRed+' '+FGreen+' '+FBlue+' rg'; + end; + end +else + if (FRed+' '+FGreen+' '+FBlue+' RG')<> CurrentColor + then + begin + EcritChaine(FRed+' '+FGreen+' '+FBlue+' RG'+CRLF,AFlux); + CurrentColor:= FRed+' '+FGreen+' '+FBlue+' RG'; + end; +end; + +constructor TPdfColor.CreateColor(const AStroke: Boolean; Couleur: Longint); +begin +inherited Create; +FBlue:= FormatFloat('0.##',Couleur mod 256/256); +Couleur:= Couleur div 256; +FGreen:= FormatFloat('0.##',Couleur mod 256/256); +FRed:= FormatFloat('0.##',Couleur div 256/256); +FStroke:= AStroke; +end; + +destructor TPdfColor.Destroy; +begin +inherited +end; + +procedure TPdfDicElement.EcritDicElement(const AFlux: TStream); +begin +FKey.EcritName(AFlux); +EcritChaine(' ',AFlux); +if FValue is TPdfBoolean +then + TPdfBoolean(FValue).EcritBoolean(AFlux); +if FValue is TPdfInteger +then + TPdfInteger(FValue).EcritInteger(AFlux); +if FValue is TPdfReference +then + TPdfReference(FValue).EcritReference(AFlux); +if FValue is TPdfName +then + TPdfName(FValue).EcritName(AFlux); +if FValue is TPdfString +then + TPdfString(FValue).EcritString(AFlux); +if FValue is TPdfArray +then + TPdfArray(FValue).EcritArray(AFlux); +if FValue is TPdfDictionary +then + TPdfDictionary(FValue).EcritDictionary(AFlux); +EcritChaine(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 +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.EcritDictionary(AFlux: TStream); +var + Cpt: Integer; +begin +EcritChaine('<<'+CRLF,AFlux); +for Cpt:= 0 to Pred(FElement.Count) do + TPdfDicElement(FElement[Cpt]).EcritDicElement(AFlux); +EcritChaine('>>',AFlux); +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.EcritXRef(const AFlux: TStream); +begin +EcritChaine(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.EcritXRefTable(const AFlux: TStream); +var + Cpt: Integer; +begin +if FXRefObjets.Count> 1 +then + for Cpt:= 1 to Pred(FXRefObjets.Count) do + TPdfXRef(FXRefObjets[Cpt]).EcritXRef(AFlux); +end; + +procedure TPdfDocument.EcritObjet(const AObjet: Integer; const AFlux: TStream); +var + Dictionaire: TPdfDictionary; + Long: TPdfInteger; + Fin: Integer; + Flux: TMemoryStream; +begin +EcritChaine(IntToStr(AObjet)+' 0 obj'+CRLF,AFlux); +if TPdfXRef(FXRefObjets[AObjet]).FStream= nil +then + TPdfDictionary(TPdfXRef(FXRefObjets[AObjet]).FObjet).EcritDictionary(AFlux) +else + begin + Flux:= TMemoryStream.Create; + Flux.Position:= 0; + CurrentColor:= ''; + CurrentWidth:= ''; + TPdfXRef(FXRefObjets[AObjet]).FStream.EcritStream(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.EcritDictionary(AFlux); +// write stream in contents dictionary + CurrentColor:= ''; + CurrentWidth:= ''; + EcritChaine(CRLF+'stream'+CRLF,AFlux); + TPdfXRef(FXRefObjets[AObjet]).FStream.EcritStream(AFlux); + EcritChaine('endstream',AFlux); + end; +EcritChaine(CRLF+'endobj'+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; + +procedure TPdfDocument.CreateCatalog; +var + Catalog: TPdfXRef; + XRefObjets: TPdfReference; + Nom: TPdfName; +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); +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('FpGUI/FPC'); +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; + 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); + end +else // add pages reference to catalog dictionary + begin + 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; + +procedure TPdfDocument.CreatePage(Parent: Integer); +var + Page: TPdfXRef; + XRefObjets: TPdfReference; + Nom: TPdfName; + Dictionaire: TPdfDictionary; + Table: TPdfArray; + Coord: TPdfInteger; +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(Imprime.LargeurPapier); +TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('MediaBox')]).FValue).AddItem(Coord); +Coord:= TPdfInteger.CreateInteger(Imprime.HauteurPapier); +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 +Dictionaire:= TPdfDictionary.CreateDictionary; +TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('Font',Dictionaire); +// 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); +end; + +procedure TPdfDocument.CreateFont(NomFonte: string; NumFonte: Integer); +var + Fontes: TPdfXRef; + XRefObjets: TPdfReference; + Nom: TPdfName; + Dictionaire: TPdfDictionary; + 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('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'); +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 +XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); +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); + Dictionaire.AddElement(TPdfName(Nom).FValue,XRefObjets); + 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; + Sty: TpdfLineStyle; +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); + if Couleur> -1 + then + begin + Clr:= TPdfColor.CreateColor(True,Couleur); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr); + end; + end; + Txt:= TPdfText.CreateText(TextPosX,TextPosY,Ecriture); + 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 + if RectCouleur> -1 + then + begin + Clr:= TPdfColor.CreateColor(True,RectCouleur); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr); + end; + if RectTrace + then + begin + Sty:= TPdfLineStyle.CreateLineStyle(RectLineStyle,0); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Sty); + end; + Rct:= TPdfRectangle.CreateRectangle(RectEpais,RectGauche,RectBas,RectLarg,RectHaut,RectEmplit,RectTrace); + 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 + if LineColor> -1 + then + begin + Clr:= TPdfColor.CreateColor(False,LineColor); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Clr); + end; + Sty:= TPdfLineStyle.CreateLineStyle(LineStyle,0); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Sty); + Lin:= TPdfLigne.CreateLigne(LineEpais,LineStartX,LineStartY,LineEndX,LineEndY); + TPdfStream(TPdfXRef(FXRefObjets[PageNum]).FStream).AddItem(Lin); + end; + end; +end; + +constructor TPdfDocument.CreateDocument; +var + Cpt,CptSect,CptPage,CptFont,NumFont,Parent,PageNum,NumPage: Integer; + Trouve: Boolean; + Dictionaire: TPdfDictionary; + FontName: string; +begin +inherited Create; +CreateRefTable; +CreateTrailer; +CreateCatalog; +CreateInfo; +CreatePreferences; +Parent:= 0; +if Sections.Count> 1 +then + Parent:= CreatePages(Parent); +NumPage:= 0; // numéro de page identique à celui de l'appel à ImprimePage +for CptSect:= 0 to Pred(Sections.Count) do + begin + Parent:= CreatePages(Parent); + for CptPage:= 0 to Pred(T_Section(Sections[CptSect]).Pages.Count) do + begin + CreatePage(Parent); + Inc(NumPage); + PageNum:= CreateContents; // pagenum = numéro d'objet dans le fichier PDF + CreateStream(NumPage,PageNum); + end; + end; +NumFont:= 0; +for Cpt:= 0 to Pred(Fontes.Count) do + begin + Trouve:= False; + FontName:= ExtractBaseFontName(T_Fonte(Fontes[Cpt]).GetFonte.FontDesc); + //for CptFont:= 1 to Pred(FXRefObjets.Count) do + // begin + // Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[CptFont]).FObjet); + // if Dictionaire.FElement.Count> 0 + // then + // if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue= 'Font' + // then + // if TPdfName(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('BaseFont')]).FValue).FValue= FontName + // then + // begin + // Trouve:= True; + // Break; + // end; + // end; + //if not Trouve + //then + // begin + CreateFont(FontName,NumFont); + Inc(NumFont); + //end; + end; +TPdfInteger(TPdfDicElement(Trailer.FElement[Trailer.ElementParCle('Size')]).FValue).FValue:= FXRefObjets.Count; +if PdfPage.Count> 0 +then + for CptPage:= 0 to Pred(PdfPage.Count) do + TPdfElement(PdfPage[CptPage]).Free; +PdfPage.Free; +end; + +destructor TPdfDocument.Destroy; +var + Cpt: Integer; +begin +Trailer.Free; +for Cpt:= 0 to Pred(FXRefObjets.Count) do + TPdfXRef(FXRefObjets[Cpt]).Free; +FXRefObjets.Free; +inherited; +end; + +procedure TPdfDocument.EcritDocument(const AFlux: TStream); +var + Cpt,XRefPos: Integer; +begin +AFlux.Position:= 0; +EcritChaine(PDF_VERSION+CRLF,AFlux); +// write numbered indirect objects +for Cpt:= 1 to Pred(FXRefObjets.Count) do + begin + XRefPos:= AFlux.Position; + EcritObjet(Cpt,AFlux); + TPdfXRef(FXRefObjets[Cpt]).Offset:= XRefPos; + end; +XRefPos:= AFlux.Position; +// write xref table +EcritChaine('xref'+CRLF+'0 '+IntToStr(FXRefObjets.Count)+CRLF,AFlux); +with TPdfXRef(FXRefObjets[0]) do + EcritChaine(IntToChaine(Offset,10)+' '+IntToChaine(PDF_MAX_GEN_NUM,5)+' f'+CRLF,AFlux); +EcritXRefTable(AFlux); +// write trailer +EcritChaine('trailer'+CRLF,AFlux); +Trailer.EcritDictionary(AFlux); +// write offset of last xref table +EcritChaine(CRLF+'startxref'+CRLF+IntToStr(XRefPos)+CRLF,AFlux); +EcritChaine(PDF_FILE_END,AFlux); +end; + +end. + diff --git a/extras/contributed/report_tool/reportengine/u_visu.pas b/extras/contributed/report_tool/reportengine/u_visu.pas new file mode 100644 index 00000000..5475342d --- /dev/null +++ b/extras/contributed/report_tool/reportengine/u_visu.pas @@ -0,0 +1,500 @@ +{ + << 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 is the preview form +} + +unit U_Visu; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Process, + {$ifdef win32} + shellapi, + {$endif} + fpg_base, fpg_main, + fpg_form, fpg_panel, fpg_label, fpg_button, fpg_edit, fpg_dialogs, fpg_utils; + +type + TF_Visu = class(TfpgForm) + private + Bv_Commande: TfpgBevel; + Bt_Fermer: TfpgButton; + Bt_Imprimer: TfpgButton; + Bt_Imprimante: TfpgButton; + Bt_Arreter: TfpgButton; + Bt_Pdf: TfpgButton; + Bv_Pages: TfpgBevel; + L_Pages: TfpgLabel; + Bt_PremPage: TfpgButton; + Bt_PrecPage: TfpgButton; + E_NumPage: TfpgEditInteger; + Bt_SuivPage: TfpgButton; + Bt_DernPage: TfpgButton; + L_DePage: Tfpglabel; + L_NbrPages: TfpgLabel; + Bv_Sections: TfpgBevel; + L_Sections: TfpgLabel; +// Bt_PremSect: TfpgButton; + Bt_PrecSect: TfpgButton; + E_NumSect: TfpgEditInteger; + Bt_SuivSect: TfpgButton; +// Bt_DernSect: TfpgButton; + L_DeSect: Tfpglabel; + L_NbrSect: TfpgLabel; + L_PageSect: Tfpglabel; + L_NumPageSect: Tfpglabel; + L_DePageSect: TfpgLabel; + L_NbrPageSect: TfpgLabel; + procedure FormShow(Sender: TObject); + procedure Bt_FermerClick(Sender: TObject); + procedure Bt_ImprimerClick(Sender: TObject); + procedure Bt_ImprimanteClick(Sender: TObject); + procedure Bt_ArreterClick(Sender: TObject); + procedure Bt_PdfClick(Sender: TObject); + procedure Bt_PremPageClick(Sender: TObject); + procedure Bt_PrecPageClick(Sender: TObject); + procedure Bt_SuivPageClick(Sender: TObject); + procedure Bt_DernPageClick(Sender: TObject); +// procedure Bt_PremSectClick(Sender: TObject); + procedure Bt_PrecSectClick(Sender: TObject); + procedure Bt_SuivSectClick(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 Bt_DernSectClick(Sender: TObject); + procedure ChangeBoutons; + public + constructor Create(AOwner: TComponent); override; + end; + +var + F_Visu: TF_Visu; + Bv_Visu: TfpgBevel; + +implementation + +uses + U_Imprime, U_Commande, U_Pdf; + +procedure TF_Visu.FormShow(Sender: TObject); +begin +L_Pages.Text:= 'Page'; +L_Sections.Text:= 'Section'; +L_PageSect.Text:= 'Page'; +L_DePage.Text:= 'of'; +with Imprime 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(NumeroPage); + L_NbrPages.Text:= IntToStr(T_Section(Sections[Pred(Sections.Count)]).TotPages); + E_NumSect.Text:= IntToStr(NumeroSection); + L_NbrSect.Text:= IntToStr(Sections.Count); + L_NumPageSect.Text:= IntToStr(NumeroPageSection); + L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumeroSection)]).GetNbPages); + ChangeBoutons; + end; +end; + +procedure TF_Visu.Bt_FermerClick(Sender: TObject); +begin +Close; +end; + +procedure TF_Visu.Bt_ImprimerClick(Sender: TObject); +begin +end; + +procedure TF_Visu.Bt_ImprimanteClick(Sender: TObject); +begin +end; + +procedure TF_Visu.Bt_ArreterClick(Sender: TObject); +begin +end; + +procedure TF_Visu.Bt_PdfClick(Sender: TObject); +var + Fd_SauvePdf: TfpgFileDialog; + FichierPdf: string; + FluxFichier: TFileStream; +begin +Fd_SauvePdf:= TfpgFileDialog.Create(nil); +Fd_SauvePdf.InitialDir:= ExtractFilePath(Paramstr(0)); +Fd_SauvePdf.FontDesc:= 'bitstream vera sans-9'; +Fd_SauvePdf.Filter:= 'Fichiers pdf |*.pdf'; +Fd_SauvePdf.FileName:= Imprime.DefaultFile; +try + if Fd_SauvePdf.RunSaveFile + then + begin + FichierPdf:= Fd_SauvePdf.FileName; + if Lowercase(Copy(FichierPdf,Length(FichierPdf)-3,4))<> '.pdf' + then + FichierPdf:= FichierPdf+'.pdf'; + Document:= TPdfDocument.CreateDocument; + with Document do + begin + FluxFichier:= TFileStream.Create(FichierPdf,fmCreate); + EcritDocument(FluxFichier); + FluxFichier.Free; + Free; + end; +{$ifdef linux} + fpgOpenURL(FichierPdf); +{$endif} +{$ifdef win32} + ShellExecute(0,PChar('OPEN'),PChar(FichierPdf),PChar(''),PChar(''),1); +{$endif} + end; +finally + Fd_SauvePdf.Free; + end; +end; + +procedure TF_Visu.Bt_PremPageClick(Sender: TObject); +begin +with Imprime do + begin + NumeroPage:= 1; + NumeroSection:= 1; + NumeroPageSection:= 1; + E_NumPage.Text:= IntToStr(NumeroPage); + Bv_Visu.Invalidate; + ChangeBoutons; + E_NumSect.Text:= IntToStr(NumeroSection); + L_NumPageSect.Text:= IntToStr(NumeroPageSection); + L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumeroSection)]).GetNbPages); + end; +end; + +procedure TF_Visu.Bt_PrecPageClick(Sender: TObject); +begin +with Imprime do + begin + NumeroPage:= NumeroPage-1; + if NumeroPageSection= 1 + then + begin + NumeroSection:= NumeroSection-1; + NumeroPageSection:= T_Section(Sections[Pred(NumeroSection)]).GetNbPages; + end + else + NumeroPageSection:= NumeroPageSection-1; + E_NumPage.Text:= IntToStr(NumeroPage); + Bv_Visu.Invalidate; + ChangeBoutons; + E_NumSect.Text:= IntToStr(NumeroSection); + L_NumPageSect.Text:= IntToStr(NumeroPageSection); + L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumeroSection)]).GetNbPages); + end; +end; + +procedure TF_Visu.Bt_SuivPageClick(Sender: TObject); +begin +with Imprime do + begin + NumeroPage:= NumeroPage+1; + if NumeroPageSection= T_Section(Sections[Pred(NumeroSection)]).GetNbPages + then + begin + NumeroSection:= NumeroSection+1; + NumeroPageSection:= 1; + end + else + NumeroPageSection:= NumeroPageSection+1; + E_NumPage.Text:= IntToStr(NumeroPage); + Bv_Visu.Invalidate; + ChangeBoutons; + E_NumSect.Text:= IntToStr(NumeroSection); + L_NumPageSect.Text:= IntToStr(NumeroPageSection); + L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumeroSection)]).GetNbPages); + end; +end; + +procedure TF_Visu.Bt_DernPageClick(Sender: TObject); +begin +with Imprime do + begin + NumeroPage:= T_Section(Sections[Pred(Sections.Count)]).TotPages; + NumeroSection:= Sections.Count; + NumeroPageSection:= T_Section(Sections[Pred(Sections.Count)]).GetNbPages; + E_NumPage.Text:= IntToStr(NumeroPage); + Bv_Visu.Invalidate; + ChangeBoutons; + E_NumSect.Text:= IntToStr(NumeroSection); + L_NumPageSect.Text:= IntToStr(NumeroPageSection); + L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumeroSection)]).GetNbPages); + end; +end; + +//procedure TF_Visu.Bt_PremSectClick(Sender: TObject); +//begin +//end; + +procedure TF_Visu.Bt_PrecSectClick(Sender: TObject); +begin +with Imprime do + begin + NumeroSection:= NumeroSection-1; + NumeroPage:= T_Section(Sections[Pred(NumeroSection)]).GetFirstPage; + NumeroPageSection:= 1; + E_NumPage.Text:= IntToStr(NumeroPage); + Bv_Visu.Invalidate; + ChangeBoutons; + E_NumSect.Text:= IntToStr(NumeroSection); + L_NumPageSect.Text:= IntToStr(NumeroPageSection); + L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumeroSection)]).GetNbPages); + end; +end; + +procedure TF_Visu.Bt_SuivSectClick(Sender: TObject); +begin +with Imprime do + begin + NumeroSection:= NumeroSection+1; + NumeroPage:= T_Section(Sections[Pred(NumeroSection)]).GetFirstPage; + NumeroPageSection:= 1; + E_NumPage.Text:= IntToStr(NumeroPage); + Bv_Visu.Invalidate; + ChangeBoutons; + E_NumSect.Text:= IntToStr(NumeroSection); + L_NumPageSect.Text:= IntToStr(NumeroPageSection); + L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumeroSection)]).GetNbPages); + end; +end; + +//procedure TF_Visu.Bt_DernSectClick(Sender: TObject); +//begin +//end; + +procedure TF_Visu.ChangeBoutons; +begin +with Imprime do + if T_Section(Sections[Pred(Sections.Count)]).TotPages> 1 + then + if NumeroPage= 1 + then + begin + Bt_PremPage.Enabled:= False; + Bt_PrecPage.Enabled:= False; + Bt_SuivPage.Enabled:= True; + Bt_DernPage.Enabled:= True; + Bt_PrecSect.Enabled:= False; + if Sections.Count> 1 + then + Bt_SuivSect.Enabled:= True + else + Bt_SuivSect.Enabled:= False; + end + else + if NumeroPage= T_Section(Sections[Pred(Sections.Count)]).TotPages + then + begin + Bt_PremPage.Enabled:= True; + Bt_PrecPage.Enabled:= True; + Bt_SuivPage.Enabled:= False; + Bt_DernPage.Enabled:= False; + if Sections.Count> 1 + then + Bt_PrecSect.Enabled:= True + else + Bt_PrecSect.Enabled:= False; + Bt_SuivSect.Enabled:= False; + end + else + begin + Bt_PremPage.Enabled:= True; + Bt_PrecPage.Enabled:= True; + Bt_SuivPage.Enabled:= True; + Bt_DernPage.Enabled:= True; + if Sections.Count> 1 + then + if NumeroSection= 1 + then + begin + Bt_PrecSect.Enabled:= False; + Bt_SuivSect.Enabled:= True; + end + else + if NumeroSection= Sections.Count + then + begin + Bt_PrecSect.Enabled:= True; + Bt_SuivSect.Enabled:= False; + end + else + begin + Bt_PrecSect.Enabled:= True; + Bt_SuivSect.Enabled:= True; + end + else + begin + Bt_PrecSect.Enabled:= False; + Bt_SuivSect.Enabled:= False; + end; + end + else + begin + Bt_PremPage.Enabled:= False; + Bt_PrecPage.Enabled:= False; + Bt_SuivPage.Enabled:= False; + Bt_DernPage.Enabled:= False; + Bt_PrecSect.Enabled:= False; + Bt_SuivSect.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 Imprime do + begin + if E_NumPage.Value> T_Section(Sections[Pred(Sections.Count)]).TotPages + then + NumeroPage:= T_Section(Sections[Pred(Sections.Count)]).TotPages + else + if E_NumPage.Value= 0 + then + NumeroPage:= 1 + else + NumeroPage:= E_NumPage.Value; + E_NumPage.Value:= NumeroPage; + CptSect:= 0; + CptPage:= 0; + repeat + Inc(CptSect); + CptPageSect:= 0; + repeat + Inc(CptPage); + Inc(CptPageSect); + until (CptPage= NumeroPage) or (CptPage= T_Section(Sections[Pred(Cptsect)]).GetNbPages); + until CptPage= NumeroPage; + NumeroSection:= CptSect; + NumeroPageSection:= CptPagesect; + Bv_Visu.Invalidate; + ChangeBoutons; + E_NumSect.Text:= IntToStr(NumeroSection); + L_NumPageSect.Text:= IntToStr(NumeroPageSection); + L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumeroSection)]).GetNbPages); + 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 Imprime do + begin + if E_NumSect.Value> Sections.Count + then + NumeroSection:= Sections.Count + else + if E_NumSect.Value= 0 + then + NumeroSection:= 1 + else + NumeroSection:= E_NumSect.Value; + E_NumSect.Value:= NumeroSection; + NumeroPage:= T_Section(Sections[Pred(Numerosection)]).GetFirstPage; + NumeroPageSection:= 1; + E_NumPage.Value:= NumeroPage; + Bv_Visu.Invalidate; + ChangeBoutons; + L_NumPageSect.Text:= IntToStr(NumeroPageSection); + L_NbrPageSect.Text:= IntToStr(T_Section(Sections[Pred(NumeroSection)]).GetNbPages); + end; +end; + +constructor TF_Visu.Create(AOwner: TComponent); +begin +inherited Create(AOwner); +Name := 'F_Visu'; +WindowTitle:= 'Preview'; +WindowPosition:= wpUser; +SetPosition(0, 0, FpgApplication.ScreenWidth-2, FpgApplication.ScreenHeight-66); +Sizeable:= False; +BackgroundColor:= clMediumAquamarine; +Bv_Commande:= CreateBevel(Self,0,0,Width,50,bsBox,bsRaised); +Bv_Commande.BackgroundColor:= clBisque; +Bt_Fermer:= CreateButton(Bv_Commande,10,10,26,'',@Bt_FermerClick); +Bt_Fermer.BackgroundColor:= clOrangeRed; +Bt_Fermer.ImageName:= 'stdimg.Fermer'; +Bt_Imprimer:= CreateButton(Bv_Commande,50,10,26,'',@Bt_ImprimerClick); +Bt_Imprimer.BackgroundColor:= clGreen; +Bt_Imprimer.ImageName:= 'stdimg.Imprimer'; +Bt_Imprimer.Enabled:= False; +Bt_Imprimante:= CreateButton(Bv_Commande,90,10,26,'',@Bt_ImprimanteClick); +Bt_Imprimante.BackgroundColor:= clSilver; +Bt_Imprimante.ImageName:= 'stdimg.Imprimante'; +Bt_Imprimante.Enabled:= False; +Bt_Arreter:= CreateButton(Bv_Commande,130,10,26,'',@Bt_ArreterClick); +Bt_Arreter.BackgroundColor:= clRed; +Bt_Arreter.ImageName:= 'stdimg.Stop'; +Bt_Pdf:= CreateButton(Bv_Commande,170,10,26,'',@Bt_PdfClick); +Bt_Pdf.BackgroundColor:= clWhite; +Bt_Pdf.ImageMargin:= 0; +Bt_Pdf.ImageName:= 'stdimg.Adobe_pdf'; +Bv_Pages:= CreateBevel(Bv_Commande,220,5,300,40,bsBox,bsLowered); +Bv_Pages.BackgroundColor:= clLinen; +Bt_PremPage:= CreateButton(Bv_Pages,54,6,26,'',@Bt_PremPageClick); +Bt_PremPage.ImageName:= 'stdimg.Debut'; +Bt_PrecPage:= CreateButton(Bv_Pages,80,6,26,'',@Bt_PrecPageClick); +Bt_PrecPage.ImageName:= 'stdimg.Precedent'; +E_NumPage:= CreateEditInteger(Bv_Pages,110,8,60,0); +E_NumPage.OnKeyPress:= @E_NumPageKeypress; +Bt_Suivpage:= CreateButton(Bv_Pages,174,6,26,'',@Bt_SuivPageClick); +Bt_SuivPage.ImageName:= 'stdimg.Suivant'; +Bt_DernPage:= CreateButton(Bv_Pages,200,6,26,'',@Bt_DernPageClick); +Bt_DernPage.ImageName:= 'stdimg.Fin'; +L_Pages:= CreateLabel(Bv_Pages,5,E_NumPage.Top,'Page',0,E_NumPage.Height,taLeftJustify,tlcenter); +L_Depage:= CreateLabel(Bv_Pages,235,E_NumPage.Top,'de',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_Commande,540,5,500,40,bsBox,bsLowered); +Bv_Sections.BackgroundColor:= clLinen; +//Bt_PremSect:= CreateButton(Bv_Sections,64,6,26,'',@Bt_PremSectClick); +//Bt_PremSect.ImageName:= 'stdimg.Debut'; +Bt_PrecSect:= CreateButton(Bv_Sections,90,6,26,'',@Bt_PrecSectClick); +Bt_PrecSect.ImageName:= 'stdimg.Precedent'; +E_NumSect:= CreateEditInteger(Bv_Sections,120,8,60,0); +E_NumSect.OnKeyPress:= @E_NumSectKeyPress; +Bt_SuivSect:= CreateButton(Bv_Sections,184,6,26,'',@Bt_SuivSectClick); +Bt_SuivSect.ImageName:= 'stdimg.Suivant'; +//Bt_DernSect:= CreateButton(Bv_Sections,210,6,26,'',@Bt_DernSectClick); +//Bt_DernSect.ImageName:= 'stdimg.Fin'; +L_Sections:= CreateLabel(Bv_Sections,5,E_NumSect.Top,'Section',0,E_NumSect.Height,taLeftJustify,tlcenter); +L_DeSect:= 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_DePageSect:= 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; + +end. + |