|
|
Private Const MM_TEXT = 1
Private Type TEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
End Type
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Function SmallFonts() As Boolean
Dim hdc As Long, hwnd As Long
Dim PrevMapMode As Long, tm As TEXTMETRIC
' Set the default return value to small fonts
SmallFonts = True
' 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 SmallFonts = False
End If
End Function
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
MsgBox "Using small fonts: " + Str$(SmallFonts)
End Sub
|
|
