Visual Basic, .NET, ASP, VBA, VBScript
 
  Библиотека кодов  
  Работа с 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

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
 
     
  VBNet online (всего: 51616)  
 

Логин:

Пароль:

Регистрация, забыли пароль?


В чате сейчас человек
 
     
  VBNet рекомендует  
   
     
  Лучшие материалы  
 
ActiveX контролы (112)
Hitman74_Library (36119)
WindowsXPControls (20739)
FlexGridPlus (19374)
DSMAniGifControl (18295)
FreeButton (15157)
Примеры кода (546)
Parol (18027)
Passworder (9299)
Screen saver (7654)
Kerish AI (5817)
Folder_L (5768)
Статьи по VB (136)
Мое второе впечатление... (11236)
VB .NET: дорога в будущее (11161)
Основы SQL (9225)
Сообщения Windows в Vi... (8788)
Классовая теория прогр... (8619)
 
     
Техническая поддержка MTW-хостинг | © Copyright 2002-2011 VBNet.RU | Пишите нам