Make your own free website on Tripod.com

AllApi.net

[an error occurred while processing this directive]
 
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


 
Copyright © 1998-2000, The KPD-Team.
Send mail to KPDTeam@Allapi.net with comments about this web site.
This site is located at
http://www.Allapi.net/