Reading .TTF, .FON files

Based on the TrueType font specification I managed to build a unit that
retrieves the font name from a font file. As the TrueType font file
specification is quite difficult (frustrating!), the source code is heavily
commented. The unit uses a form with three components on it: a TOpenDialog,
a button and a label with an OnClick handler attached to it.
Notice: opening fonts in your Windows\Fonts directory won't work.

Robin Gerrets
r.gerr...@student.nyenrode.nl
_______________

unit MainUnit;

{***************************************************************************
***}
{                                                                         
   }
{   Demonstration unit to retrieve string information (for example a
     }
{   name) from a TrueType font
      }
{                                                                         
   }
{   Copyright (c) 2000 Robin Gerrets.
          }
{                                                                         
   }
{   If you have any questions on its use or discover any bugs in the
,     }
{   please feel free to contact the author at
otmail.com            }
{                                                                         
   }
{   This software is provided "as is", without any guarantee made as to
    }
{   suitability or fitness for any particular use. It may contain bugs,
   }
{   use of this tool is at your own
      }
{                                                                         
   }
{***************************************************************************
***}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  end;

  {All TrueType fonts use Motorola-style byte ordering (big-endian).}
  TBigWord = record
    HiByte: Byte;
    LoByte: Byte;
  end;
  TBigCardinal = record
    HiWordHiByte: Byte;
    HiWordLoByte: Byte;
    LoWordHiByte: Byte;
    LoWordLoByte: Byte;
  end;

{converts a big-endian Word to a little-endian Word}
function BigWordToWord(const BigWord: TBigWord): Word;

{converts a big-endian Cardinal to a little-endian Cardinal}
function BigCardinalToCardinal(const BigCardinal: TBigCardinal): Cardinal;

type
  {The TrueType font file begins at byte 0 with the Offset Table.}
  POffsetTable = ^TOffsetTable;
  TOffsetTable = record
    VersionHi: TBigCardinal;   // 0x00010000 for version 1.0
    NumTables: TBigWord;      // number of tables
    SearchRange: TBigWord;    // (Maximum power of 2 <= NumTables) x 16
    EntrySelector: TBigWord;   // Log2(maximum power of 2 <= NumTables
    RangeShift: TBigWord;     // NumTables x 16 - SearchRange
  end;

  {The Offset Table is followed at byte 12 by the Table Directory entries.}
  PTableDirectoryEntry = ^TTableDirectoryEntry;
  TTableDirectoryEntry = record
    Tag: array[0..3] of Char; // table identifier
    CheckSum: TBigCardinal;   // checksum for this table
    Offset: TBigCardinal;     // offset from start of font file
    Length: TBigCardinal;     // length of this table
  end;

  {The Naming Table is one of the Table Directory entries.}
  PNamingTableHeader = ^TNamingTableHeader;
  TNamingTableHeader = record
    Format: TBigWord; // format selector (=0)
    Number: TBigWord; // number of Name Records
    Offset: TBigWord; // offset to start of string storage (from start of
table)
    {all name records follow here}
    {storage area for the actual string data starts here}
  end;

  {The Naming Table contains the Name Records.}
  PNameRecord = ^TNameRecord;
  TNameRecord = record
    PlatformID: TBigWord;     // platform ID
    EncodingID: TBigWord;     // platform-specific encoding ID
    LanguageID: TBigWord;     // language ID
    NameID: TBigWord;         // name ID
    Length: TBigWord;         // string length
    StorageAreaOffset: TBigWord; // String offset from start of storage area
  end;

  TPlatformID = (piAny, piAppleUnicode, piMacintosh, piISO, piMicrosoft);
  TNameID = (niCopyright, niFontFamily, niFontSubfamily, niUniqueID,
             niFullFontName, niVersion, niPostScript, niTrademark,
             niManufacturer, niDesigner, niDescription, niVendorURL,
             niDesignerURL, niLicenseDescription, niLicenseInfoURL,
             niReserved, // do not use niReserved
             niPreferredFamily, niPreferredSubfamily, niCompatibleFull);

  {TrueType string specification}
  TTrueTypeStringID = record
    PlatformID: TPlatformID;   // platform ID
    EncodingID: Word;         // platform-specific encoding ID
    LanguageID: Word;         // language ID
    NameID: TNameID;          // name ID
  end;

{retrieves the font name from a TrueType font file}
function GetTrueTypeString(const FontFile: Pointer;
  const StringID: TTrueTypeStringID): string;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function BigWordToWord(const BigWord: TBigWord): Word;
begin
  Result := (BigWord.HiByte shl 8) or BigWord.LoByte;
end;

