vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevAniGif - als kostenlose Vollversion auf unserer vb@rchiv CD Vol.5  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Grafik und Font · Font & Text   |   VB-Versionen: VB4, VB5, VB627.03.02
Prüfen auf nicht proportionale Schriften

Dieser Tipp verrät Ihnen, wie sich alle installierten nicht-proportionalen Schriften ermitteln lassen.

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  15.234 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 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

Dieser Tipp wurde bereits 15.234 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel