Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
Private Sub Command1_Click()
Dim TTFontFile As String
'get the font name for Arial Bold
'be sure to verify that this font exists on your system
TTFontFile = "C:\Windows\Fonts\anb_____.TTF"
Label1.Caption = GetFontName(TTFontFile)
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
'Return the font name
GetFontName = FontName
End Function
|
