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

You might also like...

Comments

James Crowley James first started this website when learning Visual Basic back in 1999 whilst studying his GCSEs. The site grew steadily over the years while being run as a hobby - to a regular monthly audience ...

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“Owning a computer without programming is like having a kitchen and using only the microwave oven” - Charles Petzold