VB.NET-Tipp 0128: Erweiterte BindingList

von ChristianM

Beschreibung
Ab Visual Basic 2005 ist es mit der Klasse BindingList(Of T) möglich beliebige Datenaufzählungen für ObjectBinding zu verwenden. Damit hat man eine voll DataBinding-fähige Alternative zu DataSets. Sehr zu empfehlen sind hier die sehr informativen MSDN-Lehrvideos (dort den Abschnitt "Object Binding Video Series" aufsuchen).
Schwierigkeitsgrad:
Schwierigkeitsgrad 3
Framework-Version(en):
.NET Framework 1.0, .NET Framework 1.1, .NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5, .NET Compact Framework 1.0, .NET Compact Framework 2.0, .NET Framework 4
.NET-Version(en):
Visual Basic 2002, Visual Basic 2003, Visual Basic 2005, Visual Basic 2008, Visual Basic 2010
Download:
Download des Beispielprojektes [14,69 KB]
' 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 2005
' Option Strict:    An
'
' Referenzen: 
'  - System
'  - System.Data
'  - System.Deployment
'  - System.Drawing
'  - System.Runtime.Serialization.Formatters.Soap
'  - System.Windows.Forms
'  - System.Xml
'
' Imports: 
'  - Microsoft.VisualBasic
'  - System
'  - System.Collections
'  - System.Collections.Generic
'  - System.Data
'  - System.Diagnostics
'  - System.Runtime.Serialization.Formatters.Binary
'

' ##############################################################################
' ############################# Compatibility.vb ###############################
' ##############################################################################
Module Compatibility
    Public Delegate Sub Action()
    Public Delegate Sub Action(Of T1, T2)(ByVal Arg1 As T1, ByVal Arg2 As T2)
    Public Delegate Sub Action(Of T1, T2, T3)( _
        ByVal Arg1 As T1, ByVal Arg2 As T2, ByVal Arg3 As T3)

    Public Delegate Function Func(Of T)() As T
    Public Delegate Function Func(Of T1, T2)(ByVal Arg1 As T1) As T2
    Public Delegate Function Func(Of T1, T2, T3)( _
        ByVal Arg1 As T1, ByVal Arg2 As T2) As T3
    Public Delegate Function Func(Of T1, T2, T3, T4)( _
        ByVal Arg1 As T1, ByVal Arg2 As T2, ByVal Arg3 As T3) As T4
End Module

' ##############################################################################
' ########################### CustomBindingList.vb #############################
' ##############################################################################
Imports System.IO
Imports System.ComponentModel

Public Class CustomBindingList(Of T) : Inherits BindingList(Of T)
    Private m_OriginalCollection As New List(Of T)
    Private ReadOnly m_listRef As List(Of T)
    Private m_Comparer As PropertyComparer(Of T)

    Public Sub New()
        MyBase.New()
        m_listRef = DirectCast(MyBase.Items, List(Of T))
    End Sub

    Protected Overrides Function FindCore(ByVal prop As PropertyDescriptor, _
            ByVal key As Object) As Integer

        For i As Integer = 0 To Me.Count - 1
            If prop.GetValue(m_listRef(i)).Equals(key) Then Return i
        Next
        Return -1
    End Function

    Protected Overrides ReadOnly Property SupportsSearchingCore() As Boolean
        Get
            Return True
        End Get
    End Property
    Protected Overrides ReadOnly Property IsSortedCore() As Boolean
        Get
            Return m_Comparer IsNot Nothing
        End Get
    End Property
    Protected Overrides ReadOnly Property SupportsSortingCore() As Boolean
        Get
            Return True
        End Get
    End Property
    Protected Overrides ReadOnly Property SortDirectionCore() _
            As ListSortDirection

        Get
            Return m_Comparer.Direction
        End Get
    End Property

    Protected Overrides Sub ApplySortCore(ByVal prop As PropertyDescriptor, _
            ByVal direction As ListSortDirection)

        m_Comparer = New PropertyComparer(Of T)(prop, direction)
        m_listRef.Sort(m_Comparer)
        OnListChanged(New ListChangedEventArgs(ListChangedType.Reset, -1))
        MyBase.AllowRemove = False
        MyBase.AllowNew = False
    End Sub

    Protected Overrides ReadOnly Property SortPropertyCore() _
            As PropertyDescriptor

        Get
            If m_Comparer Is Nothing Then Return Nothing
            Return m_Comparer.Property
        End Get
    End Property

    Protected Overrides Sub InsertItem(ByVal index As Integer, ByVal item As T)
        If IsSortedCore Then
            m_OriginalCollection.Add(item)
        Else
            m_OriginalCollection.Insert(index, item)
        End If
        MyBase.InsertItem(index, item)
    End Sub

    Protected Overrides Sub RemoveItem(ByVal index As Integer)
        m_OriginalCollection.RemoveAt(index)
        MyBase.RemoveItem(index)
    End Sub

    Protected Overrides Sub RemoveSortCore()
        m_listRef.Clear()
        m_listRef.AddRange(m_OriginalCollection)
        m_Comparer = Nothing
        MyBase.AllowRemove = True
        MyBase.AllowNew = True
        OnListChanged(New ListChangedEventArgs(ListChangedType.Reset, -1))
    End Sub

