paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-02-04 06:34:52 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Several fixes from Graeme Geldenhuys:

Browse Source 
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 -
This commit is contained in:
michael 2016-09-26 21:47:03 +00:00
parent db590da1e6
commit 5a58faa3d5
5 changed files with 65 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
packages/fcl-pdf/examples/testfppdf.lpr
View File

@ -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 +

8
packages/fcl-pdf/src/fpparsettf.pp
View File

@ -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;

57
packages/fcl-pdf/src/fppdf.pp
View File

@ -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;

15
packages/fcl-pdf/src/fpttf.pp
View File

@ -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;

4
packages/fcl-pdf/tests/fppdf_test.pas
View File

@ -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);