paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 19:29:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Graeme Geldenhuys to test reading human-friendly name

Browse Source 
git-svn-id: trunk@36358 -
This commit is contained in:
michael 2017-05-28 08:50:28 +00:00
parent 5d360ea1c4
commit 6a22c5afae
3 changed files with 38 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -289,6 +289,7 @@ Type
CharBase: PTTFEncodingNames;
PostScriptName: string;
FamilyName: string;
HumanFriendlyName: string; // aka FullName
destructor Destroy; override;
{ Returns the Glyph Index value in the TTF file, where AValue is the ordinal value of a character. }
function GetGlyphIndex(AValue: word): word;
@ -660,15 +661,23 @@ begin
writeln('NameID = ', E[i].Info.NameID);
writeln('Value = ', E[i].Value);
{$ENDIF}
if (PostScriptName='')
and (E[i].Info.NameID=NameIDPostScriptName)
and (E[i].Info.EncodingID=NameMSEncodingUGL) then
PostScriptName:=E[i].Value;
if (FamilyName = '')
and (E[i].Info.NameID = NameIDFontFamily)
and (E[i].Info.LanguageID = 1033)
and (E[i].Info.EncodingID = 1) then
FamilyName := E[i].Value;
if (HumanFriendlyName = '')
and (E[i].Info.NameID = NameIDFullFontName)
and (E[i].Info.LanguageID = 1033)
and (E[i].Info.EncodingID = 1) then
HumanFriendlyName := E[i].Value;
end; { for i ... }
end;

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

@ -49,6 +49,7 @@ type
FFileInfo: TTFFileInfo;
FOwner: TFPFontCacheList; // reference to FontCacheList that owns this instance
FPostScriptName: string;
FHumanFriendlyName: string; // aka FullName
procedure DoLoadFileInfo;
procedure LoadFileInfo;
procedure BuildFontCacheItem;
@ -59,6 +60,7 @@ type
function GetIsRegular: boolean;
function GetFamilyName: String;
function GetPostScriptName: string;
function GetHumanFriendlyName: string;
function GetFileInfo: TTFFileInfo;
public
constructor Create(const AFilename: String);
@ -70,6 +72,7 @@ type
property FileName: String read FFileName;
property FamilyName: String read GetFamilyName;
property PostScriptName: string read GetPostScriptName;
property HumanFriendlyName: string read GetHumanFriendlyName;
property FontData: TTFFileInfo read GetFileInfo;
{ A bitmasked value describing the full font style }
property StyleFlags: TTrueTypeFontStyles read FStyleFlags;
@ -203,6 +206,12 @@ begin
Result := FPostScriptName;
end;
function TFPFontCacheItem.GetHumanFriendlyName: string;
begin
DoLoadFileInfo;
Result := FHumanFriendlyName;
end;
function TFPFontCacheItem.GetFileInfo: TTFFileInfo;
begin
DoLoadFileInfo;
@ -218,6 +227,7 @@ begin
FFamilyName := FFileInfo.FamilyName;
if Pos(s, FFamilyName) = 1 then
Delete(s, 1, Length(FFamilyName));
FHumanFriendlyName := FFileInfo.HumanFriendlyName;
FStyleFlags := [fsRegular];

19
packages/fcl-pdf/tests/fpparsettf_test.pas
View File

@ -197,6 +197,7 @@ type
{ General info }
procedure TestPostScriptName;
procedure TestFamilyName;
procedure TestHumanFriendlyName;
end;
@ -210,6 +211,7 @@ type
{ General info }
procedure TestPostScriptName;
procedure TestFamilyName;
procedure TestHumanFriendlyName;
end;
@ -370,6 +372,7 @@ type
{ General info }
procedure TestPostScriptName;
procedure TestFamilyName;
procedure TestHumanFriendlyName;
end;
implementation
@ -1181,6 +1184,11 @@ begin
AssertEquals('Failed on 1', 'Liberation Sans', FI.FamilyName);
end;
procedure TTestLiberationFont.TestHumanFriendlyName;
begin
AssertEquals('Failed on 1', 'Liberation Sans', FI.HumanFriendlyName);
end;
{ TTestLiberationItalicFont }
procedure TTestLiberationItalicFont.SetUp;
@ -1208,6 +1216,11 @@ begin
AssertEquals('Failed on 1', 'Liberation Sans', FI.FamilyName);
end;
procedure TTestLiberationItalicFont.TestHumanFriendlyName;
begin
AssertEquals('Failed on 1', 'Liberation Sans Italic', FI.HumanFriendlyName);
end;
{ TTestFreeSansFont }
procedure TTestFreeSansFont.SetUp;
@ -1964,6 +1977,12 @@ begin
AssertEquals('Failed on 1', 'FreeSans', FI.FamilyName);
end;
procedure TTestFreeSansFont.TestHumanFriendlyName;
begin
AssertEquals('Failed on 1', 'FreeSans', FI.HumanFriendlyName);
end;
initialization
RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestEmptyParseTTF{$ifdef fptest}.Suite{$endif});
RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestLiberationFont{$ifdef fptest}.Suite{$endif});