Installierte Schriften zur Auswahl anbieten VB-Version:  VB5, VB6
	Views:  8.323

Wie kann ich in meinem Programm dem Anwender die installierten Fonts zurAuswahl anbieten, so dass er sich mehrere Schriften aussuchen kann? Mit einerListbox funktioniert das so:

Auf einer Form platzieren Sie eine ListBox und einen CommandButton. StellenSie die ListBox-Eigenschaften wie folgt ein:
Sorted = True
Style = 1 Kontrollkästchen

Dann noch folgenden Code einfügen:

Option Explicit
 
' zunächst die benötigten API-Deklarationen
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 Sub Form_Load()
  ' alle installierten Schriften anzeigen
  Dim I As Integer
 
  ' Listbox leeren
  List1.Clear
 
  ' Bildschirmschriften
  For I = 0 To Screen.FontCount - 1
    If Screen.Fonts(I) << "Symbol" Then
      List1.AddItem Screen.Fonts(I)
    End If
  Next I
 
  ' Jetzt noch die Drucker-Schriften
  For I = 0 To Printer.FontCount - 1
    If Printer.Fonts(I) << "Symbol" Then
      ' schon vorhanden?
      If SendMessage(List1.hwnd, LB_FINDSTRINGEXACT, _
        -1, Printer.Fonts(I)) < 0 Then
         ' Nein, also hinzufügen
        List1.AddItem Printer.Fonts(I)
      End If
    End If
  Next I
End Sub
 
 
Private Sub Command1_Click()
  ' alle ausgewählten Schriften in ein Array
  ' kopieren
  Dim I As Integer
  Dim lCount As Long
  Dim arrFont() As String
 
  lCount = 0
  For I = 0 To List1.ListCount - 1
    ' Eintrag selektiert?
    If List1.Selected(I) Then
      ReDim Preserve arrFont(lCount)
      arrFont(lCount) = List1.List(I)
      lCount = lCount + 1
    End If
  Next I
 
  MsgBox CStr(lCount) & " Schrift(en) ausgewählt!"
End Sub

Oder soll der Benutzer die Schriften aus einem PopUp-Menü auswählen können? Dannsehen Sie sich doch mal unseren Tipp  Schriftauswahl per PopUp-Menü realisieren an.