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 17.333 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Neu! sevEingabe 3.0 Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. |
||||||||||||||||
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. |