Seite 1 von 1
Fontname aus .ttf (TrueTypeFonts) auslesen
Verfasst: 09.04.2013 07:43
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.
Re: Fontname aus .ttf (TrueTypeFonts) auslesen
Verfasst: 09.04.2013 09:49
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.
Re: Fontname aus .ttf (TrueTypeFonts) auslesen
Verfasst: 09.04.2013 10:38
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)
Re: Fontname aus .ttf (TrueTypeFonts) auslesen
Verfasst: 09.04.2013 10:57
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