function BigCardinalToCardinal(const BigCardinal: TBigCardinal): Cardinal;
begin
  Result := (BigCardinal.HiWordHiByte shl 24)
            or (BigCardinal.HiWordLoByte shl 16)
            or (BigCardinal.LoWordHiByte shl 8) or BigCardinal.LoWordLoByte;
end;

function GetTrueTypeString(const FontFile: Pointer;
  const StringID: TTrueTypeStringID): string;
var
  OffsetTable: POffsetTable;
  Entry: PTableDirectoryEntry;
  CurrentEntry: Integer;
  Header: PNamingTableHeader;
  NameRecord: PNameRecord;
  CurrentRecord: Integer;
  StorageArea: Pointer;
  Continue: Boolean;
  PlatformID: Integer;
  FontName: PChar;
begin
  {the offset table is located at the beginning of the font file}
  OffsetTable := FontFile;
  {let Entry point to the first table directory entry, located directly
after
   the offset table}
  Entry := Ptr(Cardinal(FontFile) + SizeOf(TOffsetTable));

  CurrentEntry := 1;
  while (Entry^.Tag <> 'name')
        and (CurrentEntry < BigWordToWord(OffsetTable^.NumTables)) do
  begin
    {let Entry point to the next table directory entry}
    Entry := Ptr(Cardinal(Entry) + SizeOf(TTableDirectoryEntry));
    Inc(CurrentEntry);
  end;

  {locate the Naming Table Header}
  Header := Ptr(Cardinal(FontFile) + BigCardinalToCardinal(Entry^.Offset));

  {locate the storage area for name strings}
  StorageArea := Ptr(Cardinal(Header) + BigWordToWord(Header^.Offset));

  {let NameRecord point to the first Name Record}
  NameRecord := Ptr(Cardinal(Header) + SizeOf(TNamingTableHeader));

  CurrentRecord := 1;
  repeat
    {select the string to be retrieved}
    Continue := (BigWordToWord(NameRecord^.NameID) = Ord(StringID.NameID))
                and (BigWordToWord(NameRecord^.EncodingID) =
StringID.EncodingID)
                and (BigWordToWord(NameRecord^.LanguageID) =
StringID.LanguageID);
    if Continue then
    begin
      PlatformID := BigWordToWord(NameRecord^.PlatformID);
      case StringID.PlatformID of
        piAny:          Continue := Continue and (PlatformID = 1);
        piAppleUnicode: Continue := Continue and (PlatformID = 0);
        piMacintosh:    Continue := Continue and (PlatformID = 1);
        piISO:          Continue := Continue and (PlatformID = 2);
        piMicrosoft:    Continue := Continue and (PlatformID = 3);
      end;
    end;

    if Continue then
    begin
      FontName := PChar(Cardinal(StorageArea)
                  + BigWordToWord(NameRecord^.StorageAreaOffset));
      Result := FontName;
      SetLength(Result, BigWordToWord(NameRecord^.Length));
      Exit;
    end;

    {let NameRecord point to the next Name Record}
    NameRecord := Pointer(Cardinal(NameRecord) + SizeOf(TNameRecord));

    Inc(CurrentRecord);
  until CurrentRecord > BigWordToWord(Header^.Number);

  Result := ''; // string not found
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SavedFile: THandle;                 // holds a handle to the open file
  BytesRead: DWORD;                   // the number of bytes read from the
file
  FontData: Pointer;                  // points to retrieved font data
  FontDataSize: Integer;              // holds the size of the font data
  StringID: TTrueTypeStringID;        // defines string to be retrieved
begin
  if OpenDialog1.Execute then
  begin
    {open the font file}
    SavedFile := CreateFile(PChar(OpenDialog1.FileName), GENERIC_READ, 0,
nil,
                            OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or
                            FILE_FLAG_SEQUENTIAL_SCAN, 0);

    {determine the font file size}
    FontDataSize := GetFileSize(SavedFile, nil);

    {retrieve enough memory to hold the font data}
    GetMem(FontData, FontDataSize);
    try
      {read the font data into the font data buffer}
      ReadFile(SavedFile, FontData^, FontDataSize, BytesRead, nil);

      {we are done with the document file, so close it}
      CloseHandle(SavedFile);

      with StringID do
      begin
        PlatformID := piAny;
        EncodingID := 0;
        LanguageID := 0;
        NameID := niFullFontName;
      end;

      {display the name of the font that is located in the font file}
      Label1.Caption := GetTrueTypeString(FontData, StringID);
    finally
      {free the buffer allocated to hold the font data}
      FreeMem(FontData);
    end;
  end;
end;

end.