Startseite / Tipps / VB.NET-Tipp 0015: Eine FontListBox mittels einer OwnerDrawn-Listbox realisieren

VB.NET-Tipp 0015: Eine FontListBox mittels einer OwnerDrawn-Listbox realisieren

 von Herfried Wagner

' Dieser Quellcode stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' Projektversion:   Visual Studio 2002/2003
' Option Strict:    An
' Option Explicit:  An
'
' Referenzen: 
'  - System
'  - System.Drawing
'  - System.Windows.Forms
'

' ##############################################################################
' ###################### EnumerationFinishedEventArgs.vb #######################
' ##############################################################################
Option Explicit On 
Option Strict On
Option Compare Binary

Imports System

' <remarks>
'   Stellt Informationen für das Ereignis, das 
'   beim Abschliessen der Enumeration relevant sind,
'   bereit.
' </remarks>
Public Class EnumerationFinishedEventArgs
    Inherits EventArgs

    Private m_blnCancelled As Boolean
    Private m_intValidFontsCount As Integer
    Private m_intInvalidFontsCount As Integer

    ' <summary>
    '   Erstellt eine neue Instanz der Klasse und 
    '   weist ihren Eigenschaften die übergebenen Werte zu.
    ' </summary>
    ' <param name="blnCancelled">Erfolte ein vorzeitiger 
    '   Abbruch des Enumerationsvorgangs?</param>
    ' <param name="intValidFontsCount">Anzahl der erfolgreich 
    '   geladenen Fonts.</param>
    ' <param name="intInvalidFontsCount">Anzahl der nicht 
    '   erfolgreich geladenen Fonts.</param>
    Public Sub New( _
      ByVal blnCancelled As Boolean, _
      ByVal intValidFontsCount As Integer, _
      ByVal intInvalidFontsCount As Integer)
        m_blnCancelled = blnCancelled
        m_intValidFontsCount = intValidFontsCount
        m_intInvalidFontsCount = intInvalidFontsCount
    End Sub

    ' <summary>
    '   Gibt an oder zurück, ob der Enumerationsvorgang 
    '   vorzeitig abgebrochen wurde.
    ' </summary>
    ' <value>Erfolgte ein vorzeitiger Abbruch 
    '   des Enumerationsvorgangs?</value>
    Public Property Cancelled() As Boolean
        Get
            Return m_blnCancelled
        End Get
        Set(ByVal Value As Boolean)
            m_blnCancelled = Value
        End Set
    End Property

    ' <summary>
    '   Gibt an oder gibt zurück, wie viele 
    '   Fonts erfolgreich geladen werden konnten.
    ' </summary>
    ' <value>Anzahl der erfolgreich geladenen Fonts.</value>
    Public Property ValidFontsCount() As Integer
        Get
            Return m_intValidFontsCount
        End Get
        Set(ByVal Value As Integer)
            m_intValidFontsCount = Value
        End Set
    End Property

    ' <summary>
    '   Gibt an oder gibt zurück, wie viele Fonts 
    '   nicht erfolgreich geladen werden konnten.
    ' </summary>
    ' <value>Anzahl der nicht erfolgreich geladenen Fonts.</value>
    Public Property InvalidFontsCount() As Integer
        Get
            Return m_intInvalidFontsCount
        End Get
        Set(ByVal Value As Integer)
            m_intInvalidFontsCount = Value
        End Set
    End Property
End Class
' ##############################################################################
' ############################## FontListBox.vb ################################
' ##############################################################################
Option Explicit On 
Option Strict On
Option Compare Binary

Imports System
Imports System.Drawing
Imports System.Threading
Imports System.Windows.Forms

