Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0537: Werden kleine oder große Schriften im System verwendet

VB 5/6-Tipp 0537: Werden kleine oder große Schriften im System verwendet

 von Helge Rex

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GetDesktopWindow, GetTextMetricsA (GetTextMetrics), GetWindowDC, ReleaseDC, SetMapMode

Download: Download des Beispielprojektes [2,62 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei FontSize.vbp -------------
'-------- Anfang Formular "Form1" alias FontSize.frm --------
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label1"

'
'Autor:   Helge Rex   helge@activevb.de
'
'Prüft, ob das System kleine oder große Schriftarten verwendet

Option Explicit

'   Datentyp für die Funktion
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

'   ... Diverse APIs ...
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" ( _
    ByVal hdc As Long, _
    lpMetrics As TEXTMETRIC _
) As Long
   
Private Declare Function GetDesktopWindow Lib "user32" ( _
) As Long
   
Private Declare Function GetWindowDC Lib "user32" ( _
    ByVal hwnd As Long _
) As Long
   
Private Declare Function ReleaseDC Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal hdc As Long _
) As Long
   
Private Declare Function SetMapMode Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal nMapMode As Long _
) As Long

'   ... Und eine Konstante
Private Const MM_TEXT = 1

Public Function boolUseSmallFonts() As Boolean
    '   Funktion liefert TRUE, wenn das System kleine Schriftarten verwendet,
    '   sonst wird FALSE zurückgegeben
    
    '   Speicher reservieren
    Dim hdc As Long
    Dim hwnd As Long
    Dim PrevMapMode As Long
    Dim tm As TEXTMETRIC

    '   Standard-Rückgabe setzen
    boolUseSmallFonts = True
    
    '   Handle zum desktop ermitteln
    hwnd = GetDesktopWindow()
    
    '   DC vom Desktop auslesen
    hdc = GetWindowDC(hwnd)
    
    '   Konnte DC ermittelt werden?
    If hdc Then
        '   Ja, ScaleMode auf Pixel setzen
        PrevMapMode = SetMapMode(hdc, MM_TEXT)
        
        '   Größe des Systemfonts auslesen
        GetTextMetrics hdc, tm
        
        '   Scalemode zurücksetzen
        PrevMapMode = SetMapMode(hdc, PrevMapMode)
        
        '   DC freigeben
        ReleaseDC hwnd, hdc
        
        '   Ist die Schriftgröße größer als 16 Pixel?
        If (tm.tmHeight > 16) Then
            '   Ja, also werden große Schriftarten verwendet
            boolUseSmallFonts = False
        End If
    End If
End Function

Public Function strGetFontRes() As String
    '   Funktion gibt aus, welche Schriftgröße verwendet wird

    '   Werden kleine Schriftarten verwendet?
    If boolUseSmallFonts Then
        '   Ja, Rückgabe entsprechend setzen
        strGetFontRes = "kleine Schriftarten"
    Else
        '   Ja, Rückgabe entsprechend setzen
        strGetFontRes = "große Schriftarten"
    End If
End Function

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Me.Label1.Caption = "Das System verwendet " & strGetFontRes
End Sub
'--------- Ende Formular "Form1" alias FontSize.frm ---------
'-------------- Ende Projektdatei FontSize.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.