From 3e993b0cc66e25d2c8542471849931dd96b2734c Mon Sep 17 00:00:00 2001 From: Jean-Marc Levecque Date: Tue, 31 Jul 2012 09:38:14 +0100 Subject: Adds *.ttf font support to the PDF report engine. --- extras/contributed/report_tool/demo/u_demo.pas | 188 +++++++-- .../contributed/report_tool/reportengine/u_pdf.pas | 442 ++++++++++++++++++--- 2 files changed, 541 insertions(+), 89 deletions(-) diff --git a/extras/contributed/report_tool/demo/u_demo.pas b/extras/contributed/report_tool/demo/u_demo.pas index 687b84d6..41cc5d16 100644 --- a/extras/contributed/report_tool/demo/u_demo.pas +++ b/extras/contributed/report_tool/demo/u_demo.pas @@ -30,6 +30,7 @@ type Bt_PdfGraph: TfpgButton; Bt_PdfSurf: TfpgButton; Bt_PdfImages: TfpgButton; + Bt_PdfTtfFont: TfpgButton; L_Visu: TfpgLabel; Bt_VisuEmptyPage: TfpgButton; Bt_VisuSimpleText: TfpgButton; @@ -43,6 +44,7 @@ type Bt_VisuGraph: TfpgButton; Bt_VisuSurf: TfpgButton; Bt_VisuImages: TfpgButton; + Bt_VisuTtfFont: TfpgButton; L_Print: TfpgLabel; Bt_PrintEmptyPage: TfpgButton; Bt_PrintSimpleText: TfpgButton; @@ -56,6 +58,7 @@ type Bt_PrintGraph: TfpgButton; Bt_PrintSurf: TfpgButton; Bt_PrintImages: TfpgButton; + Bt_PrintTtfFont: TfpgButton; L_Settings: TfpgLabel; Ckb_Preferences: TfpgCheckBox; P_Zoom: TfpgPanel; @@ -65,6 +68,7 @@ type RB_Single: TfpgRadiobutton; RB_Two: TfpgRadiobutton; RB_Continuous: TfpgRadiobutton; + Bt_FontDir: TfpgButton; Bt_Exit: TfpgButton; procedure Bt_PdfEmptyPageClick(Sender: TObject); procedure Bt_PdfSimpleTextClick(Sender: TObject); @@ -78,6 +82,7 @@ type procedure Bt_PdfGraphClick(Sender: TObject); procedure Bt_PdfSurfClick(Sender: TObject); procedure Bt_PdfImagClick(Sender: TObject); + procedure Bt_PdfTtfFontClick(Sender: TObject); procedure Bt_VisuEmptyPageClick(Sender: TObject); procedure Bt_VisuSimpleTextClick(Sender: TObject); procedure Bt_VisuMultiPagesClick(Sender: TObject); @@ -90,6 +95,7 @@ type procedure Bt_VisuGraphClick(Sender: TObject); procedure Bt_VisuSurfClick(Sender: TObject); procedure Bt_VisuImagClick(Sender: TObject); + procedure Bt_VisuTtfFontClick(Sender: TObject); procedure Bt_PrintEmptyPageClick(Sender: TObject); procedure Bt_PrintSimpleTextClick(Sender: TObject); procedure Bt_PrintMultiPagesClick(Sender: TObject); @@ -102,7 +108,9 @@ type procedure Bt_PrintGraphClick(Sender: TObject); procedure Bt_PrintSurfClick(Sender: TObject); procedure Bt_PrintImagClick(Sender: TObject); + procedure Bt_PrintTtfFontClick(Sender: TObject); procedure Bt_ExitClick(Sender: TObject); + procedure Bt_FontDirClick(Sender: TObject); procedure PrintEmptyPage(Preview: Boolean); procedure PrintSimpleText(Preview: Boolean); procedure PrintMultiPages(Preview: Boolean); @@ -115,8 +123,10 @@ type procedure PrintGraph(Preview: Boolean); procedure PrintSurf(Preview: Boolean); procedure PrintImage(Preview: Boolean); + procedure PrintTtfFont(Preview: Boolean); procedure Ckb_PreferencesChange(Sender: TObject); procedure SE_ZoomChange(Sender: TObject); + procedure SE_ZoomExit(Sender: TObject); procedure P_LayoutRBChange(Sender: TObject); public constructor Create(AOwner: TComponent); override; @@ -128,7 +138,7 @@ var implementation uses - U_Command, U_Pdf, U_ReportImages; + U_Command, U_Pdf; var ChartValues: array[0..18] of Integer; @@ -763,6 +773,58 @@ with FReport do end; end; +procedure TF_Demo.Bt_PdfTtfFontClick(Sender: TObject); +var + Fd_SavePdf: TfpgFileDialog; + PdfFile: string; + PdfFileStream: TFileStream; +begin +FReport:= T_Report.Create; +with FReport do + begin +// Language:= Version; + PrintTtfFont(False); + if T_Section(Sections[Pred(Sections.Count)]).TotPages= 0 + then + begin + ShowMessage('There is no file to print'); + Exit; + end; + Fd_SavePdf:= TfpgFileDialog.Create(nil); + Fd_SavePdf.InitialDir:= ExtractFilePath(Paramstr(0)); + Fd_SavePdf.FontDesc:= 'bitstream vera sans-9'; + Fd_SavePdf.Filter:= 'PDF files (*.pdf) |*.pdf'; + Fd_SavePdf.FileName:= 'TtfFont.pdf'; + try + if Fd_SavePdf.RunSaveFile + then + begin + PdfFile:= Fd_SavePdf.FileName; + if Lowercase(Copy(PdfFile,Length(PdfFile)-3,4))<> '.pdf' + then + PdfFile:= PdfFile+'.pdf'; + Document:= TPdfDocument.CreateDocument(LayoutMode,ZoomValue,Preferences); + with Document do + begin + PdfFileStream:= TFileStream.Create(PdfFile,fmCreate); + WriteDocument(PdfFileStream); + PdfFileStream.Free; + Free; + end; + {$ifdef linux} + fpgOpenURL(PdfFile); + {$endif} + {$ifdef win32} + ShellExecute(0,PChar('OPEN'),PChar(PdfFile),PChar(''),PChar(''),1); + {$endif} + end; + finally + Fd_SavePdf.Free; + end; + Free; + end; +end; + procedure TF_Demo.Bt_VisuEmptyPageClick(Sender: TObject); begin FReport:= T_Report.Create; @@ -907,6 +969,18 @@ with FReport do end; end; +procedure TF_Demo.Bt_VisuTtfFontClick(Sender: TObject); +begin +FReport:= T_Report.Create; +with FReport do + begin + //Language:= Version; + DefaultFile:= 'TtfFont.pdf'; + PrintTtfFont(True); + Free; + end; +end; + procedure TF_Demo.Bt_PrintEmptyPageClick(Sender: TObject); begin @@ -967,6 +1041,16 @@ begin end; +procedure TF_Demo.Bt_PrintTtfFontClick(Sender: TObject); +begin + +end; + +procedure TF_Demo.Bt_FontDirClick(Sender: TObject); +begin +FontDirectory:= SelectDirDialog('/Home'); +end; + procedure TF_Demo.Bt_ExitClick(Sender: TObject); begin Close; @@ -995,12 +1079,12 @@ with FReport do begin // define orientation, page format, measurement unit, language, preview (true) or print (false) BeginWrite(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) FtText1:= Font('helvetica-15:bold',clBlack); FtText2:= Font('helvetica-8',clBlack); FtText3:= Font('helvetica-8:italic',clBlack); + // create a new section and define the margins: 10 mm each side + Section(10,10,10,10); // write the text at position 100 mm from left and 120 mm from top WritePage(100,120,'Big text at absolute position',-1,FtText1); // write the text aligned to left @@ -1027,11 +1111,11 @@ with FReport do begin // define orientation, page format, measurement unit, language, preview (true) or print (false) BeginWrite(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) FtTitle:= Font('helvetica-15:bold',clBlack); FtText:= Font('helvetica-8',clBlack); + // create a new section and define the margins + Section(20,10,10,10); // write title on each page WriteHeader(cnCenter,lnEnd,'MULTIPAGE DOCUMENT',ColDefaut,FtTitle); // write page number and total of pages on each page @@ -1183,8 +1267,6 @@ with FReport do begin // define orientation, page format, measurement unit, language, preview (true) or print (false) BeginWrite(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) FtTitle:= Font('helvetica-15:bold',clBlack); FtText:= Font('helvetica-8',clBlack); @@ -1195,6 +1277,8 @@ with FReport do // create line spacings to be used IlTitle:= LineSpace(3,0,3); IlText:= LineSpace(1,0,1); + // create a new section and define the margins with an additional one due to frames drawing + Section(20,10,10,10,5); // write title on each page WriteHeader(cnCenter,lnEnd,'SHOWING FRAMES',ColDefaut,FtTitle,IlTitle); // write page number and total of pages on each page @@ -1224,8 +1308,6 @@ with FReport do begin // define orientation, page format, measurement unit, language, preview (true) or print (false) BeginWrite(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 BcBeige:= BackColor(clBeige); BcAqua:= BackColor(clAqua); @@ -1245,6 +1327,8 @@ with FReport do // create line spacings to be used IlTitle:= LineSpace(5,0,5); IlText:= LineSpace(0,0,0); + // create a new section and define the margins + Section(20,10,10,10); // write title on each page WriteHeader(cnCenter,lnEnd,'SHOWING COLORS',ColDefaut,FtTitle,IlTitle); // write page number and total of pages on each page @@ -1276,8 +1360,6 @@ with FReport do begin // define orientation, page format, measurement unit, language, preview (true) or print (false) BeginWrite(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) FtTitle:= Font('helvetica-15:bold',clBlack); FtText:= Font('helvetica-8',clBlack); @@ -1297,6 +1379,8 @@ with FReport do Col1:= Column(20,60,2); Col2:= Column(80,60,2); Col3:= Column(140,60,2); + // create a new section and define the margins + Section(20,10,10,10); // write title on each page WriteHeader(cnCenter,lnEnd,'SHOWING LINES',ColDefaut,FtTitle,IlTitle); // write page number and total of pages on each page @@ -1343,8 +1427,6 @@ with FReport do begin // define orientation, page format, measurement unit, language, preview (true) or print (false) BeginWrite(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) FtTitle:= Font('helvetica-15:bold',clBlack); FtText:= Font('helvetica-7',clBlack); @@ -1369,6 +1451,8 @@ with FReport do Col[3]:= Column(Col3Pos,Col3Wid,2); Col[4]:= Column(Col4Pos,Col4Wid,2); Col[5]:= Column(Col5Pos,Col5Wid,2); + // create a new section and define the margins + Section(20,10,10,10); // write title on each page WriteHeader(cnCenter,lnEnd,'SHOWING GRIDS',ColDefaut,FtTitle,IlTitle); // write page number and total of pages on each page @@ -1452,8 +1536,6 @@ with FReport do begin // define orientation, page format, measurement unit, language, preview (true) or print (false) BeginWrite(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) FtTitle:= Font('helvetica-15:bold',clBlack); FtText:= Font('helvetica-7',clBlack); @@ -1466,6 +1548,8 @@ with FReport do TsGray:= LineStyle(1,clGray,lsDot); TsBlue:= LineStyle(1,clBlue,lsSolid); TsFuchsia:= LineStyle(1,clFuchsia,lsDot); + // create a new section and define the margins + Section(10,10,10,10); WriteHeader(cnCenter,lnEnd,'SHOWING GRAPH',ColDefaut,FtTitle,IlTitle); // write page number and total of pages on each page NumPageFooter(cnRight,lnEnd,'Page','of',True,ColDefaut,FtText,IlText); @@ -1504,14 +1588,14 @@ with FReport do begin // define orientation, page format, measurement unit, language, preview (true) or print (false) BeginWrite(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) FtTitle:= Font('helvetica-15:bold',clBlack); FtText:= Font('helvetica-7',clBlack); // create line spacings to be used IlTitle:= LineSpace(3,0,3); IlText:= LineSpace(1,0,0); + // create a new section and define the margins + Section(10,10,10,10); WriteHeader(cnCenter,lnEnd,'SHOWING SURFACE',ColDefaut,FtTitle,IlTitle); // write page number and total of pages on each page NumPageFooter(cnRight,lnEnd,'Page','of',True,ColDefaut,FtText,IlText); @@ -1533,8 +1617,6 @@ with FReport do begin // define orientation, page format, measurement unit, language, preview (true) or print (false) BeginWrite(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) FtTitle:= Font('helvetica-15:bold',clBlack); FtText:= Font('helvetica-7',clBlack); @@ -1544,6 +1626,8 @@ with FReport do Col1:= Column(20,60,2); Col2:= Column(80,60,2); Col3:= Column(140,60,2); + // create a new section and define the margins + Section(10,10,10,10); WriteHeader(cnCenter,lnEnd,'SHOWING IMAGES',ColDefaut,FtTitle,IlTitle); // write page number and total of pages on each page NumPageFooter(cnRight,lnEnd,'Page','of',True,ColDefaut,FtText,IlText); @@ -1562,6 +1646,51 @@ with FReport do end; end; +procedure TF_Demo.PrintTtfFont(Preview: Boolean); +var + FtTitle,FtText,FtText1,FtText2,FtText3,FtText4,FtText5,FtText6,FtText7,FtText8,FtText9,FtText10: Integer; + IlTitle,IlText: Integer; +begin +with FReport do + begin + // define orientation, page format, measurement unit, language, preview (true) or print (false) + BeginWrite(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) + FtTitle:= Font('helvetica-15:bold',clBlack); + FtText:= Font('helvetica-7',clBlack); + FtText1:= Font('LiberationSans-10',clBlack); + FtText2:= Font('LiberationSans-10:bold:italic',clBlack); + FtText3:= Font('LiberationMono-10:italic',clBlack); + FtText4:= Font('LiberationSerif-10:bold',clBlack); + FtText5:= Font('DejaVuSans-10',clBlack); + FtText6:= Font('DejaVuSansCondensed-10',clBlack); + FtText7:= Font('DejaVuSansMono-10:bold:oblique',clBlack); + FtText8:= Font('DejaVuSerif-10:italic',clBlack); + FtText9:= Font('ComicSansMS-10',clBlack); + FtText10:= Font('ComicSansMS-10:bold',clBlack); + // create line spacings to be used + IlTitle:= LineSpace(0,0,5); + IlText:= LineSpace(3,0,3); + WriteHeader(cnCenter,lnEnd,'SHOWING TRUE TYPE FONTS',ColDefaut,FtTitle,IlTitle); + // write page number and total of pages on each page + NumPageFooter(cnRight,lnEnd,'Page','of',True,ColDefaut,FtText,IlText); + // write text aligned to center of the page + WritePage(cnCenter,lnEnd,'LiberationSans-10',ColDefaut,FtText1); + WritePage(cnCenter,lnEnd,'LiberationSans-10:bold:italic',ColDefaut,FtText2); + WritePage(cnCenter,lnEnd,'LiberationMono-10:italic',ColDefaut,FtText3); + WritePage(cnCenter,lnEnd,'LiberationSerif-10:bold',ColDefaut,FtText4); + WritePage(cnCenter,lnEnd,'DejaVuSans-10',ColDefaut,FtText5); + WritePage(cnCenter,lnEnd,'DejaVuSansCondensed-10',ColDefaut,FtText6); + WritePage(cnCenter,lnEnd,'DejaVuSansMono-10:bold:oblique',ColDefaut,FtText7); + WritePage(cnCenter,lnEnd,'DejaVuSerif-10:italic',ColDefaut,FtText8); + WritePage(cnCenter,lnEnd,'ComicSansMS-10',ColDefaut,FtText9); + WritePage(cnCenter,lnEnd,'ComicSansMS-10:bold',ColDefaut,FtText10); + EndWrite; + end; +end; + procedure TF_Demo.Ckb_PreferencesChange(Sender: TObject); begin Preferences:= Ckb_Preferences.Checked; @@ -1572,6 +1701,11 @@ begin ZoomValue:= IntToStr(SE_Zoom.Value); end; +procedure TF_Demo.SE_ZoomExit(Sender: TObject); +begin +ZoomValue:= IntToStr(SE_Zoom.Value); +end; + procedure TF_Demo.P_LayoutRBChange(Sender: TObject); begin if RB_Single.Checked @@ -1592,7 +1726,7 @@ begin inherited Create(AOwner); Name := 'F_Demo'; WindowTitle:= 'PDF demo'; -SetPosition(0, 0, 900, 550); +SetPosition(0, 0, 900, 600); WindowPosition:= wpScreenCenter; Sizeable:= False; fpgSetNamedColor(clWindowBackground,clPaleGreen); @@ -1615,6 +1749,7 @@ Bt_PdfGrid:= CreateButton(Self,50,350,150,'Show grid',@Bt_PdfGridClick,'stdimg.A Bt_PdfGraph:= CreateButton(Self,50,390,150,'Show graph',@Bt_PdfGraphClick,'stdimg.Adobe_pdf'); Bt_PdfSurf:= CreateButton(Self,50,430,150,'Show surface',@Bt_PdfSurfClick,'stdimg.Adobe_pdf'); Bt_PdfImages:= CreateButton(Self,50,470,150,'Show images',@Bt_PdfImagClick,'stdimg.Adobe_pdf'); +Bt_PdfTtfFont:= CreateButton(Self,50,510,150,'True type fonts',@Bt_PdfTtfFontClick,'stdimg.Adobe_pdf'); L_Visu:= 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'); @@ -1628,6 +1763,7 @@ Bt_VisuGrid:= CreateButton(Self,250,350,150,'Show grid',@Bt_VisuGridClick,'stdim Bt_VisuGraph:= CreateButton(Self,250,390,150,'Show graph',@Bt_VisuGraphClick,'stdimg.preview'); Bt_VisuSurf:= CreateButton(Self,250,430,150,'Show surface',@Bt_VisuSurfClick,'stdimg.preview'); Bt_VisuImages:= CreateButton(Self,250,470,150,'Show images',@Bt_VisuImagClick,'stdimg.preview'); +Bt_VisuTtfFont:= CreateButton(Self,250,510,150,'True type fonts',@Bt_VisuTtfFontClick,'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.print'); Bt_PrintEmptyPage.Enabled:= False; @@ -1653,6 +1789,8 @@ Bt_PrintSurf:= CreateButton(Self,450,430,150,'Show surface',@Bt_PrintSurfClick,' Bt_PrintSurf.Enabled:= False; Bt_PrintImages:= CreateButton(Self,450,470,150,'Show images',@Bt_PrintImagClick,'stdimg.print'); Bt_PrintImages.Enabled:= False; +Bt_PrintTtfFont:= CreateButton(Self,450,510,150,'True type fonts',@Bt_PrintTtfFontClick,'stdimg.print'); +Bt_PrintTtfFont.Enabled:= False; L_Settings:= CreateLabel(Self,650,5,'PDF settings',200,20,taCenter); Ckb_Preferences:= CreateCheckBox(Self,650,30,'FitWindow preference'); Ckb_Preferences.OnChange:= @Ckb_PreferencesChange;; @@ -1661,12 +1799,6 @@ P_Zoom.BackgroundColor:= clPaleGreen; SE_Zoom:= CreateSpinEdit(P_Zoom,10,25,55,20,20,200,1,5,100); SE_Zoom.OnChange:= @SE_ZoomChange; L_Zoom:= CreateLabel(P_Zoom,70,25,'%'); -//RB_FullPage:= CreateRadiobutton(P_Zoom,10,25,'Full page'); -//RB_FullPage.OnChange:= @P_ZoomRBChange; -//RB_FullWidth:= CreateRadiobutton(P_Zoom,10,50,'Full width'); -//RB_FullWidth.OnChange:= @P_ZoomRBChange; -//RB_Real:= CreateRadiobutton(P_Zoom,10,75,'Real'); -//RB_Real.OnChange:= @P_ZoomRBChange; P_Layout:= CreatePanel(Self,650,130,200,110,'Layout',bsRaised,taCenter,tlTop,5); P_Layout.BackgroundColor:= clPaleGreen; RB_Single:= CreateRadiobutton(P_Layout,10,25,'Single'); @@ -1675,10 +1807,10 @@ RB_Two:= CreateRadiobutton(P_Layout,10,50,'Two pages'); RB_Two.OnChange:= @P_LayoutRBChange; RB_Continuous:= CreateRadiobutton(P_Layout,10,75,'Continuous'); RB_Continuous.OnChange:= @P_LayoutRBChange; +Bt_FontDir:= CreateButton(Self,640,260,220,'True type font files directory',@Bt_FontDirClick,''); Ckb_Preferences.Checked:= True; -//RB_FullPage.Checked:= True; RB_Single.Checked:= True; -Bt_Exit:= CreateButton(Self,375,510,150,'Exit',@Bt_ExitClick,'stdimg.exit'); +Bt_Exit:= CreateButton(Self,375,550,150,'Exit',@Bt_ExitClick,'stdimg.exit'); Bt_Exit.BackgroundColor:= clTomato; ZoomValue:= '100'; Randomize; diff --git a/extras/contributed/report_tool/reportengine/u_pdf.pas b/extras/contributed/report_tool/reportengine/u_pdf.pas index 807e637e..e6c4fac9 100644 --- a/extras/contributed/report_tool/reportengine/u_pdf.pas +++ b/extras/contributed/report_tool/reportengine/u_pdf.pas @@ -1,7 +1,7 @@ { << Impressions >> U_Pdf.pas - Copyright (C) 2010 - Jean-Marc Levecque + Copyright (C) 2010 - JM.Levecque - 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 @@ -22,7 +22,7 @@ interface uses Classes, SysUtils, StrUtils, - fpg_main, fpg_base; + fpg_main, fpg_base, fpg_dialogs; type TPdfObjet = class(TObject) @@ -113,6 +113,7 @@ type FTxtSize: string; protected procedure WriteFonte(const AFlux: TStream); + function WriteFonteStream(const FFlux: TMemoryStream; const AFlux: TStream): Int64; public constructor CreateFonte(const AFont: Integer; const ASize: string); destructor Destroy; override; @@ -273,7 +274,13 @@ type function CreatePage(Parent,Haut,Larg,PageNum: Integer): Integer; function CreateOutlines: Integer; function CreateOutline(Parent,SectNo,PageNo: Integer; SectTitre: string): Integer; - procedure CreateFont(NomFonte: string; NumFonte: Integer); + procedure CreateStdFont(NomFonte: string; NumFonte: Integer); + function LoadFont(NomFonte: string): string; + procedure CreateTtfFont(const NumFonte: Integer); + procedure CreateTp1Font(const NumFonte: Integer); + procedure CreateFontDescriptor(const NumFonte: Integer); + procedure CreateFontWidth; + procedure CreateFontFile(const NumFonte: Integer); procedure CreateImage(ImgWidth,ImgHeight,NumImg: Integer); function CreateContents: Integer; procedure CreateStream(NumeroPage,PageNum: Integer); @@ -284,6 +291,24 @@ type property PageLayout: TPageLayout read FPageLayout write FPageLayout default lSingle; end; + TFontDef = record + FType: string; + FName: string; + FAscent: string; + FDescent: string; + FCapHeight: string; + FFlags: string; + FFontBBox: string; + FItalicAngle: string; + FStemV: string; + FMissingWidth: string; + FEncoding: string; + FFile: string; + FOriginalSize: string; + FDiffs: widestring; + FCharWidth: widestring; + end; + const CRLF= #13#10; PDF_VERSION= '%PDF-1.3'; @@ -296,6 +321,7 @@ var Document: TPdfDocument; OldDecSeparator: Char; Outline: Boolean; + FontDirectory: string; implementation @@ -307,6 +333,9 @@ var CurrentColor: string; CurrentWidth: string; Catalogue: Integer; + FontDef: TFontDef; + Flux: TMemoryStream; + FontFiles: array of string; // utility functions @@ -376,7 +405,7 @@ function ExtractBaseFontName(const AValue: string): string; var FontName,Chaine1,Chaine2: string; begin -FontName:= Uppercase(AValue[1])+Copy(AValue,2,Pos('-',AValue)-2); +FontName:= Copy(AValue,1,Pred(Pos('-',AValue))); if Pos(':',AValue)> 0 then begin @@ -387,26 +416,10 @@ 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'; + end; Chaine1:= '-'+Chaine1; end; Result:= FontName+Chaine1; @@ -485,7 +498,11 @@ procedure TPdfName.WriteName(const AFlux: TStream); begin if FValue<> '' then - WriteChaine('/'+FValue,AFlux); + if Pos('Length1',FValue)> 0 + then + WriteChaine('/Length1',AFlux) + else + WriteChaine('/'+FValue,AFlux); end; constructor TPdfName.CreateName(const AValue: string); @@ -665,6 +682,19 @@ begin WriteChaine('/F'+IntToStr(FTxtFont)+' '+FTxtSize+' Tf'+CRLF,AFlux); end; +function TPdfFonte.WriteFonteStream(const FFlux: TMemoryStream; const AFlux: TStream): Int64; +var + BeginFlux,EndFlux: Int64; +begin +WriteChaine(CRLF+'stream'+CRLF,AFlux); +BeginFlux:= AFlux.Position; +FFlux.SaveToStream(AFlux); +EndFlux:= AFlux.Position; +Result:= EndFlux-BeginFlux; +WriteChaine(CRLF,AFlux); +WriteChaine('endstream',AFlux); +end; + constructor TPdfFonte.CreateFonte(const AFont: Integer; const ASize: string); begin inherited Create; @@ -988,39 +1018,66 @@ end; procedure TPdfDictionary.WriteDictionary(const AObjet: Integer; const AFlux: TStream); var Long: TPdfInteger; - Flux: TMemoryStream; - Cpt,NumImg: Integer; + Cpt,NumImg,NumFnt: Integer; + Value: string; begin -WriteChaine('<<'+CRLF,AFlux); -for Cpt:= 0 to Pred(FElement.Count) do - TPdfDicElement(FElement[Cpt]).WriteDicElement(AFlux); -NumImg:= -1; -for Cpt:= 0 to Pred(FElement.Count) do - if AObjet> -1 +if TPdfName(TPdfDicElement(FElement[0]).FKey).FValue= '' +then + TPdfDicElement(FElement[0]).WriteDicElement(AFlux) // write a charwidth array of a font +else + begin + WriteChaine('<<'+CRLF,AFlux); + if FElement.Count> 0 then - begin - if (TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue= 'Name') - then - if (TPdfObjet(TPdfDicElement(FElement[Cpt]).FValue) is TPdfName) - and (TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue[1]= 'I') + for Cpt:= 0 to Pred(FElement.Count) do + TPdfDicElement(FElement[Cpt]).WriteDicElement(AFlux); + NumImg:= -1; + NumFnt:= -1; + if FElement.Count> 0 + then + for Cpt:= 0 to Pred(FElement.Count) do + if AObjet> -1 then begin - NumImg:= StrToInt(Copy(TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue,2,Length(TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue)-1)); - Flux:= TMemoryStream.Create; - Flux.Position:= 0; + if (TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue= 'Name') + then + if (TPdfObjet(TPdfDicElement(FElement[Cpt]).FValue) is TPdfName) + and (TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue[1]= 'I') + then + begin + NumImg:= StrToInt(Copy(TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue,2,Length(TPdfName(TPdfDicElement(FElement[Cpt]).FValue).FValue)-1)); + Flux:= TMemoryStream.Create; + Flux.Position:= 0; // write image stream length in xobject dictionary - Long:= TPdfInteger.CreateInteger(TPdfImage(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).WriteImageStream(NumImg,Flux)); - TPdfDictionary(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).AddElement('Length',Long); - TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AFlux); - Flux.Free; - WriteChaine('>>',AFlux); + Long:= TPdfInteger.CreateInteger(TPdfImage(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).WriteImageStream(NumImg,Flux)); + TPdfDictionary(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).AddElement('Length',Long); + TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AFlux); + Flux.Free; + WriteChaine('>>',AFlux); // write image stream in xobject dictionary - TPdfImage(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).WriteImageStream(NumImg,AFlux); + TPdfImage(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).WriteImageStream(NumImg,AFlux); + end; + if Pos('Length1',TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue)> 0 + then + begin + Flux:= TMemoryStream.Create; + Value:= TPdfName(TPdfDicElement(FElement[Cpt]).FKey).FValue; + NumFnt:= StrToInt(Copy(Value,Succ(Pos(' ',Value)),Length(Value)-Pos(' ',Value))); + Flux.LoadFromFile(FontFiles[NumFnt]); +// write fontfile stream length in xobject dictionary + Long:= TPdfInteger.CreateInteger(Flux.Size); + TPdfDictionary(TPdfXRef(Document.FXRefObjets[AObjet]).FObjet).AddElement('Length',Long); + TPdfDicElement(FElement[Pred(FElement.Count)]).WriteDicElement(AFlux); + WriteChaine('>>',AFlux); +// write fontfile stream in xobject dictionary + TPdfFonte(TPdfXRef(Document.FXRefObjets[NumFnt]).FObjet).WriteFonteStream(Flux,AFlux); + Flux.Free; + end; end; - end; -if NumImg= -1 -then - WriteChaine('>>',AFlux); + if (NumImg= -1) and (NumFnt= -1) + then + WriteChaine('>>',AFlux); + end; end; constructor TPdfDictionary.CreateDictionary; @@ -1303,8 +1360,12 @@ Page.FObjet.AddElement('Resources',Dictionaire); 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); +if Fonts.Count> 0 +then + begin + Dictionaire:= TPdfDictionary.CreateDictionary; + TPdfDictionary(TPdfDicElement(Page.FObjet.FElement[Pred(Page.FObjet.FElement.Count)]).FValue).AddElement('Font',Dictionaire); + end; for Cpt:= 0 to Pred(PdfPage.Count) do if TPdfElement(PdfPage[Cpt]) is TPdfImg then @@ -1385,7 +1446,7 @@ Outline.FObjet.AddElement('Dest',Table); Result:= Pred(FXRefObjets.Count); end; -procedure TPdfDocument.CreateFont(NomFonte: string; NumFonte: Integer); +procedure TPdfDocument.CreateStdFont(NomFonte: string; NumFonte: Integer); var Fontes: TPdfXRef; XRefObjets: TPdfReference; @@ -1393,6 +1454,10 @@ var Dictionaire: TPdfDictionary; Cpt: Integer; begin +if Pos('Italic',NomFonte)> 0 +then + NomFonte:= Copy(NomFonte,1,Pred(Pos('Italic',NomFonte)))+'Oblique'; +// AnsiReplaceText(NomFonte,'Italic','Oblique'); // add xref entry Fontes:= TPdfXRef.CreateXRef; FXRefObjets.Add(Fontes); @@ -1407,6 +1472,7 @@ Nom:= TPdfName.CreateName('WinAnsiEncoding'); Fontes.FObjet.AddElement('Encoding',Nom); // add firstchar element to font dictionary Nom:= TPdfName.CreateName('32'); +//Nom:= TPdfName.CreateName('0'); Fontes.FObjet.AddElement('FirstChar',Nom); // add lastchar element to font dictionary Nom:= TPdfName.CreateName('255'); @@ -1432,6 +1498,236 @@ for Cpt:= 1 to Pred(FXRefObjets.Count) do Dictionaire.AddElement(TPdfName(Nom).FValue,XRefObjets); end; end; +SetLength(FontFiles,Succ(Length(FontFiles))); +FontFiles[NumFonte]:= ''; +end; + +function TPdfDocument.LoadFont(NomFonte: string): string; +var + FileTxt: TextFile; + Ligne: widestring; +begin +if FileExists(FontDirectory+NomFonte+'.fnt') +then + begin + AssignFile(FileTxt,FontDirectory+NomFonte+'.fnt'); + Reset(FileTxt); + while not Eof(FileTxt) do + begin + Readln(FileTxt,Ligne); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'FontType' + then + FontDef.FType:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'FontName' + then + FontDef.FName:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Ascent' + then + FontDef.FAscent:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Descent' + then + FontDef.FDescent:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'CapHeight' + then + FontDef.FCapHeight:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Flags' + then + FontDef.FFlags:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'FontBBox' + then + FontDef.FFontBBox:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'ItalicAngle' + then + FontDef.FItalicAngle:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'StemV' + then + FontDef.FStemV:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'MissingWidth' + then + FontDef.FMissingWidth:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Encoding' + then + FontDef.FEncoding:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'FontFile' + then + FontDef.FFile:= FontDirectory+Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'OriginalSize' + then + FontDef.FOriginalSize:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'Diffs' + then + FontDef.FDiffs:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + if Copy(Ligne,1,Pred(Pos('=',Ligne)))= 'CharWidth' + then + FontDef.FCharWidth:= Copy(Ligne,Succ(Pos('=',Ligne)),Length(Ligne)-Pos('=',Ligne)); + end; + Result:= FontDef.FType; + end +else + ShowMessage('Font file '+NomFonte+'.fnt not found'); +end; + +procedure TPdfDocument.CreateTtfFont(const NumFonte: Integer); +var + Fontes: TPdfXRef; + XRefObjets: TPdfReference; + Nom: TPdfName; + Dictionaire: TPdfDictionary; + Value: TPdfInteger; + Cpt: Integer; +begin +// add xref entry +Fontes:= TPdfXRef.CreateXRef; +FXRefObjets.Add(Fontes); +// add type element to font dictionary +Nom:= TPdfName.CreateName('Font'); +Fontes.FObjet.AddElement('Type',Nom); +// add subtype element to font dictionary +Nom:= TPdfName.CreateName(FontDef.FType); +Fontes.FObjet.AddElement('Subtype',Nom); +// add encoding element to font dictionary +Nom:= TPdfName.CreateName('WinAnsiEncoding'); +Fontes.FObjet.AddElement('Encoding',Nom); +// add firstchar element to font dictionary +Value:= TPdfInteger.CreateInteger(32); +Fontes.FObjet.AddElement('FirstChar',Value); +// add lastchar element to font dictionary +Value:= TPdfInteger.CreateInteger(255); +Fontes.FObjet.AddElement('LastChar',Value); +// add basefont element to font dictionary +Nom:= TPdfName.CreateName(FontDef.FName); +Fontes.FObjet.AddElement('BaseFont',Nom); +// add name element to font dictionary +Nom:= TPdfName.CreateName('F'+IntToStr(NumFonte)); +Fontes.FObjet.AddElement('Name',Nom); +// add font reference to all page dictionary +for Cpt:= 1 to Pred(FXRefObjets.Count) do + begin + Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[Cpt]).FObjet); + if Dictionaire.FElement.Count> 0 + then + if TPdfName(TPdfDicElement(Dictionaire.FElement[0]).FValue).FValue= 'Page' + then + begin + Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Resources')]).FValue); + Dictionaire:= TPdfDictionary(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Font')]).FValue); + XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); + Dictionaire.AddElement(TPdfName(Nom).FValue,XRefObjets); + end; + end; +CreateFontDescriptor(NumFonte); +// add fontdescriptor reference to font dictionary +XRefObjets:= TPdfReference.CreateReference(FXRefObjets.Count-2); +Fontes.FObjet.AddElement('FontDescriptor',XRefObjets); +CreateFontWidth; +// add fontwidth reference to font dictionary +XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); +Fontes.FObjet.AddElement('Widths',XRefObjets); +SetLength(FontFiles,Succ(Length(FontFiles))); +FontFiles[NumFonte]:= FontDef.FFile; +end; + +procedure TPdfDocument.CreateTp1Font(const NumFonte: Integer); +begin + +end; + +procedure TPdfDocument.CreateFontDescriptor(const NumFonte: Integer); +var + FtDesc: TPdfXRef; + XRefObjets: TPdfReference; + Nom: TPdfName; + Value: TPdfInteger; + Table: TPdfArray; + Dictionaire: TPdfDictionary; +begin +// add xref entry +FtDesc:= TPdfXRef.CreateXRef; +FXRefObjets.Add(FtDesc); +// add type element to fontdescriptor dictionary +Nom:= TPdfName.CreateName('FontDescriptor'); +FtDesc.FObjet.AddElement('Type',Nom); +// add fontname element to fontdescriptor dictionary +Nom:= TPdfName.CreateName(FontDef.FName); +FtDesc.FObjet.AddElement('FontName',Nom); +// add ascent element to fontdescriptor dictionary +Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FAscent)); +FtDesc.FObjet.AddElement('Ascent',Value); +// add descent element to fontdescriptor dictionary +Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FDescent)); +FtDesc.FObjet.AddElement('Descent',Value); +// add capheight element to fontdescriptor dictionary +Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FCapHeight)); +FtDesc.FObjet.AddElement('CapHeight',Value); +// add flags element to fontdescriptor dictionary +Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FFlags)); +FtDesc.FObjet.AddElement('Flags',Value); +// add fontbbox element to fontdescriptor dictionary +Table:= TPdfArray.CreateArray; +FtDesc.FObjet.AddElement('FontBBox',Table); +// add coordinates in page fontbbox +while Pos(' ',FontDef.FFontBBox)> 0 do + begin + Dictionaire:= TPdfDictionary(TPdfXRef(FtDesc).FObjet); + Value:= TPdfInteger.CreateInteger(StrToInt(Copy(FontDef.FFontBBox,1,Pred(Pos(' ',FontDef.FFontBBox))))); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('FontBBox')]).FValue).AddItem(Value); + FontDef.FFontBBox:= Copy(FontDef.FFontBBox,Succ(Pos(' ',FontDef.FFontBBox)),Length(FontDef.FFontBBox)-Pos(' ',FontDef.FFontBBox));; + end; +// add italicangle element to fontdescriptor dictionary +Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FItalicAngle)); +FtDesc.FObjet.AddElement('ItalicAngle',Value); +// add stemv element to fontdescriptor dictionary +Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FStemV)); +FtDesc.FObjet.AddElement('StemV',Value); +// add missingwidth element to fontdescriptor dictionary +Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FMissingWidth)); +FtDesc.FObjet.AddElement('MissingWidth',Value); +CreateFontFile(NumFonte); +// add fontfilereference to fontdescriptor dictionary +XRefObjets:= TPdfReference.CreateReference(Pred(FXRefObjets.Count)); +FtDesc.FObjet.AddElement('FontFile2',XRefObjets); +end; + +procedure TPdfDocument.CreateFontWidth; +var + FtDesc: TPdfXRef; + XRefObjets: TPdfReference; + Value: TPdfInteger; + Table: TPdfArray; + Dictionaire: TPdfDictionary; +begin +// add xref entry +FtDesc:= TPdfXRef.CreateXRef; +FXRefObjets.Add(FtDesc); +// add element to fontwidth dictionary +Table:= TPdfArray.CreateArray; +FtDesc.FObjet.AddElement('',Table); +// add width values in fontwidth array +while Pos(' ',FontDef.FCharWidth)> 0 do + begin + Dictionaire:= TPdfDictionary(TPdfXRef(FtDesc).FObjet); + Value:= TPdfInteger.CreateInteger(StrToInt(Copy(FontDef.FCharWidth,1,Pred(Pos(' ',FontDef.FCharWidth))))); + TPdfArray(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('')]).FValue).AddItem(Value); + FontDef.FCharWidth:= Copy(FontDef.FCharWidth,Succ(Pos(' ',FontDef.FCharWidth)),Length(FontDef.FCharWidth)-Pos(' ',FontDef.FCharWidth));; + end; +end; + +procedure TPdfDocument.CreateFontFile(const NumFonte: Integer); +var + FtDesc: TPdfXRef; + XRefObjets: TPdfReference; + Nom: TPdfName; + Value: TPdfInteger; +begin +// add xref entry +FtDesc:= TPdfXRef.CreateXRef; +FXRefObjets.Add(FtDesc); +// add filter element to fontfile dictionary +Nom:= TPdfName.CreateName('FlateDecode'); +FtDesc.FObjet.AddElement('Filter',Nom); +// add length1 element to fontfile dictionary +Value:= TPdfInteger.CreateInteger(StrToInt(FontDef.FOriginalSize)); +FtDesc.FObjet.AddElement('Length1 '+IntToStr(NumFonte),Value); end; procedure TPdfDocument.CreateImage(ImgWidth,ImgHeight,NumImg: Integer); @@ -1593,12 +1889,12 @@ end; constructor TPdfDocument.CreateDocument(const ALayout: TPageLayout; const AZoom: string; const APreferences: Boolean); var - Cpt,CptSect,CptPage,NumFont,{NumImg,}TreeRoot,ParentPage,PageNum,NumPage: Integer; + Cpt,CptSect,CptPage,NumFont,TreeRoot,ParentPage,PageNum,NumPage: Integer; OutlineRoot,ParentOutline,PageOutline,NextOutline,NextSect,NewPage,PrevOutline,PrevSect: Integer; Dictionaire: TPdfDictionary; XRefObjets: TPdfReference; Nom: TPdfName; - FontName: string; + FontName,FtName: string; begin inherited Create; FPreferences:= APreferences; @@ -1741,15 +2037,39 @@ then Dictionaire:= TPdfDictionary(TPdfXRef(FXRefObjets[TreeRoot]).FObjet); TPdfInteger(TPdfDicElement(Dictionaire.FElement[Dictionaire.ElementParCle('Count')]).FValue).Value:= T_Section(Sections[CptSect]).TotPages; end; +if FontDirectory= '' +then + FontDirectory:= ExtractFilePath(Paramstr(0)); +// select the font type NumFont:= 0; -for Cpt:= 0 to Pred(Fonts.Count) do - begin - FontName:= ExtractBaseFontName(T_Font(Fonts[Cpt]).GetFont.FontDesc); - CreateFont(FontName,NumFont); - Inc(NumFont); - end; -for Cpt:= 0 to Pred(Images.Count) do - CreateImage(TfpgImage(Images[Cpt]).Width,TfpgImage(Images[Cpt]).Height,Cpt); +if Fonts.Count> 0 +then + for Cpt:= 0 to Pred(Fonts.Count) do + begin + FontName:= ExtractBaseFontName(T_Font(Fonts[Cpt]).GetFont.FontDesc); + if Pos('-',FontName)> 0 + then + FtName:= Copy(FontName,1,Pred(Pos('-',FontName))) + else + FtName:= FontName; + if (Lowercase(FtName)= 'courier') or (Lowercase(FtName)= 'helvetica') or (Lowercase(FtName)= 'times') + then + begin + FontName:= Uppercase(FontName[1])+Copy(FontName,2,Pred(Length(FontName))); + CreateStdFont(FontName,NumFont); + end + else + if LoadFont(FontName)= 'TrueType' + then + CreateTtfFont(NumFont) + else + CreateTp1Font(NumFont); // not implemented yet + Inc(NumFont); + end; +if Images.Count> 0 +then + for Cpt:= 0 to Pred(Images.Count) do + CreateImage(TfpgImage(Images[Cpt]).Width,TfpgImage(Images[Cpt]).Height,Cpt); TPdfInteger(TPdfDicElement(Trailer.FElement[Trailer.ElementParCle('Size')]).FValue).FValue:= FXRefObjets.Count; end; -- cgit v1.2.3-70-g09d2