GetFontCurrent




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

Knowing the current screen font size (Small or Large) in use
on the target system is often required when writing
control-resizing routines. The wrapper function presented
here, calling the Windows API GetDeviceCaps, returns True if
the system is using the Small Font, and False if the system
is in Large Font mode. Add the following code to a BAS module:










( getfontcurrent.html )- by Paolo Puglisi - Modifica del 17/12/2023