Fontname aus .ttf (TrueTypeFonts) auslesen

Windowsspezifisches Forum , API ,..
Beiträge, die plattformübergreifend sind, gehören ins 'Allgemein'-Forum.
Amor_2001
Beiträge: 75
Registriert: 14.12.2011 19:20

Fontname aus .ttf (TrueTypeFonts) auslesen

Beitrag von Amor_2001 »

Hallo zusammen,

ich suche nach einer Prozedur, mit Hilfe derer ich aus .ttf-Dateien den Fontnamen und ggf. auch andere Daten auslesen kann.
Alles was ich bisher gefunden habe bedient andere Programmiersprachen und ich tue mich schwer, den Code zu portieren.

Hat jemand vielleicht schon so eine Prozedur in der Schublade oder eine Idee dafür???

Vielen Dank schon mal vorab.
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8807
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Re: Fontname aus .ttf (TrueTypeFonts) auslesen

Beitrag von NicTheQuick »

Wenn es sowas schon in anderen Programmiersprachen gibt, dann müsste man das ja nur noch portieren. Welche Codes hast du denn dafür bereits gefunden?

Ansonsten hilft dir das hier vielleicht weiter: The TrueType Font File

Wie wär's damit? Retrieving font name from TTF file . Da ist doch alles wunderbar erklärt.
Benutzeravatar
E-P-S
Beiträge: 134
Registriert: 30.03.2007 09:39
Kontaktdaten:

Re: Fontname aus .ttf (TrueTypeFonts) auslesen

Beitrag von E-P-S »

Ich hab sowas mal vor Jahren in BlitzBasic gemacht. Hintergrund war damals das BlitzBasic zum einen nicht jeden TrueType Font laden bzw. darstellen konnte und zum anderen brauchte es zum laden den tatsächlichen Namen des Fonts - nicht den Namen der Datei.

Ich erstellte eine Dateiliste des Font Verzeichnisses -> FileList$(J) und bin dann alle durchgegangen und hab die "realen" Fontnamen extrahiert um den Font am Ende laden zu können...

keine Ahnung ob Dir das hilft. Andernfalls mal bei [url]htttp://Wotsit.org[/url] nach TTF suchen und selbst durchkämpfen ;)

Code: Alles auswählen

Handler=ReadFile(FileList$(J))
		SeekFile Handler,12
		While Not Eof(Handler)
			tag=ReadInt(Handler)
			chksum=ReadInt(Handler)
			offset=ReadByte(Handler)*$1000000+ReadByte(Handler)*$10000+ReadByte(Handler)*$100+ReadByte(Handler)
			length=ReadInt(Handler)
			If tag=$656D616E Then
				SeekFile Handler,Offset
				Dummy=ReadShort(Handler)
				Records=ReadByte(Handler)*$100+ReadByte(Handler)
				Dummy=ReadShort(Handler)
				For I=1 To Records
					Dummy=ReadShort(Handler)
					Dummy=ReadShort(Handler)
					Dummy=ReadShort(Handler)
					nameID=ReadByte(Handler)+ReadByte(Handler)
					namelength=ReadByte(Handler)*$100+ReadByte(Handler)
					nameoffset=ReadByte(Handler)*$100+ReadByte(Handler)
					If nameID=4 Then Exit
				Next
				Pos=Offset+6+(Records*12)+nameoffset
				SeekFile Handler,Pos
				A$=""
				For I=1 To namelength
					B=ReadByte(Handler)
					If B<>0 Then A$=A$+Chr$(B)
				Next
				Font=0
				Font=LoadFont(A$+".ttf",16)
Amor_2001
Beiträge: 75
Registriert: 14.12.2011 19:20

Re: Fontname aus .ttf (TrueTypeFonts) auslesen

Beitrag von Amor_2001 »

Erst mal vielen Dank, ich schaue mir das gleich mal an.

Gefunden habe ich z.B. folgenden Delphi Code...aber wie gesagt, das mit dem Portieren bekomme ich nciht so hin :(

Code: Alles auswählen

type
  TTableDirectory = record
    Tag: LongInt;
    CheckSum: LongInt;
    Offset: LongInt;
    Length: LongInt;
  end;

  TNamingTable = record
    Format: Word;
    Count: Word;
    StringOffset: Word;
  end;

  TNameRecord = record
    PlatformID: Word;
    SpecificID: Word;
    LanguageID: Word;
    NameID: Word;
    Length: Word;
    Offset: Word;
  end;

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;
__________________________________________________
Code-Tags hinzugefügt
09.04.2013
RSBasic
Antworten