#Region "Persistence Support"

    Private Sub Save(ByVal filename As String, _
            ByVal Serialize As Action(Of Stream, Object))

        Using stream As IO.FileStream = _
                New IO.FileStream(filename, IO.FileMode.Create)

            Serialize(stream, DirectCast(m_OriginalCollection, List(Of T)))
        End Using
    End Sub

    Private Sub Load(ByVal filename As String, _
            ByVal Deserialize As Func(Of Stream, Object))

        Using stream As IO.FileStream = _
                New IO.FileStream(filename, IO.FileMode.Open)

            m_OriginalCollection = DirectCast(Deserialize(stream), List(Of T))
            Me.ClearItems()
            DirectCast(m_listRef, List(Of T)).AddRange(m_OriginalCollection)
        End Using
        Me.OnListChanged(New ListChangedEventArgs(ListChangedType.Reset, -1))
    End Sub

    Public Sub SaveBinary(ByVal filename As String)
        Dim formatter As New  _
            Runtime.Serialization.Formatters.Binary.BinaryFormatter

        Save(filename, AddressOf formatter.Serialize)
    End Sub

    Public Sub LoadBinary(ByVal filename As String)
        Load(filename, AddressOf ( _
             New Runtime.Serialization.Formatters.Binary.BinaryFormatter).Deserialize)
    End Sub

    Public Sub SaveXML(ByVal filename As String)
        Save(filename, AddressOf ( _
             New Xml.Serialization.XmlSerializer(GetType(List(Of T)))).Serialize)
    End Sub

    Public Sub LoadXML(ByVal filename As String)
        Load(filename, AddressOf ( _
             New Xml.Serialization.XmlSerializer(GetType(List(Of T)))).Deserialize)
    End Sub
#End Region

End Class

' ##############################################################################
' ################################ frmList.vb ##################################
' ##############################################################################
Imports System.Windows.Forms
Imports System.ComponentModel

Public Class frmList

    Private m_List As CustomBindingList(Of ImportantEvent)
    Private m_Binding As BindingSource

    Private Sub frmList_Load(ByVal sender As Object, ByVal e As EventArgs) _
         Handles MyBase.Load

        ' Datenobjekt erstellen
        m_List = New CustomBindingList(Of ImportantEvent)
        ' Daten hinzufügen
        With m_List
            .Add(New ImportantEvent(Now.AddDays(2), "Geburtstag", _
                "Ich werde wieder ein Jahr älter!", 0))
            .Add(New ImportantEvent(Now.AddDays(-2), _
                "Geschäftstermin", _
                "Hoffe diesmal geht endlich etwas weiter", 196))
            .Add(New ImportantEvent(Now.AddDays(7), _
                "Urlaubsbeginn", "Na endlich", 255))
            .Add(New ImportantEvent(Now.AddDays(14), _
                "Urlaubsende", "Schade", 255))
        End With
        m_Binding = New BindingSource
        m_Binding.DataSource = m_List

        ' Folgende Einstellungen könnten auch im Designer getätigt werden:
        With DataGridView
            .AllowUserToOrderColumns = False
            .AutoGenerateColumns = True
            'Auswahlmöglichkeit
            .SelectionMode = DataGridViewSelectionMode.FullRowSelect
            .MultiSelect = False
            'Spalten-Größe anpassen
            .AutoSizeColumnsMode = _
                DataGridViewAutoSizeColumnsMode.DisplayedCells
            .AutoSizeRowsMode = DataGridViewAutoSizeRowsMode.DisplayedCells
        End With

        ' DataBinding hinzufügen
        DataGridView.DataSource = m_Binding
    End Sub

    Private Sub cmdSaveBinary_Click(ByVal sender As Object, _
            ByVal e As EventArgs) Handles cmdSaveBinary.Click

        ' Binär speichern
        m_List.SaveBinary(IO.Path.Combine( _
            My.Application.Info.DirectoryPath, "BinData.bin"))
    End Sub

    Private Sub cmdSaveXML_Click(ByVal sender As Object, _
            ByVal e As EventArgs) Handles cmdSaveXML.Click

        ' XML speichern
        m_List.SaveXML(IO.Path.Combine( _
            My.Application.Info.DirectoryPath, "XMLData.xml"))
    End Sub

    Private Sub cmdLoadBinary_Click(ByVal sender As Object, _
            ByVal e As EventArgs) Handles cmdLoadBinary.Click

        ' Datenobjekt erstellen
        m_List = New CustomBindingList(Of ImportantEvent)
        ' Binär Laden
        m_List.LoadBinary(IO.Path.Combine( _
            My.Application.Info.DirectoryPath, "BinData.bin"))
        ' Anzeigen
        m_Binding.DataSource = m_List
    End Sub

    Private Sub cmdLoadXML_Click(ByVal sender As Object, _
            ByVal e As EventArgs) Handles cmdLoadXML.Click

        ' Datenobjekt erstellen
        m_List = New CustomBindingList(Of ImportantEvent)
        ' XML laden
        m_List.LoadXML(IO.Path.Combine( _
            My.Application.Info.DirectoryPath, "XMLData.xml"))
        ' Anzeigen
        m_Binding.DataSource = m_List
    End Sub

    Private Sub cmdSearch_Click(ByVal sender As Object, _
            ByVal e As EventArgs) Handles cmdSearch.Click

        ' Eintrag suchen
        Dim pos As Integer = DirectCast(DataGridView.DataSource,  _
            BindingSource).Find("Name", txtSearch.Text)
        If pos < 0 Then
            MsgBox("Kein passender Eintrag gefunden!", MsgBoxStyle.Information)
        Else
            DataGridView.Rows(pos).Selected = True
        End If
    End Sub

    Private Sub DataGridView_ColumnHeaderMouseClick(ByVal sender As Object, _
            ByVal e As DataGridViewCellMouseEventArgs) _
            Handles DataGridView.ColumnHeaderMouseClick

        Static oldSorted As PropertyDescriptor = Nothing
        Dim ibl As IBindingList = m_List
        If oldSorted Is ibl.SortProperty AndAlso _
            ibl.SortDirection = ListSortDirection.Ascending Then

            m_Binding.Sort = ""
        End If
        oldSorted = ibl.SortProperty
    End Sub

