Hi there,
does anybody have an idea how to display fonts that aren't installed in my system?
Printable View
Hi there,
does anybody have an idea how to display fonts that aren't installed in my system?
If their not installed how are you going to
see/display them?
I found the solution. I call the WinAPI AddFontResource and I am able to use fonts that aren't in the Windows Font directory like shown below (I typed it in quickly so maybe I mistyped something):Quote:
Originally posted by johnpc:
If their not installed how are you going to
see/display them?
Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Private Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long
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
Sub SomeCommand()
Dim sz As String
sz = "C:\Windows\Desktop\MyFont.ttf"
AddFontResource(sz)
Text1.Font = GetFontName(sz)
RemoveFontResource(sz)
End Sub
Public Function GetFontName(FileNameTTF As String) As String
Dim hFile As Integer
Dim Buffer As String
Dim FontName As String
Dim TempName As String
Dim iPos As Integer
'Build name for new resource file in
'a temporary file, and call the API.
TempName = App.Path & "\~TEMP.FOT"
If CreateScalableFontResource(1, _
TempName, _
FileNameTTF, _
vbNullString) Then
'The name sits behind the text "FONTRES:"
hFile = FreeFile
Open TempName For Binary Access Read As hFile
Buffer = Space(LOF(hFile))
Get hFile, , Buffer
iPos = InStr(Buffer, "FONTRES:") + 8
FontName = Mid(Buffer, iPos, _
InStr(iPos, Buffer, vbNullChar) - iPos)
Close hFile
Kill TempName
End If
GetFontName = FontName
End Function