TrueType Font

This code provides a neat little module function for detecting whether a font is truetype or not.

' Declare constants
Private Const TMPF_TRUETYPE = &H4
Private Const LF_FACESIZE = 32
' Declare types
Private Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName(1 To LF_FACESIZE) As Byte
End Type
Private Type TEXTMETRIC
        tmHeight As Long
        tmAscent As Long
        tmDescent As Long
        tmInternalLeading As Long
        tmExternalLeading As Long
        tmAveCharWidth As Long
        tmMaxCharWidth As Long
        tmWeight As Long
        tmOverhang As Long
        tmDigitizedAspectX As Long
        tmDigitizedAspectY As Long
        tmFirstChar As Byte
        tmLastChar As Byte
        tmDefaultChar As Byte
        tmBreakChar As Byte
        tmItalic As Byte
        tmUnderlined As Byte
        tmStruckOut As Byte
        tmPitchAndFamily As Byte
        tmCharSet As Byte
End Type
' Declare Windows API functions
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long

' Is Font a True Type font?
Public Function IsFontTrueType(sFontName As String, hDC As Long) As Boolean
  Dim lf As LOGFONT
  Dim tm As TEXTMETRIC
  Dim hOldfont As Long, hNewFont As Long
  Dim tmpArray() As Byte
  Dim i As Integer
  'need to convert font name to byte array...
  tmpArray = StrConv(sFontName & vbNullString, vbFromUnicode)
  For i = 0 To UBound(tmpArray)
    lf.lfFaceName(i + 1) = tmpArray(i)
  Next
  'create the font object
  hNewFont = CreateFontIndirect(lf)
  'save the current font object and use the new font object
  hOldFont = SelectObject(Me.hdc, hNewFont)
  'get the new font object's info
  GetTextMetrics(hdc, tm)
  'determine whether new font object is TrueType
  IsFontTrueType = (tm.tmPitchAndFamily And TMPF_TRUETYPE)
  'restore the original font object - This is important!
  SelectObject(hdc, hOldFont)
End Function