'** TYPES **
Type TEXTMETRIC
tmHeight As Integer
tmAscent As Integer
tmDescent As Integer
tmInternalLeading As Integer
tmExternalLeading As Integer
tmAveCharWidth As Integer
tmMaxCharWidth As Integer
tmWeight As Integer
tmItalic As String * 1
tmUnderlined As String * 1
tmStruckOut As String * 1
tmFirstChar As String * 1
tmLastChar As String * 1
tmDefaultChar As String * 1
tmBreakChar As String * 1
tmPitchAndFamily As String * 1
tmCharSet As String * 1
tmOverhang As Integer
tmDigitizedAspectX As Integer
tmDigitizedAspectY As Integer
End Type
'** Win32 API DECLARATIONS **
Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" _
(ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc _
As Long) As Long
Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal _
nMapMode As Long) As Long
'** CONSTANTS **
Global Const MM_TEXT = 1
'** Function **
Public Function gbl_GetFontRes$()
Dim hdc, hwnd, PrevMapMode As Long
Dim tm As TEXTMETRIC
' Set the default return value to small fonts
gbl_GetFontRes$ = "VGA"
' Get the handle of the desktop window
hwnd = GetDesktopWindow()
' Get the device context for the desktop
hdc = GetWindowDC(hwnd)
If hdc Then
' Set the mapping mode to pixels
PrevMapMode = SetMapMode(hdc, MM_TEXT)
' Get the size of the system font
GetTextMetrics hdc, tm
' Set the mapping mode back to what it was
PrevMapMode = SetMapMode(hdc, PrevMapMode)
' Release the device context
ReleaseDC hwnd, hdc
' If the system font is more than 16 pixels high,
' then large fonts are being used
If tm.tmHeight > 16 Then gbl_GetFontRes$ = "8514"
End If
End Function