Explorar o código

* Several fixes from Graeme Geldenhuys:
fppdf: test project page number output is now more dynamic.
pdf+ttf: replace string constants with resource strings.
pdf: removes the unused color parameter from TPDFDocument.AddFont().
pdf: update "testfppdf" application due to TPDFDocument.AddFont() changes.
pdf tests: fix failing tests due to TPDFDocument.AddFont() changes.
------------------------------------------------------------------------

git-svn-id: trunk@34563 -

michael %!s(int64=8) %!d(string=hai) anos
pai
achega
5a58faa3d5

+ 20 - 17
packages/fcl-pdf/examples/testfppdf.lpr

@@ -1,5 +1,5 @@
 { This program generates a multi-page PDF document and tests various
-  functionality on each of the 5 pages.
+  functionality on each of the pages.
 
   You can also specify to generate single pages by using the -p <n>
   command line parameter.
@@ -54,6 +54,8 @@ type
 var
   Application: TPDFTestApp;
 
+const
+  cPageCount: integer = 7;
 
 function TPDFTestApp.SetUpDocument: TPDFDocument;
 var
@@ -83,7 +85,7 @@ begin
 
   Result.StartDocument;
   S := Result.Sections.AddSection; // we always need at least one section
-  lPageCount := 7;
+  lPageCount := cPageCount;
   if Fpg <> -1 then
     lPageCount := 1;
   for i := 1 to lPageCount do
@@ -129,9 +131,9 @@ begin
   P := D.Pages[APage];
 
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clRed);
-  FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans', clGreen); // TODO: this color value means nothing - not used at all
-  FtText2 := D.AddFont('Times-BoldItalic', clBlack);
+  FtTitle := D.AddFont('Helvetica');
+  FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans'); // TODO: this color value means nothing - not used at all
+  FtText2 := D.AddFont('Times-BoldItalic');
   // FtText3 := D.AddFont('arial.ttf', 'Arial', clBlack);
   FtText3 := FtText1; // to reduce font dependecies, but above works too if you have arial.ttf available
 
@@ -150,7 +152,7 @@ begin
   P.AddExternalLink(54, 58, 49, 5, 'http://www.freepascal.org', false);
 
   P.SetFont(ftText2,16);
-  P.SetColor($c00000, false);
+  P.SetColor($C00000, false);
   P.WriteText(60, 100, '(60mm,100mm) Times-BoldItalic: Big text at absolute position');
 
   // -----------------------------------
@@ -184,7 +186,7 @@ var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -227,7 +229,7 @@ var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clRed);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -265,7 +267,7 @@ Var
 begin
   P := D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -299,7 +301,7 @@ var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -415,7 +417,7 @@ var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -451,7 +453,7 @@ begin
   P.Orientation := ppoLandscape;
 
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -515,9 +517,9 @@ begin
   if HasOption('p', '') then
   begin
     Fpg := StrToInt(GetOptionValue('p', ''));
-    if (Fpg < 1) or (Fpg > 7) then
+    if (Fpg < 1) or (Fpg > cPageCount) then
     begin
-      Writeln('Error in -p parameter. Valid range is 1-7.');
+      Writeln(Format('Error in -p parameter. Valid range is 1-%d.', [cPageCount]));
       Writeln('');
       Terminate;
       Exit;
@@ -569,9 +571,10 @@ procedure TPDFTestApp.WriteHelp;
 begin
   writeln('Usage:');
   writeln('    -h          Show this help.');
