Board index » delphi » Font name from TTF file ?

Font name from TTF file ?

Is there a way to determine a fonts working name from the ttf file?

I need to select, and use an abitrary font from disk - not knowing
ahead of time what that font is called.

Thanks,

Roy.

r...@spang.org

 

Re:Font name from TTF file ?


Quote
Roy Coates wrote:

> Is there a way to determine a fonts working name from the ttf file?

> I need to select, and use an abitrary font from disk - not knowing
> ahead of time what that font is called.

> Thanks,

> Roy.

> r...@spang.org

You can get a list of all fonts installed, would that do?

Re:Font name from TTF file ?


Quote
Alan MacArthur wrote:

> Roy Coates wrote:

> > Is there a way to determine a fonts working name from the ttf file?

> > I need to select, and use an abitrary font from disk - not knowing
> > ahead of time what that font is called.

> > Thanks,

> > Roy.

> > r...@spang.org

> You can get a list of all fonts installed, would that do?

No, I think he wants to do something like a font manager wich displays (so
far) *uninstalled* fonts contained on a disk.

-Michael

Re:Font name from TTF file ?


Quote
Roy Coates <r...@mechnet.liv.ac.uk> wrote in message

news:7t30hv$am4$1@news.liv.ac.uk...

Quote
> Is there a way to determine a fonts working name from the ttf file?

> I need to select, and use an abitrary font from disk - not knowing
> ahead of time what that font is called.