End Class
' ##############################################################################
' ############################# ImportantEvent.vb ##############################
' ##############################################################################
' Durch dieses Attribut funktioniert die binäre Serialisierung
<Serializable()> _
Public Class ImportantEvent
    Private m_Time As Date
    Public Property Time() As Date
        Get
            Return m_Time
        End Get
        Set(ByVal value As Date)
            m_Time = value
        End Set
    End Property

    Private m_Name As String
    Public Property Name() As String
        Get
            Return m_Name
        End Get
        Set(ByVal value As String)
            m_Name = value
        End Set
    End Property

    Private m_Comment As String
    Public Property Comment() As String
        Get
            Return m_Comment
        End Get
        Set(ByVal value As String)
            m_Comment = value
        End Set
    End Property

    Private m_Rating As Byte
    Public Property Rating() As Byte
        Get
            Return m_Rating
        End Get
        Set(ByVal value As Byte)
            m_Rating = value
        End Set
    End Property

    Public Sub New(ByVal TimePoint As Date, _
            ByVal Name As String, _
            ByVal Comment As String, _
            ByVal Rating As Byte)

        m_Time = TimePoint
        m_Name = Name
        m_Comment = Comment
        m_Rating = Rating
    End Sub

    ' Für die Serialisierung beötigt
    Public Sub New()
    End Sub

End Class
' ##############################################################################
' ########################### SimpleSortComparer.vb ############################
' ##############################################################################
Imports System.ComponentModel

Public Class PropertyComparer : Implements IComparer

    Public [Property] As PropertyDescriptor
    Public Direction As ListSortDirection

    Public Sub New(ByVal propDesc As PropertyDescriptor, _
            ByVal sortDirection As ListSortDirection)

        [Property] = propDesc
        Direction = sortDirection
    End Sub

    Protected Function Compare(ByVal x As Object, ByVal y As Object) _
            As Integer Implements IComparer.Compare

        Dim xVal As Object = [Property].GetValue(x)
        Dim yVal As Object = [Property].GetValue(y)
        If TypeOf xVal Is IComparable Then
            If xVal Is Nothing Then
                If yVal Is Nothing Then Return 0
                Compare = -DirectCast(yVal, IComparable).CompareTo(Nothing)
            Else
                Compare = DirectCast(xVal, IComparable).CompareTo(yVal)
            End If
        Else
            If xVal Is Nothing Then xVal = ""
            If yVal Is Nothing Then yVal = ""
            Compare = xVal.ToString.CompareTo(yVal.ToString)
        End If
        If Direction = ListSortDirection.Descending Then Return -Compare
    End Function

End Class

Public Class PropertyComparer(Of T) _
    : Inherits PropertyComparer _
    : Implements IComparer(Of T)

    Public Sub New(ByVal propDesc As PropertyDescriptor, _
            ByVal direction As ListSortDirection)

        MyBase.New(propDesc, direction)
    End Sub

    Protected Function Compare1(ByVal x As T, ByVal y As T) As Integer _
            Implements IComparer(Of T).Compare

        Return MyBase.Compare(x, y)
    End Function
End Class
Ihre Meinung

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.