vb@rchiv · Tipps & Tricks · System-Schriftart der Fenster-Titelzeile ermitteln

Rubrik: Grafik und Font · Font & Text | VB-Versionen: VB4, VB5, VB6

04.12.06

System-Schriftart der Fenster-Titelzeile ermitteln Dieser Tipp zeigt, wie man den Namen des Fonts der Beschriftung der aktiven Titelleiste ermittelt
Autor: Microsys Kramer	Bewertung:	Views: 10.298
www.access-paradies.de	System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Dieser Tipp zeigt, wie man den Namen des Fonts der Beschriftung der aktiven Titelleiste ermittelt.

Fügen Sie nachfolgenden Code in ein Modul ein:

Option Explicit
 
' Benötigte API-Deklarationen 
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 GetSystemTitleBarFontName() As String
  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
 
  GetSystemTitleBarFontName = s 
End Function