Главная страницаОбратная связьКарта сайта

Получить имя шрифта заголовка активного окна



Private Const LF_FACESIZE = 32
Private Const SPI_GETNONCLIENTMETRICS = 41

Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(1 To LF_FACESIZE) As Byte
End Type

Private Type NONCLIENTMETRICS
cbSize As Long
iBorderWidth As Long
iScrollWidth As Long
iScrollHeight As Long
iCaptionWidth As Long
iCaptionHeight As Long
lfCaptionFont As LOGFONT
iSMCaptionWidth As Long
iSMCaptionHeight As Long
lfSMCaptionFont As LOGFONT
iMenuWidth As Long
iMenuHeight As Long
lfMenuFont As LOGFONT
lfStatusFont As LOGFONT
lfMessageFont As LOGFONT
End Type

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long

Public Function ActiveTitleBarFontName()
Dim s As String
Dim i As Byte
Dim ncm As NONCLIENTMETRICS
Dim sdfont As StdFont
ncm.cbSize = Len(ncm)
If SystemParametersInfo(41, ncm.cbSize, ncm, 0) Then
s = StrConv(ncm.lfCaptionFont.lfFaceName, vbUnicode)
i = InStr(s, vbNullChar)
If i > 0 Then s = Left(s, i - 1)
End If
ActiveTitleBarFontName = s
End Function

Private Sub Form_Load()
MsgBox ActiveTitleBarFontName
End Sub


Обсудить статью на форуме


Если Вас заинтересовала или понравилась информация программирование на Visual Basic - "Получить имя шрифта заголовка активного окна", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:

Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи, в сообщение обязательно указывайте название или ссылку на статью!
   


Copyright © 2008 - 2017 Дискета.info