Library code snippets

Large Fonts or Small?

This code shows you how to determine if Large Fonts or Small fonts are being used. If the system font is more than 16 pixels high, then large fonts are being used.

'Module Code
'** 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

AddThis

Comments

Leave a comment

Sign in or Join us (it's free).

Related discussion