-  writeln('    -p <n>      Generate only one page. Valid range is 1-7.' + LineEnding +
-          '                If this option is not specified, then all 7 pages are' + LineEnding +
-          '                generated.');
+  writeln(Format(
+          '    -p <n>      Generate only one page. Valid range is 1-%d.' + LineEnding +
+          '                If this option is not specified, then all %0:d pages are' + LineEnding +
+          '                generated.', [cPageCount]));
   writeln('    -f <0|1>    Toggle embedded font compression. A value of 0' + LineEnding +
           '                disables compression. A value of 1 enables compression.');
   writeln('    -t <0|1>    Toggle text compression. A value of 0' + LineEnding +

+ 5 - 3
packages/fcl-pdf/src/fpparsettf.pp

@@ -359,6 +359,8 @@ implementation
 
 resourcestring
   rsFontEmbeddingNotAllowed = 'Font licence does not allow embedding';
+  rsErrNoFormat4MapTable = 'No Format 4 map (unicode) table found <%s - %s>';
+  rsErrUnexpectedUnicodeSubtable = 'Unexpected unicode subtable format, expected 4, got %s';
 
 Function GetTableType(Const AName : String) : TTTFTableType;
 begin
@@ -525,12 +527,12 @@ begin
   While (UE>=0) and ((FSubtables[UE].PlatformID<>3) or (FSubtables[UE].EncodingID<> 1)) do
     Dec(UE);
   if (UE=-1) then
-    Raise ETTF.Create('No Format 4 map (unicode) table found <'+FFileName + ' - ' + PostScriptName+'>');
+    Raise ETTF.CreateFmt(rsErrNoFormat4MapTable, [FFileName, PostScriptName]);
   TT:=TableStartPos+FSubtables[UE].Offset;
   AStream.Position:=TT;
   FUnicodeMap.Format:= ReadUShort(AStream);               // 2 bytes - Format of subtable
   if (FUnicodeMap.Format<>4) then
-    Raise ETTF.CreateFmt('Unexpected unicode subtable format, expected 4, got %s',[FUnicodeMap.Format]);
+    Raise ETTF.CreateFmt(rsErrUnexpectedUnicodeSubtable, [FUnicodeMap.Format]);
   FUnicodeMap.Length:=ReadUShort(AStream);
   S:=TMemoryStream.Create;
   try
@@ -939,7 +941,7 @@ function TTFFileInfo.GetMissingWidth: integer;
 begin
   if FMissingWidth = 0 then
   begin
-    FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth;  // Char(32) - Space character
+    FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth;  // 32 is in reference to the Space character
   end;
   Result := FMissingWidth;
 end;

+ 26 - 31
packages/fcl-pdf/src/fppdf.pp

@@ -13,6 +13,12 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
+
+    LOCALISATION NOTICE:
+       Most of the string constants in this unit should NOT be localised,
+       as they are specific constants used in the PDF Specification document.
+       If you do localise anything, make sure you know what you are doing.
+
  **********************************************************************}
 unit fpPDF;
 
@@ -654,7 +660,6 @@ type
 
   TPDFFont = CLass(TCollectionItem)
   private
-    FColor: TARGBColor;
     FIsStdFont: boolean;
     FName: String;
     FFontFilename: String;
@@ -670,7 +675,6 @@ type
     procedure   AddTextToMappingList(const AText: UnicodeString);
     Property    FontFile: string read FFontFilename write SetFontFilename;
     Property    Name: String Read FName Write FName;
-    Property    Color: TARGBColor Read FColor Write FColor;
     property    TextMapping: TTextMappingList read FTextMappingList;
     property    IsStdFont: boolean read FIsStdFont write FIsStdFont;
   end;
@@ -921,8 +925,8 @@ type
     Function CreateXRef : TPDFXRef;
     Function CreateArray : TPDFArray;
     Function CreateImage(const ALeft, ABottom, AWidth, AHeight: TPDFFloat; ANumber: integer) : TPDFImage;
-    Function AddFont(AName : String; AColor : TARGBColor = clBlack) : Integer; overload;
-    Function AddFont(AFontFile: String; AName : String; AColor : TARGBColor = clBlack) : Integer; overload;
+    Function AddFont(AName : String) : Integer; overload;
+    Function AddFont(AFontFile: String; AName : String) : Integer; overload;
     Function AddLineStyleDef(ALineWidth : TPDFFloat; AColor : TARGBColor = clBlack; APenStyle : TPDFPenStyle = ppsSolid) : Integer;
     Property Options : TPDFOptions Read FOptions Write FOPtions;
     property PageLayout: TPDFPageLayout read FPageLayout write FPageLayout default lSingle;
@@ -1000,14 +1004,14 @@ function PDFCoord(x, y: TPDFFloat): TPDFCoord;
 implementation
 
 
-Resourcestring
+resourcestring
   rsErrReportFontFileMissing = 'Font File "%s" does not exist.';
