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

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 17 Bewertung insgesamt: nützlich Durchschnittliche Bewertung: 2.8 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

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