Ez a függvény a GetFontNameFromTTF nevet kapta. Paraméterként kéri a TTF állomány nevét, visszatérési értékként a font nevét adja.
A megoldáshoz a következő trükköt használjuk fel: a CreateScalableFontResource Windows függvény hívásával létrehozunk a TTF állomány alapján egy FOT kiterjesztésű állományt. A függvény valójában arra szolgál, hogy méretezhető font erőforrásokat készítsünk, de nekünk most nem erre van szükségünk, hanem csak a FOT állomány létrejöttére. Ugyanis ebbe az állományba már belekerül a TTF állományban lévő betűtípus neve szövegesen, és így azt onnan ki tudjuk olvasni. Bár ez az információ rendelkezésre áll a TTF-ben, onnan viszont sokkal körülményesebb módon tudnánk csak elővarázsolni a számunkra fontos sztringet.
FOT állomány létrehozásához tehát meghívjuk a CreateScalableFontResource függvényt.
Private Function GetFontNameFromTTF(ByVal ttfFileName As String) As String
Dim tempfile As String = Path.ChangeExtension(Path.GetTempFileName(), "fot")
Win32.CreateScalableFontResource(1, tempfile, ttfFileName, "")
Ezek után már csak meg kell keresnünk a FOT állományban a betűtípus nevét. Ehhez az állományt beolvassuk egy bájtokat tartalmazó tömbbe.
Dim fs As New FileStream(tempfile, FileMode.Open)
Dim br As New BinaryReader(fs)
Dim fot As Byte() = br.ReadBytes(CInt(fs.Length))
Az állomány ugyan bináris, de a betűtípus neve szövegesen olvasható, így az egyszerűség kedvéért ezt a bájttömböt sztringként kezeljük. Ehhez azonban a 0 értékű bájtokat le kell cserélnünk, mondjuk a TAB (9) kódjára, mivel ha nullát hagynánk benne, ott a sztring véget érne.
For i = 0 To fs.Length - 1
If fot(i) = 0 Then
fot(i) = 9
End If
Next i
Ezt követi az a lépés, amikor a bájttömbből sztringet készítünk.
Dim s As String = ""
Dim c As Byte
For Each c In fot
s += ChrW(c)
Next c
Tudjuk azt, hogy a FOT állományban a „FONTRES:” sztring után olvasható be a betűtípus neve, így meg kell keresnünk az előállított sztringben ezt a szöveget.
Dim pos As Integer = s.IndexOf("FONTRES:")
pos += 8
Végül már csak ki kell olvasnunk a megtalált pozícióról a karaktereket egészen az első TAB karakterig. Mivel az eredeti FOT állományban egy nulla bájt zárja a font nevét, amit ugye időközben kicseréltünk tab-ra, így biztosak lehetünk a tab találata esetén, hogy a font neve véget ért.
Dim fontname As String = ""
Try
While (s.Chars(pos) <> ControlChars.Tab)
fontname += s.Chars(pos)
pos += 1
End While
Catch
End Try
Most már csak zárnunk kell a megnyitott FOT állományt, majd egyúttal töröljük is, hogy ne maradjon „szemét” az alkalmazásunk után.
fs.Close()
File.Delete(tempfile)
Return fontname
End Function 'GetFontNameFromTTF