Binaryworld - How to retrive font name from font file. ... [ VB -> Font ]

I tried so many places but never found any simple code which retrive font name. Because to set font for drawing/printing we have to set font name and ususally font name is different than file name.

Click here to copy the following block

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 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

Private Sub Form_Load()
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\ANTQUAB.TTF"
'MsgBox "Font name : " & GetFontName(TTFontFile)
Me.caption = GetFontName(TTFontFile)

Me.CurrentX = 1000
Me.CurrentY = Me.Height / 2
Me.FontName = GetFontName(TTFontFile)
Me.FontSize = 15
Me.FontBold = True
Me.Print Me.caption & " Font Demo.."
End Sub