-  SErrDictElementNotFound = 'Error: Dictionary element "%s" not found.';
-  SerrInvalidSectionPage = 'Error: Invalid section page index.';
-  SErrNoGlobalDict = 'Error: no global XRef named "%s".';
-  SErrInvalidPageIndex = 'Invalid page index: %d';
-  SErrInvalidAnnotIndex = 'Invalid annot index: %d';
-  SErrNoFontIndex = 'No FontIndex was set - please use SetFont() first.';
+  rsErrDictElementNotFound = 'Error: Dictionary element "%s" not found.';
+  rsErrInvalidSectionPage = 'Error: Invalid section page index.';
+  rsErrNoGlobalDict = 'Error: no global XRef named "%s".';
+  rsErrInvalidPageIndex = 'Invalid page index: %d';
+  rsErrInvalidAnnotIndex = 'Invalid annot index: %d';
+  rsErrNoFontIndex = 'No FontIndex was set - please use SetFont() first.';
 
 type
   // to get access to protected methods
@@ -1577,7 +1581,7 @@ begin
   if Assigned(Flist) then
     Result:=TPDFPage(FList[Aindex])
   else
-    Raise EListError.CreateFmt(SErrInvalidPageIndex,[AIndex]);
+    Raise EListError.CreateFmt(rsErrInvalidPageIndex,[AIndex]);
 end;
 
 function TPDFPages.GetPageCount: integer;
@@ -1638,7 +1642,7 @@ begin
   if Assigned(FList) then
     Result := TPDFAnnot(FList[AIndex])
   else
-    raise EListError.CreateFmt(SErrInvalidAnnotIndex, [AIndex]);
+    raise EListError.CreateFmt(rsErrInvalidAnnotIndex, [AIndex]);
 end;
 
 destructor TPDFAnnotList.Destroy;
@@ -1860,7 +1864,7 @@ var
   p: TPDFCoord;
 begin
   if FFontIndex = -1 then
-    raise EPDF.Create(SErrNoFontIndex);
+    raise EPDF.Create(rsErrNoFontIndex);
   p := Matrix.Transform(X, Y);
   DoUnitConversion(p);
   if Document.Fonts[FFontIndex].IsStdFont then
@@ -2047,7 +2051,7 @@ begin
   If Assigned(FPages) then
     Result:=TPDFPage(FPages[Aindex])
   else
-    Raise EPDF.CreateFmt(SerrInvalidSectionPage,[AIndex]);
+    Raise EPDF.CreateFmt(rsErrInvalidSectionPage,[AIndex]);
 end;
 
 function TPDFSection.GetP: INteger;
@@ -2233,7 +2237,7 @@ begin
 
         Str.WriteByte(C.Red shr 8);
         Str.WriteByte(C.Green shr 8);
-        Str.WriteByte(C.blue shr 8);
+        Str.WriteByte(C.Blue shr 8);
         end;
     if Str<>MS then
       Str.Free;
@@ -3161,7 +3165,7 @@ function TPDFDictionary.ElementByName(const AKey: String): TPDFDictionaryItem;
 begin
   Result:=FindElement(AKey);
   If (Result=Nil) then
-    Raise EPDF.CreateFmt(SErrDictElementNotFound,[AKey]);
+    Raise EPDF.CreateFmt(rsErrDictElementNotFound,[AKey]);
 end;
 
 function TPDFDictionary.ValueByName(const AKey: String): TPDFObject;
@@ -3207,7 +3211,7 @@ end;
 constructor TPDFInfos.Create;
 begin
   inherited Create;
-  FProducer := 'fpGUI Toolkit 0.8';
+  FProducer := 'fpGUI Toolkit 1.4';
 end;
 
 
@@ -3664,8 +3668,7 @@ begin
   FDict.AddInteger('MissingWidth', Fonts[EmbeddedFontNum].FTrueTypeFile.MissingWidth);
   if (poNoEmbeddedFonts in Options) then
   begin
-    //CreateFontFileEntry(EmbeddedFontNum);
-    //FDict.AddReference('FontFile2',GlobalXRefCount-1);
+    // do nothing
   end
   else
   begin
@@ -3694,12 +3697,10 @@ begin
 end;
 
 procedure TPDFDocument.CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer);
