GetFontCurrent

Private Function IsScreenFontSmall() As Boolean
    Dim hWndDesk As Long
    Dim hDCDesk As Long
    Dim logPix As Long
    Dim r As Long
    
    'get the handle to the desktop window
    hWndDesk = GetDesktopWindow()
    
    'get the handle desktop display context (hDC)
    hDCDesk = GetDC(hWndDesk)
    
    'get the horizontal logical pixels
    logPix = GetDeviceCaps(hDCDesk, LOGPIXELSX)
    
    'release the hDC
    r = ReleaseDC(hWndDesk, hDCDesk)
    
    'if the return from GetDeviceCaps is 96, then the system is
    'using small fonts.  If the system is using small fonts,
    'the return value will be 96.
    IsScreenFontSmall = logPix = 96
    
End Function

Option Explicit
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Const LOGPIXELSX = 88
Public Const LOGPIXELSY = 90
Private Sub Command1_Click()
'call the wrapper function

If IsScreenFontSmall() Then
Label1 = "The system is using Small Fonts"
Else: Label1 = "The system is using Large Fonts"
End If
End Sub

Private Function IsScreenFontSmall() As Boolean
Dim hWndDesk As Long
Dim hDCDesk As Long
Dim logPix As Long
Dim r As Long

'get the handle to the desktop window

hWndDesk = GetDesktopWindow()

'get the handle desktop display context (hDC)

hDCDesk = GetDC(hWndDesk)

'get the horizontal logical pixels

logPix = GetDeviceCaps(hDCDesk, LOGPIXELSX)

'release the hDC

r = ReleaseDC(hWndDesk, hDCDesk)

'if the return from GetDeviceCaps is 96, then the system is

'using small fonts. If the system is using small fonts,

'the return value will be 96.

IsScreenFontSmall = logPix = 96

End Function