[VBnet Screen] GetDeviceCaps: Determine the Current System Screen Font


	Visual Basic Screen & System Metrics GetDeviceCaps: Determine the Current System Screen Font

Posted:	Monday February 3, 1997
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB4-32, Windows 95
OS restrictions:	None
Author:	VBnet - Randy Birch

Prerequisites

None.

Knowing the current screen font size (Small or Large) in use on the target system may provide useful 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. Note that if the user has selected a custom font size via Control Panel / Display, this will return False.

BAS Module Code

None.

Form Code

Add the following code to the form containing a command button and a label:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetDC Lib "user32" _
     (ByVal hwnd As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" _
     (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare Function ReleaseDC Lib "user32" _
     (ByVal hwnd As Long, ByVal hdc As Long) As Long


Private Sub Command1_Click()
   
   'call the wrapper function   
    If IsScreenFontSmall() Then
       Label1.Caption = "System is using Small fonts"
    Else
       Label1.Caption = "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
   
   '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   
    Call ReleaseDC(hWndDesk, hDCDesk)
   
   'if the return from GetDeviceCaps is 96, then  
   'the system is using small fonts.
    IsScreenFontSmall = logPix = 96 
  
End Function

Comments

This routine can be easily adapted to return a string, the actual LOGPIXELSX value, or True for large fonts, as requirements dictate. Note that this routine assumes that the user has not chosen to specify a scaled screen font in the Display Properties/Font Size combo box. With the code above, any setting other than small font will return False, however this can be easily modified to return the actual scale factor in use.

VB3 users should declare the function As Integer.

PayPal Link