Kontakt
DSVGO
Möchte man Bildschirm- und Drucker-Ausgaben "synchronisieren" (so dass sie wirklich erkennbar gleich aussehen, etwa für eine Vorschau) sollte man für beide Anwendungsfälle den gleichen Font benutzen. Leider entspricht die Menge der Bildschirm-Fonts nicht unbedingt der Menge der Drucker-Fonts.
Abhilfe schafft die u.g. SecureFonts-Funktion, welche gerade die Schnittmenge der Bildschirm- und Drucker-Fonts zurückgibt.
Das folgende Beispiel benutzt die unten definierte SecureFonts-Collection, um eine ComboBox mit den "sicheren" Font-Namen zu füllen:
Private Sub Form_Load() Dim vFont As Variant With cmbFont '.Sorted = True '.Style = 2 'Dropdown List .Clear For Each vFont In SecureFonts If Len(vFont) Then .AddItem vFont Next vFont If SecureFonts.Count Then .ListIndex = 0 End With End Sub
Der folgende Code ist eigentlich relativ einfach: Erst werden alle Drucker-Fonts in eine Collection geladen. Dann werden alle Bildschirm-Fonts darauf getestet, ob sie in dieser Collection vorkommen. Übereinstimmende Treffer werden in der SecureFonts-Collection gesammelt.
Durch Nutzung der statischen colFonts-Variable muss dieser Prozess nur beim ersten Aufruf durchgeführt werden - es sei denn, man setzt den optionalen Refresh-Parameter auf True. Der wiederholte Aufruf dieser Funktion ist dadurch deutlich schneller (etwa Faktor 100 - je nach Font-Anzahl).
Public Function SecureFonts( _ Optional ByVal Refresh As Boolean = False _ ) As Collection 'Deklarationen: Static colFonts As Collection Dim i As Long Dim IsInCollection As Boolean If (colFonts Is Nothing) Or Refresh Then 'Kandidaten (d.h. Drucker-Fonts) sammeln: Set colFonts = New Collection With Printer For i = 1 To .FontCount colFonts.Add True, .Fonts(i) Next i End With 'In Bildschirm-Fonts nach Duplikaten suchen: Set SecureFonts = New Collection With Screen For i = 1 To .FontCount 'Check auf Treffer: On Error Resume Next IsInCollection = colFonts(.Fonts(i)) On Error GoTo 0 If IsInCollection Then SecureFonts.Add .Fonts(i) IsInCollection = False End If Next i End With 'Ergebnis cachen: Set colFonts = SecureFonts Else 'Cache benutzen: Set SecureFonts = colFonts End If End Function
© Jost Schwider, 08.08.2002-08.08.2002 - http://vb-tec.de/secfonts.htm