Jakou velikost fontu používají Windows ?

Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" _
   (ByVal hwnd As Long) As Long
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 ReleaseDC Lib "user32" _
   (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Const MM_TEXT = 1
Private Type TEXTMETRIC
   tmHeight As Integer
   tmAscent As Integer
   tmDescent As Integer
   tmInternalLeading As Integer
   tmExternalLeading As Integer
   tmAveCharWidth As Integer
   tmMaxCharWidth As Integer
   tmWeight As Integer
   tmItalic As String * 1
   tmUnderlined As String * 1
   tmStruckOut As String * 1
   tmFirstChar As String * 1
   tmLastChar As String * 1
   tmDefaultChar As String * 1
   tmBreakChar As String * 1
   tmPitchAndFamily As String * 1
   tmCharSet As String * 1
   tmOverhang As Integer
   tmDigitizedAspectX As Integer
   tmDigitizedAspectY As Integer
End Type

Private Function SmallFonts() As Boolean

   Dim hdc As Long
   Dim hwnd As Long
   Dim PrevMapMode As Long
   Dim tm As TEXTMETRIC

   SmallFonts = True

   hwnd = GetDesktopWindow()
   hdc = GetWindowDC(hwnd)
   If hdc Then
      PrevMapMode = SetMapMode(hdc, MM_TEXT)
      GetTextMetrics hdc, tm
      PrevMapMode = SetMapMode(hdc, PrevMapMode)
      ReleaseDC hwnd, hdc
      If tm.tmHeight > 16 Then SmallFonts = False
   End If

End Function

Příklad volání:
MsgBox SmallFonts

Zpět