This does the trick - I didn't write it, and I've lost the name of the
author (if you're listening, come and take the credit <g>)

function GetTypeFaceName(TrueTypeFile: string): string;
var
  I, FileHandle   : Integer;
  TableDirectory   : TTableDirectory;
  NamingTable    : TNamingTable;
  NameRecord     : TNameRecord;
  LongSwap      : LongInt;
  Buffer       : array[0..255] of Char;
  WideResult     : string;
  MSNameFound    : Boolean;

begin
  MSNameFound  := False;
  Result   := '';
  Buffer   := '';
  WideResult  := '';
  FileHandle  := FileOpen(TrueTypeFile, fmOpenRead);
  if FileHandle < 0 then Exit;

  FileSeek(FileHandle, 12, 0);
  repeat
    if FileRead(FileHandle,
                TableDirectory,
                SizeOf(TableDirectory)) < SizeOf(TableDirectory) then begin
      FileClose(FileHandle);
      Exit;
    end;
  until TableDirectory.Tag = $656D616E;  // tag_NamingTable - Name

  LongSwap := TableDirectory.Offset shr 16;
  TableDirectory.Offset := Swap(TableDirectory.Offset) shl 16 + Swap(LongSwap);
  FileSeek(FileHandle, TableDirectory.Offset, 0);
  FileRead(FileHandle, NamingTable, SizeOf(NamingTable));

  repeat
    if FileRead(FileHandle, NameRecord, SizeOf(NameRecord)) < SizeOf(NameRecord)
then begin
      FileSeek(FileHandle, TableDirectory.Offset, 0);
      FileRead(FileHandle, NamingTable, SizeOf(NamingTable));
      repeat
        if FileRead(FileHandle, NameRecord, SizeOf(NameRecord)) <
SizeOf(NameRecord) then begin
        FileClose(FileHandle);
        Exit;
        end;
      until (Swap(NameRecord.PlatformID) = 3) and (Swap(NameRecord.NameID) = 4);
      MSNameFound := True;
      Break;
    end;
  until (Swap(NameRecord.PlatformID) = 1) and (Swap(NameRecord.NameID) = 4);

  FileSeek(FileHandle,
           Swap(NamingTable.StringOffset) + Swap(NameRecord.Offset) +
TableDirectory.Offset,
           0);
  FileRead(FileHandle, Buffer, Swap(NameRecord.Length));
  NameRecord.Length := Swap(NameRecord.Length);

  if not MSNameFound then
   WideResult := Copy(Buffer, 0, NameRecord.Length)
  else begin
    I := 1;
    repeat
      WideResult := WideResult + Buffer[I];
      Inc(I, 2);
    until I > NameRecord.Length;
  end;

  Result := WideResult;
  FileClose(FileHandle);
end;

If you want to know *why* it works, you can get the format of a
TTF file at http://www.wotsit.org/

--
Jeremy Collins
Kansai Business Systems
http://www.kansai.co.uk/

Re:Font name from TTF file ?


In article <938859913.7844.1.nnrp-01.c2de6...@news.demon.co.uk>, "Jeremy

Quote
Collins" <jer...@kansai.co.uk> writes:
>This does the trick - I didn't write it, and I've lost the name of the
>author (if you're listening, come and take the credit <g>)

>function GetTypeFaceName(TrueTypeFile: string): string;
>var

That's OK if you've got Delphi 4+ which I presume has the record definition,
the following will work for Delphi 3. You have to wander through the Tables,
Names and Strings to get it, as well as converting "BigEndian" values to
"LittleEndian" - great fun <g>. I also found that some of the common Windows 95
fonts (eg Arail) had a PlatformId of 1 (==Macintosh) - how strange :-

function GetFontName(FontFileName : string ) : string;
(*== Start Sub-functions ===================================*)
  function SwapWord(AValue : word) : Word;
  begin
    Result := ((AValue and $00FF) shl 8)
              + ((Avalue and $FF00) shr 8);
  end;

  function SwapDWord(AValue : DWord) : DWord;
  begin
    Result := ((AValue and $000000FF) shl 24)
              + ((Avalue and $0000FF00) shl 8)
              + ((Avalue and $00FF0000) shr 8)
              + ((Avalue and $FF000000) shr 24);
  end;
(*== End Sub-functions =====================================*)
type
  TOffsetTable = packed record
    SfntVersionHi : Word;
    SfntVersionLo : Word;
    NumTables : Word;
    SearchRange : Word;
    EntrySelector : Word;
    RangeShift : Word;
  end;
  TTableDirectory = packed record
    Tag : longint;
    CheckSum : longint;
    Offset : longint;
    Length : longint;
  end;
  TNameTableHdr = packed record
    FormatSelector : Word;
    NameRecordCount : Word;
    Offset : Word;
   end;
   TNameRecord = packed record
     PlatformID : word;
     EncodingID : word;
     LanguageID : word;
     NameID : word;
     NameLen : word;
     NameOffset : word;
   end;
const
  Name : array[0..3] of char = ('n', 'a', 'm', 'e');
var
  NameDW : DWord absolute Name; // reverses order of chars
  MemStrm : TMemoryStream;
  OffsetTable : TOffsetTable;
  TableDirectory : TTableDirectory;
  NameTableHdr : TNameTableHdr;
  NameRecord : TNameRecord;
  {offsets}
  NameTableOffset,   // tables from start of file
  NameStringsOffset, // string data from start of tables
  StringsIndex     // font name in string data
                : integer;
  i, TableCount, NameCount, LenFontName : integer;
  FontName : string;
begin
  Result := '';
  MemStrm := TMemoryStream.Create;
  with MemStrm do begin
    LoadFromFile(FontFileName);
    Seek(0, soFromBeginning);
    MemStrm.Read(OffsetTable, SizeOf(TOffsetTable));
    {get number of tables}
    TableCount := SwapWord(OffSetTable.NumTables);
    {go to start of table directory}
    Seek(12, soFromBeginning);
    {now go through tables looking for one with the tag 'name'}
    i := 0;
    while i < TableCount do begin
      MemStrm.Read(TableDirectory, SizeOf(TTableDirectory));
      if TableDirectory.Tag = NameDW then
        break;
      inc(i);
    end; {for i := 0 to TableCount - 1}
    if i = TableCount then begin
      MemStrm.Free;
      Exit;
    end;
    NameTableOffset := SwapDWord(TableDirectory.Offset);
    {go to start of 'name' table}
    Seek(NameTableOffset, soFromBeginning);
    {get 'name' table header ...}
    Read(NameTableHdr, SizeOf(TNameTableHdr));
    { ... and number of name records}
    NameCount := SwapWord(NameTableHdr.NameRecordCount);
    NameStringsOffset := SwapWord(NameTableHdr.Offset);
    {stream pointer is already at start of NameRecords}
    {look for the name record for the font name}
    i := 0;
    while i < NameCount do begin
      Read(NameRecord, SizeOf(TNameRecord));
      if (SwapWord(NameRecord.NameID) = 4) then begin
        StringsIndex := SwapWord(NameRecord.NameOffset);
        LenFontName := SwapWord(NameRecord.NameLen);
        Break;
      end; {if SwapWord(NameRecord.NameID) = 4}
      inc(i);
    end; {for i := 0 to NameCount - 1}
    {now we can get & return the name string}
    if i < NameCount then begin
      SetLength(Result, LenFontName);
      Seek(NameTableOffset + NameStringsOffset + StringsIndex,
soFromBeginning);
      Read(Result[1], LenFontName);
    end;
    MemStrm.Free;
  end; {with MemStrm}
end;

Alan Lloyd
alangll...@aol.com

Other Threads