-
 var
   N: TPDFName;
   IDict,ADict: TPDFDictionary;
   i: integer;
-
 begin
   IDict:=CreateGlobalXRef.Dict;
   IDict.AddName('Type','XObject');
@@ -3817,7 +3818,7 @@ function TPDFDocument.GlobalXRefByName(const AName: String): TPDFXRef;
 begin
   Result:=FindGlobalXRef(AName);
   if Result=Nil then
-    Raise EPDF.CreateFmt(SErrNoGlobalDict,[AName]);
+    Raise EPDF.CreateFmt(rsErrNoGlobalDict,[AName]);
 end;
 
 function TPDFDocument.CreateLineStyles: TPDFLineStyleDefs;
@@ -4064,10 +4065,8 @@ begin
 end;
 
 procedure TPDFDocument.CreateImageEntries;
-
 Var
   I : Integer;
-
 begin
   for i:=0 to Images.Count-1 do
     CreateImageEntry(Images[i].Width,Images[i].Height,i);
@@ -4091,10 +4090,8 @@ begin
 end;
 
 procedure TPDFDocument.SaveToStream(const AStream: TStream);
-
 var
   i, XRefPos: integer;
-
 begin
   CreateSectionsOutLine;
   CreateFontEntries;
@@ -4216,7 +4213,7 @@ begin
   Result:=TPDFImage.Create(Self,ALeft,ABottom,AWidth,AHeight,ANumber);
 end;
 
-function TPDFDocument.AddFont(AName: String; AColor : TARGBColor = clBlack): Integer;
+function TPDFDocument.AddFont(AName: String): Integer;
 var
   F: TPDFFont;
   i: integer;
@@ -4232,12 +4229,11 @@ begin
   end;
   F := Fonts.AddFontDef;
   F.Name := AName;
-  F.Color := AColor;
   F.IsStdFont := True;
   Result := Fonts.Count-1;
 end;
 
-function TPDFDocument.AddFont(AFontFile: String; AName: String; AColor: TARGBColor): Integer;
+function TPDFDocument.AddFont(AFontFile: String; AName: String): Integer;
 var
   F: TPDFFont;
   i: integer;
@@ -4261,7 +4257,6 @@ begin
     lFName := IncludeTrailingPathDelimiter(FontDirectory)+AFontFile;
   F.FontFile := lFName;
   F.Name := AName;
-  F.Color := AColor;
   F.IsStdFont := False;
   Result := Fonts.Count-1;
 end;

+ 12 - 3
packages/fcl-pdf/src/fpttf.pp

@@ -1,11 +1,22 @@
 {
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2015 by Graeme Geldenhuys
+
     Description:
       This is a homegrown font cache. The fpReport reports can reference
       a font by its name. The job of the font cache is to look through
       its cached fonts to match the font name, and which *.ttf file it
       relates too. The reporting code can then extract font details
       correctly (eg: font width, height etc).
-}
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
 unit fpTTF;
 
 {$mode objfpc}{$H+}
@@ -65,8 +76,6 @@ type
   end;
 
 
-  { TFPFontCacheList }
-
   TFPFontCacheList = class(TObject)
   private
     FBuildFontFacheIgnoresErrors: Boolean;

+ 2 - 2
packages/fcl-pdf/tests/fppdf_test.pas

@@ -655,7 +655,7 @@ var
   s8: UTF8String;
 begin
   PDF.Options := []; // disable all compression
-  fnt := PDF.AddFont(cFont1, 'Liberation Sans', clBlack);
+  fnt := PDF.AddFont(cFont1, 'Liberation Sans');
   o := TPDFUTF8String.Create(PDF, 'TestT', fnt);
   try
     AssertEquals('Failed on 1', '', S.DataString);
@@ -685,7 +685,7 @@ var
   o: TPDFUTF8String;
   fnt: integer;
 begin
-  fnt := PDF.AddFont(cFont1, 'Liberation Sans', clBlack);
+  fnt := PDF.AddFont(cFont1, 'Liberation Sans');
   o := TPDFUTF8String.Create(PDF, 'a(b)c\def/g', fnt);
   try
     AssertEquals('Failed on 1', '', S.DataString);