|
Einer TrueType-Font-Datei können Sie leider nicht den
tatsächlichen Namen des darin enthaltenen Fonts ansehen und auf
einfache Weise entnehmen. Mit nur einer einzigen API-Funktion und
mit Hilfe einer temporären Datei können Sie den gesuchten Namen
auf recht einfache Weise in Erfahrung bringen.
Diese API-Funktion heißt  CreateScalableFontResource
und legt zu einer gegebenen TTF-Datei eine Ressourcen-Datei an, die
an einer mit InStr auffindbaren Position den Font-Namen im Klartext
enthält. Da wir diese Ressourcen-Datei nur vorübergehend brauchen,
legen wir sie, ordentlich wie wir doch immer sind, als temporäre
Datei im Temp-Verzeichnis an. Dies erledigt die Hilfsfunktion
CreateTempFile (siehe  "Kurzlebige
Dateien") - wir brauchen nur noch die
Dateierweiterung dieser Datei von "TMP" in "FOT"
zu ändern, damit die besagte API-Funktion damit etwas anfangen
kann. Nach Gebrauch der Datei sollten wir sie natürlich genau so
ordentlich wieder löschen.
Die ganze Arbeit lassen wir am besten von einer weiteren
Hilfsfunktion erledigen. Sie übergeben der Funktion TTFontName den
Pfadnamen der TTF-Datei und erhalten von ihr den Namen des darin
enthaltenen Fonts zurückgegeben.
Private Declare Function CreateScalableFontResource Lib "gdi32" _
Alias "CreateScalableFontResourceA" (ByVal fHidden As Long, _
ByVal lpszResourceFile As String, ByVal lpszFontFile As String, _
ByVal lpszCurrentPath As String) As Long
Public Function TTFontName(FileName As String) As String
Dim nFNr As Integer
Dim nContents As String
Dim nTempFile As String
Dim nPos As Long
nTempFile = CreateTempFile()
nTempFile = Left$(nTempFile, Len(nTempFile) - 3) & "FOT"
If CreateScalableFontResource(1, nTempFile, FileName, _
vbNullString) Then
nFNr = FreeFile
On Error GoTo TTFontName_Error
Open nTempFile For Binary Access Read As #nFNr
nContents = Space(LOF(nFNr))
Get #nFNr, , nContents
Close #nFNr
Kill nTempFile
nPos = InStr(nContents, "FONTRES:") + 8
If nPos Then
TTFontName = Mid(nContents, nPos, InStr(nPos, nContents, _
vbNullChar) - nPos)
End If
End If
Exit Function
TTFontName_Error:
Resume
End Function
|