' <remarks>
'   Erweitert die Standard-ListBox dahingehend, 
'   dass darin alle verfügbaren Schriftarten angezeigt werden.
' </remarks>
Public Class FontListBox
    Inherits ListBox

    ' <summary>
    '   Wird ausgelöst, wenn alle Schriftarten 
    '   in das Steuerelement geladen wurden.
    ' </summary>
    ' <param name="sender">Objekt, das das Ereignis auslöst.</sender>
    ' <param name="e">Mit dem Ereignis verbundene Informationen.</sender>
    Public Event EnumerationFinished( _
      ByVal sender As Object, _
      ByVal e As EnumerationFinishedEventArgs)

    Private m_EnumThread As Thread
    Private m_blnHasFocus As Boolean

    Private m_sngFontSize As Single
    Private m_blnEnumerating As Boolean

    Private m_intValidFontsCount As Integer
    Private m_intInvalidFontsCount As Integer


    Private Sub FontListBox_MeasureItem( _
      ByVal sender As Object, _
      ByVal e As MeasureItemEventArgs) _
      Handles MyBase.MeasureItem

        ' Es gibt eine Auswahl.
        If e.Index >= 0 And e.Index < Me.Items.Count Then
            Dim strItemCaption As String = Me.Items(e.Index).ToString()
            Try

                ' Font setzen und Abmasse ermitteln, 
                ' dann die Grösse des Items bestimmen.
                Dim fntCurrent As Font = _
                  New System.Drawing.Font( _
                    strItemCaption, _
                    m_sngFontSize, _
                    FontStyle.Regular, _
                    GraphicsUnit.Point)
                Dim MySizeF As SizeF = _
                  e.Graphics.MeasureString(strItemCaption, _
                    fntCurrent)

                ' Oben und unten jeweils ein Pixel Abstand.
                e.ItemHeight = CInt(MySizeF.Height) + 2
                e.ItemWidth = CInt(MySizeF.Width)
            Catch

                ' Hier müssen wir nichts machen, da 
                ' implizit die Prozedur verlassen wird.
            End Try
        End If
    End Sub

    Private Sub FontListBox_DrawItem( _
      ByVal sender As Object, _
      ByVal e As DrawItemEventArgs) _
      Handles MyBase.DrawItem

        ' Es gibt eine Auswahl.
        If e.Index >= 0 And e.Index < Me.Items.Count Then
            Dim strItemCaption As String = Me.Items(e.Index).ToString()
            Dim fntCurrent As Font
            Try

                ' Versuchen, den Font zu erstellen.
                fntCurrent = New System.Drawing.Font( _
                  strItemCaption, _
                  Me.FontSize, _
                  FontStyle.Regular, _
                  GraphicsUnit.Point)
            Catch
                Return
            End Try

            ' Das Item ist ausgewählt.
            If (e.State And DrawItemState.Selected) = _
                DrawItemState.Selected Then

                ' Highlight-Rechteck für das Element; dann 
                ' wird ein Fokusrechteck gezeichnet (dies
                ' könnte man so erweitern, dass das Zeichnen 
                ' nur erfolgt, wenn sich Windows im
                ' entsprechenden Modus befindet). Schliesslich 
                ' wird noch der Text gezeichnet.
                e.Graphics.FillRectangle(SystemBrushes.Highlight, e.Bounds)
                If Me.ShowFocusCues And m_blnHasFocus Then
                    ControlPaint.DrawFocusRectangle(e.Graphics, e.Bounds)
                End If
                e.Graphics.DrawString(strItemCaption, _
                  fntCurrent, _
                  SystemBrushes.HighlightText, _
                  e.Bounds.Left, _
                  e.Bounds.Top + 1)

            ' Das Item ist nicht ausgewählt.
            Else

                ' Neuzeichnen des Hintergrunds, um alte States 
                ' zu entfernen, anschliessend zeichnen
                ' des Textes im entsprechenden Font.
                e.Graphics.FillRectangle(SystemBrushes.Window, e.Bounds)
                e.Graphics.DrawString( _
                  strItemCaption, _
                  fntCurrent, _
                  SystemBrushes.WindowText, _
                  e.Bounds.Left, _
                  e.Bounds.Top + 1)
            End If
        End If
    End Sub

    Protected Overrides Sub OnLostFocus(ByVal e As System.EventArgs)
        m_blnHasFocus = False
        Me.Invalidate()
    End Sub

    Protected Overrides Sub OnGotFocus(ByVal e As System.EventArgs)
        m_blnHasFocus = True
        Me.Invalidate()
    End Sub

    ' <summary>
    '   Leert die Liste und füllt sie mit den aktuellen Schriften neu.
    ' </summary>
    Public Sub Refill()
        Me.Items.Clear()
        MyBase.OnSelectedIndexChanged(New EventArgs())

        ' Falls gerade enumeriert wird, Enumeration abbrechen.
        If (Not m_EnumThread Is Nothing) AndAlso m_EnumThread.IsAlive Then
            m_EnumThread.Abort()
            m_blnEnumerating = False
        End If

        ' Thread für EnumFonts erstellen und starten.
        m_EnumThread = New Threading.Thread(AddressOf EnumFonts)
        m_EnumThread.Start()
    End Sub

    ' <summary>
    '   Bricht einen laufenden Enumerationsvorgang ab.
    ' </summary>
    Public Sub AbortEnumeration()
        If (Not m_EnumThread Is Nothing) AndAlso m_EnumThread.IsAlive Then
            m_EnumThread.Abort()
            RaiseEvent EnumerationFinished(Me, _
              New EnumerationFinishedEventArgs( _
                True, _
                m_intValidFontsCount, _
                m_intInvalidFontsCount))
            m_blnEnumerating = False
        Else
            Throw New Exception("Es wird nicht enumeriert, " & _
              "daher kann auch nicht abgegrochen werden")
        End If
    End Sub

    ' <summary>
    '   Gibt die Grösse der Schrift an oder gibt diese zurück.
    ' </summary>
    ' <value>Grösse der Schrift, in der die Einträge 
    '   angezeigt werden.</value>
    Public Property FontSize() As Single
        Get
            Return m_sngFontSize
        End Get
        Set(ByVal Value As Single)
            m_sngFontSize = Value
            Refill()
        End Set
    End Property

    ' <summary>
    '   Gibt an, ob gerade eine Enumeration durchgeführt wird.
    ' </summary>
    ' <value>Wird gerade eine Enumeration durchgeführt?</value>
    Public ReadOnly Property Enumerating() As Boolean
        Get
            Return m_blnEnumerating
        End Get
    End Property

    ' <summary>
    '   Enumeriert alle verfügbaren Fonts. Da dies 
    '   etwas mehr Zeit beanspruchen kann, erfolgt die
    '   Ausführung in einem eigenen Thread.
    ' </summary>
    Private Sub EnumFonts()
        m_blnEnumerating = True
        m_intInvalidFontsCount = 0
        m_intValidFontsCount = 0

        ' Alle Fontfamilien durchgehen.
        Dim fntfam As FontFamily
        For Each fntfam In System.Drawing.FontFamily.Families

            ' Font anhand des Namens erstellen.
            Try
                Dim fntCurrent As Font = _
                  New System.Drawing.Font( _
                    fntfam.Name, _
                    m_sngFontSize, _
                    FontStyle.Regular, _
                    GraphicsUnit.Pixel)
                Me.Items.Add(fntfam.Name)
                m_intValidFontsCount += 1
            Catch
                m_intInvalidFontsCount += 1
            End Try
        Next fntfam
        RaiseEvent EnumerationFinished(Me, _
          New EnumerationFinishedEventArgs( _
            False, m_intValidFontsCount, _
            m_intInvalidFontsCount))
        m_blnEnumerating = False
    End Sub
