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

git-svn-id: trunk@36358 -

packages/fcl-pdf/src/fpparsettf.pp

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

packages/fcl-pdf/src/fpttf.pp

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

packages/fcl-pdf/tests/fpparsettf_test.pas

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