Recent

Author Topic: Get ttf font name from file  (Read 3666 times)

hosune7845

  • Full Member
  • ***
  • Posts: 159
Get ttf font name from file
« on: June 26, 2017, 08:51:21 am »
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

  • Hero Member
  • *****
  • Posts: 5130
  • My goal: build my own game engine using Lazarus
Re: Get ttf font name from file
« Reply #1 on: June 26, 2017, 08:55:11 am »
Font name does not have to be the same as its file name. You can try font manager or something like that.

hosune7845

  • Full Member
  • ***
  • Posts: 159
Re: Get ttf font name from file
« Reply #2 on: June 26, 2017, 09:04:06 am »
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?
« Last Edit: June 26, 2017, 09:11:32 am by hosune7845 »

Mr.Madguy

  • Hero Member
  • *****
  • Posts: 844
Re: Get ttf font name from file
« Reply #3 on: June 26, 2017, 01:24:44 pm »
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.  
« Last Edit: June 26, 2017, 02:04:44 pm by Mr.Madguy »
Is it healthy for project not to have regular stable releases?
Just for fun: Code::Blocks, GCC 13 and DOS - is it possible?

marcov

  • Administrator
  • Hero Member
  • *
  • Posts: 11383
  • FPC developer.
Re: Get ttf font name from file
« Reply #4 on: June 26, 2017, 01:29:36 pm »
(there are some ttf units part of fcl-pdf. Check out trunk or fixes_3_0)

 

TinyPortal © 2005-2018