Get ttf font name from file

[hosune7845]

Hello.

I tried to install and use a font in Lazarus, but the font was not found as font file name.

I think the file name of font is not font name(TFont.name)

How can i find the name? any idea?

[Handoko]

Font name does not have to be the same as its file name. You can try font manager or something like that.

[hosune7845]

Font name does not have to be the same as its file name. You can try font manager or something like that.

Thanks for answer.

But i need to find the fond family name with file name and ttf file programely.

Is there way to load font from file in linux?

[Mr.Madguy]

Only thing, I can suggest - to try to extract this info from ttf file directly. Via this code for example:

Warning!!! Little-endian only! Comment EncodeWord and EncodeLong in case of Big-endian platform!

Code: Pascal  [Select][+][-]

1. unit FontInfo;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. function FindTrueTypeFontName(const AFileName:String):String;
8.  
9. implementation
10.  
11. uses Classes, SysUtils;
12.  
13. type
14.   TTrueTypeHeader = packed record
15.     MajorVersion:Word;
16.     MinorVersion:Word;
17.     NumOfTables:Word;
18.     SearchRange:Word;
19.     EntrySelector:Word;
20.     RangeShift:Word;
21.   end;
22.  
23.   TTrueTypeTableEntry = packed record
24.     Tag:array[0..3] of Char;
25.     CheckSum:Longword;
26.     Offset:Longword;
27.     Length:Longword;
28.   end;
29.  
30.   TTrueTypeNameTableHeader = packed record
31.     Selector:Word;
32.     Count:Word;
33.     Offset:Word;
34.   end;
35.  
36.   TTrueTypeNameRecord = packed record
37.     PlatformID:Word;
38.     EncodingID:Word;
39.     LanguageID:Word;
40.     NameID:Word;
41.     Length:Word;
42.     Offset:Word;
43.   end;
44.  
45.   TWord = packed record
46.     LowByte:Byte;
47.     HighByte:Byte;
48.   end;
49.  
50.   TLongword = packed record
51.     LowByte:Byte;
52.     MiddleWord:Word;
53.     HighByte:Byte;
54.   end;
55.  
56. function EncodeWord(AWord:Word):Word;inline;
57. begin
58.   TWord(Result).LowByte := TWord(AWord).HighByte;
59.   TWord(Result).HighByte := TWord(AWord).LowByte;
60. end;
61.  
62. function EncodeLong(ALong:Longword):Longword;inline;
63. begin
64.   TLongword(Result).LowByte := TLongword(ALong).HighByte;
65.   TLongword(Result).MiddleWord := EncodeWord(TLongword(ALong).MiddleWord);
66.   TLongword(Result).HighByte := TLongword(ALong).LowByte;
67. end;  
68.  
69. function FindTrueTypeFontName(const AFileName:String):String;
70.   var Stream:TStream;
71.   Found:Boolean;
72.   I, J, TableEntryCount, NameRecordCount, Len:Integer;
73.   StorageOffset:Longword;
74.   Header:TTrueTypeHeader;
75.   TrueTypeTableEntry:TTrueTypeTableEntry;
76.   TrueTypeNameTableHeader:TTrueTypeNameTableHeader;
77.   TrueTypeNameRecord:TTrueTypeNameRecord;
78.   Temp1:AnsiString;Temp2:UnicodeString;
79. begin
80.   Result := '';
81.   try
82.     try
83.       Stream := TFileStream.Create(AFileName, fmOpenRead);
84.       Stream.Read(Header, SizeOf(Header));
85.       TableEntryCount := EncodeWord(Header.NumOfTables);
86.       Found := False;
87.       for I := 0 to TableEntryCount - 1 do begin
88.         Stream.Read(TrueTypeTableEntry, SizeOf(TrueTypeTableEntry));
89.         if CompareText(TrueTypeTableEntry.Tag, 'name') = 0 then begin
90.           Found := True;
91.           Break;
92.         end;
93.       end;
94.       if Found then begin
95.         StorageOffset := EncodeLong(TrueTypeTableEntry.Offset);
96.         Stream.Seek(StorageOffset, soBeginning);
97.         Stream.Read(TrueTypeNameTableHeader, SizeOf(TrueTypeNameTableHeader));
98.         StorageOffset := StorageOffset + EncodeWord(TrueTypeNameTableHeader.Offset);
99.         NameRecordCount := EncodeWord(TrueTypeNameTableHeader.Count);
100.         for I := 0 to NameRecordCount - 1 do begin
101.           Stream.Read(TrueTypeNameRecord, SizeOf(TrueTypeNameRecord));
102.           if EncodeWord(TrueTypeNameRecord.NameID) = 1 then begin
103.             Len := EncodeWord(TrueTypeNameRecord.Length);
104.             {Platform and Encoding stuff!!!}
105.             if (EncodeWord(TrueTypeNameRecord.PlatformID) = 1) or (
106.               (EncodeWord(TrueTypeNameRecord.PlatformID) = 3) and
107.               (EncodeWord(TrueTypeNameRecord.EncodingID) = 0)
108.             )
109.             then begin
110.               {ANSI}
111.               SetLength(Temp1, Len);
112.               Stream.Seek(StorageOffset + EncodeWord(TrueTypeNameRecord.Offset), soBeginning);
113.               Stream.Read(Temp1[1], Len);
114.               Result := UTF8Encode(Temp1);
115.             end
116.             else begin
117.               {Unicode}
118.               SetLength(Temp2, Len shr 1);
119.               Stream.Seek(StorageOffset + EncodeWord(TrueTypeNameRecord.Offset), soBeginning);
120.               Stream.Read(Temp2[1], Len);
121.               for J := 1 to Length(Temp2) do begin
122.                 Word(Temp2[J]) := EncodeWord(Word(Temp2[J]));
123.               end;
124.               Result := UTF8Encode(Temp2);
125.             end;
126.             Break;
127.           end;
128.         end;
129.       end;
130.     finally
131.       Stream.Free;
132.     end;
133.   except
134.     {Just ignore exceptions}
135.   end;
136. end;
137.  
138. end.
139.  

The only messy thing - is platform IDs and encoding IDs. Sometimes it's AnsiString with specific encoding, sometimes it's Unicode. You can use this article as reference, if you will have some problems.

Example project:

Code: Pascal  [Select][+][-]

1. unit TestName;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, FontInfo;
9.  
10. type
11.  
12.   { TFontTestForm }
13.  
14.   TFontTestForm = class(TForm)
15.     FontNameLabel: TLabel;
16.     procedure FormCreate(Sender: TObject);
17.   private
18.     { private declarations }
19.   public
20.     { public declarations }
21.   end;
22.  
23. var
24.   FontTestForm: TFontTestForm;
25.  
26. implementation
27.  
28. {$R *.lfm}
29.  
30. { TFontTestForm }
31.  
32. procedure TFontTestForm.FormCreate(Sender: TObject);
33. begin
34.   FontNameLabel.Caption := FindTrueTypeFontName('times.ttf');
35. end;
36.  
37. end.
38.  

[marcov]

(there are some ttf units part of fcl-pdf. Check out trunk or fixes_3_0)