End Class
' ##############################################################################
' ################################ MainForm.vb #################################
' ##############################################################################
Option Explicit On 
Option Strict On
Option Compare Binary

Imports Microsoft.VisualBasic
Imports System.Windows.Forms

' <remarks>
'   Hauptformular der Anwendung.
' </remarks>
Public Class MainForm
    Inherits System.Windows.Forms.Form


    Private Sub btnLoadFonts_Click( _
      ByVal sender As System.Object, _
      ByVal e As System.EventArgs) _
      Handles btnLoadFonts.Click

        ' "Neu Laden".
        If Me.btnLoadFonts.Text = "&Neu laden" Then
            Me.lblStatistics.Text = ""
            Me.btnLoadFonts.Text = "&Stoppen"
            Me.FontListBox1.Refill()

        ' "Stoppen".
        Else
            If Me.FontListBox1.Enumerating Then
                Me.FontListBox1.AbortEnumeration()
            Else
                MessageBox.Show("Die Enumeration läuft nicht " & _
                  "und kann nicht abgebrochen werden!", _
                  Application.ProductName, _
                  MessageBoxButtons.OK, _
                  MessageBoxIcon.Exclamation)
            End If
            Me.btnLoadFonts.Text = "&Neu laden"
        End If
    End Sub

    Private Sub MainForm_Closed( _
      ByVal sender As Object, _
      ByVal e As System.EventArgs) Handles MyBase.Closed

        ' Wenn noch enumeriert wird, dann den
        ' Enumerationsvorgang abbrechen.
        If Me.FontListBox1.Enumerating Then
            Me.FontListBox1.AbortEnumeration()
        End If
    End Sub

    Private Sub txtCurrentFont_TextChanged( _
      ByVal sender As System.Object, _
      ByVal e As System.EventArgs) _
      Handles txtCurrentFont.TextChanged
        Me.FontListBox1.SelectedIndex = _
          Me.FontListBox1.FindString(Me.txtCurrentFont.Text)
    End Sub

    Private Sub FontListBox1_SelectedIndexChanged( _
      ByVal sender As System.Object, _
      ByVal e As System.EventArgs) _
      Handles FontListBox1.SelectedIndexChanged
        If Me.FontListBox1.SelectedItem Is Nothing Then
            Me.lblSelectedFontName.Text = "(keine Auswahl)"
        Else
            Me.lblSelectedFontName.Text = _
              Me.FontListBox1.SelectedItem.ToString()
        End If
    End Sub

    Private Sub FontListBox1_EnumerationFinished( _
      ByVal sender As Object, _
      ByVal e As FontList.EnumerationFinishedEventArgs) _
      Handles FontListBox1.EnumerationFinished
        Me.lblStatistics.Text = _
            "Gültig: " & e.ValidFontsCount.ToString() & _
            ControlChars.NewLine & _
            "Ungültig: " & e.InvalidFontsCount.ToString() & _
            ControlChars.NewLine & _
            "Abgebrochen: " & e.Cancelled.ToString()
        Me.btnLoadFonts.Text = "&Neu laden"
    End Sub
End Class

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Me.lblStatistics.Text = _
            "Gültig: " & e.ValidFontsCount.ToString() & _
            ControlChars.NewLine & _
            "Ungültig: " & e.InvalidFontsCount.ToString() & _
            ControlChars.NewLine & _
            "Abgebrochen: " & e.Cancelled.ToString()