| |
Определить, использует ли компьютер большие или маленькие шрифты |
|
| |
Данный пример покажет, какой размер шрифта установлен в настройках экрана. Данные опции устанавливаются через Панель Управления - Свойства Экрана - вкладка Настройка - кнопка Дополнительно - РазмерШрифта.
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
Public 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
Private Sub Form_Load()
'В случае маленького фрифта вы получите
сообщение "TRUE", иначе получите сообщение
"FALSE".
MsgBox SmallFonts
End Sub
|
|
| |
|
|
|
|