' below is in .Bas
Option Explicit
Public Const LF_FULLFACESIZE = 64
Public Const LF_FACESIZE = 32
Public Const DEVICE_FONTTYPE = &H1
Public Const RASTER_FONTTYPE = &H2
Public Const TRUETYPE_FONTTYPE = &H4
Public Const FF_DECORATIVE = 80
Public Const FF_DONTCARE = 0
Public Const FF_MODERN = 48
Public Const FF_ROMAN = 16
Public Const FF_SCRIPT = 64
Public Const FF_SWISS = 32
Public Const LOGPIXELSY = 90

Type NEWTEXTMETRIC
        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
        ntmFlags As Long
        ntmSizeEM As Long
        ntmCellHeight As Long
        ntmAveWidth As Long
End Type


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(LF_FACESIZE) As Byte
End Type
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 Function EnumFontFamilies Lib "gdi32" Alias "EnumFontFamiliesA" (ByVal hdc As Long, ByVal lpszFamily As String, ByVal lpEnumFontFamProc As Long, ByVal lparam As Long) As Long
Type ENUMLOGFONT
        elfLogFont As LOGFONT
        elfFullName(LF_FULLFACESIZE) As Byte
        elfStyle(LF_FACESIZE) As Byte
End Type
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private hdc As Long

Public Sub EnumFontInfo()
Dim i As Long
i = 1
hdc = GetDC(0)
Call EnumFontFamilies(hdc, vbNullString, AddressOf FontFamily, 0)
Call ReleaseDC(0,hdc)
End Sub

Public Function FontFamily(ELGFont As ENUMLOGFONT, ByVal ntm As Long, ByVal fonttype As Long, ByVal lparam As Long) As Long
Dim str5 As String, ff As Byte
Dim hi As Long, ii As Long
str5 = StrConv(ELGFont.elfLogFont.lfFaceName, vbUnicode)
str5 = Left(str5, InStr(1, str5, Chr(0)) - 1)
ii = GetDeviceCaps(hdc, LOGPIXELSY)
hi = MulDiv(ELGFont.elfLogFont.lfHeight, 72, ii)
Debug.Print "FontFace = "; str5, " Height (point) = "; hi
If (fonttype And DEVICE_FONTTYPE) <> 0 Then
   Debug.Print "   Type is Vector"
End If
If (fonttype And RASTER_FONTTYPE) <> 0 Then
   Debug.Print "   Type is Raster"
End If
If (fonttype And TRUETYPE_FONTTYPE) <> 0 Then
   Debug.Print "   Type is TrueType"
End If
ff = ELGFont.elfLogFont.lfPitchAndFamily And &HF0
If ff = FF_DECORATIVE Then
   Debug.Print "   Family = Decorative"
End If
If ff = FF_DONTCARE Then
   Debug.Print "   Family = Do Not Care"
End If
If ff = FF_MODERN Then
   Debug.Print "   Family = Modern"
End If
If ff = FF_ROMAN Then
   Debug.Print "   Family = Roman"
End If
If ff = FF_SCRIPT Then
   Debug.Print "   Family = Script"
End If
If ff = FF_SWISS Then
   Debug.Print "   Family = Swiss"
End If
FontFamily = 1
End Function

'Below is in Form

Private Sub Form_Load()
Call EnumFontInfo
End Sub