Prüfen auf nicht proportionale Schriften Dieser Tipp verrät Ihnen, wie sich alle installierten nicht-proportionalen Schriften ermitteln lassen.
Autor:   Dieter Otter	Bewertung:	Views:  17.343
www.tools4vb.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Manchmal benötigt man eine Schriftart, bei der alle Buchstaben die gleiche Breite haben, z.b. immer dann, wenn man eine sauber formatierte Druckausgabe erstellen, jedoch keine Tab-Stops oder Tabellen verwenden will.

Mit nachfolgender Funktion lässt sich prüfen, ob die Zeichen einer bestimmten Schriftart proportional zueinander sind. Hierzu wird die Breite des Zeichens I mit der Breite des Zeichens M verglichen. Sind die Buchstaben unterschiedlich breit, so handelt es sich um eine proportionale Schrift.

Die Funktion erwartet als Parameter ein Form-Objekt, sowie den Namen der Schrift. Der Rückgabewert ist entweder True (es handelt sich um eine nicht-proportionale Schrift) oder False.

' Handelt es sich um eine proportionale Schrift?
Public Function IsFontNonProportional(F As Form, _
  ByVal sFontName As String) As Boolean
 
  Dim sOldFontName As String
  Dim bResult As Boolean
 
  ' Standard-Rückgabewert
  bResult = False
 
  ' Fehlerbehandlung aktivieren, falls Schriftart
  ' nicht existiert
  On Local Error Resume Next
  With F
    ' ursprüngliche Schrift merken
    sOldFontName = .FontName
 
    ' neue Schriftart festlegen
    .FontName = sFontName
    If Err = 0 Then
      ' Textbreite des Zeichens "I" mit "M" vergleichen
      bResult = (.TextWidth("I") = .TextWidth("M"))
    End If
 
    ' ursprüngliche Schrift wiederherstellen
    .FontName = sOldFontName
  End With
 
  IsFontNonProportional = bResult
End Function

Um nun z.B. alle im System installierten nicht-proportionalen Schriften (Bildschirmschriften, wie auch Druckerschriften) zu ermitteln, dient nachfolgende Funktion. Als Parameter wird wiederum ein Form-objekt, sowie ein ListBox- oder ComboBox-Control erwartet, welches mit den ermittelten Schriften gefüllt wird.

' zunächst die benötigten API-Deklarationen
' (wird benötigt, um keine doppelten Einträge in die 
' List/ComboBox zu schreiben)
Private Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" ( _
  ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As String) As Long
 
Private Const LB_FINDSTRINGEXACT = &H1A2
Private Const CB_FINDSTRINGEXACT = &H158

Public Sub GetFontsNonProportional(F As Form, _
  Liste As Control)
 
  Dim I As Integer
  Dim sFont As String
  Dim wMsg As Long
 
  ' ursprüngliche Schrift merken
  sFont = F.Font.Name
 
  ' Bildschirmschriften
  For I = 0 To Screen.FontCount - 1
    F.Font.Name = Screen.Fonts(I)
    If F.TextWidth("I") = F.TextWidth("M") Then
      Liste.AddItem Screen.Fonts(I)
    End If
  Next I
 
  ' jetzt noch die Druckerschriften
  If TypeOf Liste Is ListBox Then
    wMsg = LB_FINDSTRINGEXACT
  Else
    wMsg = CB_FINDSTRINGEXACT
  End If
 
  For I = 0 To Printer.FontCount - 1
    F.Font.Name = Printer.Fonts(I)
 
    If SendMessage(Liste.hwnd, wMsg, -1, Printer.Fonts(I)) Then
      If F.TextWidth("I") = F.TextWidth("M") Then
        Liste.AddItem Printer.Fonts(I)
      End If
    End If
  Next I
 
  ' ursprüngliche Schrift wiederherstellen
  F.Font.Name = sFont
End Sub

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.