'Author: Fawxes
'Date: 22nd November 2005
'Foreword: This strongly-typed collection of MyNamespace.MyClass objects enables sorting and searching.
' The collection inherits from CollectionBase and implements IBindingList
' to enable the collections to be sorted according to properties and direction.
' Some methods are not supported and if they are required they be edited with
' code that provides support and moved to the correct region.
Public Class SortedCollection
Inherits CollectionBase
Implements System.ComponentModel.IBindingList
Implements System.Collections.IComparer
#Region " Constructors "
Public Sub New()
'Call the base class new method
MyBase.New()
'Initialise the sort direction
Me.mSortDirection = New System.ComponentModel.ListSortDirection
Me.mSortDirection = System.ComponentModel.ListSortDirection.Ascending
'Create a property descriptor collection for a new object
Dim propCollection As System.ComponentModel.PropertyDescriptorCollection
propCollection = System.ComponentModel.TypeDescriptor.GetProperties(New Object)
''Initialise the sort property
Dim propDesc As System.ComponentModel.PropertyDescriptor
propDesc = propCollection.Find("ToString", True)
'Initialise the IsSorted flag
mIsSorted = False
'Initialise the auto sort flag
Me.mAutoSort = False
End Sub 'New
#End Region 'Constructors
#Region " Binding List Supported Members "
Public Function AddNew() As Object Implements _
System.ComponentModel.IBindingList.AddNew
'Call the base class method
Me.Add(New MyNamespace.MyClass)
End Function
Public ReadOnly Property AllowEdit() As Boolean _
Implements System.ComponentModel.IBindingList.AllowEdit
Get
Return True
End Get
End Property
Public ReadOnly Property AllowNew() As Boolean _
Implements System.ComponentModel.IBindingList.AllowNew
Get
Return True
End Get
End Property
Public ReadOnly Property AllowRemove() As Boolean _
Implements System.ComponentModel.IBindingList.AllowRemove
Get
Return True
End Get
End Property
Private mIsSorted As Boolean
Public ReadOnly Property IsSorted() As Boolean _
Implements System.ComponentModel.IBindingList.IsSorted
Get
Return Me.mIsSorted
End Get
End Property 'IsSorted
Public ReadOnly Property SupportsSearching() As Boolean _
Implements System.ComponentModel.IBindingList.SupportsSearching
Get
Return True
End Get
End Property 'SupportsSearching
Public ReadOnly Property SupportsSorting() As Boolean _
Implements System.ComponentModel.IBindingList.SupportsSorting
Get
Return True
End Get
End Property 'SupportsSorting
Public ReadOnly Property SupportsChangeNotification() As Boolean _
Implements System.ComponentModel.IBindingList.SupportsChangeNotification
Get
Return True
End Get
End Property 'SupportsChangeNotification
Public Sub ApplySort(ByVal [property] As System.ComponentModel.PropertyDescriptor, _
ByVal direction As System.ComponentModel.ListSortDirection) _
Implements System.ComponentModel.IBindingList.ApplySort
'If sorting is supported then sort the objects, otherwise throw an exception
If Me.SupportsSorting Then
'Set the property and direction
Me.mSortProperty = [property]
Me.mSortDirection = direction
'Sort the inner list
Me.InnerList.Sort(Me)
'Set the is sorted flag
Me.mIsSorted = True
'Raise the list changed event
RaiseEvent ListChanged(Me, _
New System.ComponentModel.ListChangedEventArgs( _
System.ComponentModel.ListChangedType.Reset, _
Me.SortProperty))
Else
Throw New System.NotSupportedException
End If
End Sub 'ApplySort
'Provide a sort direction object
Dim mSortDirection As System.ComponentModel.ListSortDirection
Public ReadOnly Property SortDirection() As System.ComponentModel.ListSortDirection _
Implements System.ComponentModel.IBindingList.SortDirection
Get
Return Me.mSortDirection
End Get
End Property 'SortDirection
'Provide a sort property object
Dim mSortProperty As System.ComponentModel.PropertyDescriptor
Public ReadOnly Property SortProperty() As System.ComponentModel.PropertyDescriptor _
Implements System.ComponentModel.IBindingList.SortProperty
Get
Return Me.mSortProperty
End Get
End Property 'SortProperty
Public Function Find(ByVal [property] As System.ComponentModel.PropertyDescriptor, _
ByVal key As Object) As Integer _
Implements System.ComponentModel.IBindingList.Find
'Provide an algorithm to find the position of an object based uopn a property
'value only if the colletion is sorted and the property passed is the sorted
'property
If Not (Me.IsSorted And Me.SortProperty Is [property]) Then
Me.mSortProperty = [property]
Me.ApplySort(Me.SortProperty, Me.SortDirection)
End If
'Declare left, right and mid pointers
Dim left As Integer
Dim right As Integer
Dim mid As Integer
'Set the intial values of left and right
left = 0
right = Me.Count - 1
'Check the left and right extremes
If Me.CompareProperty(Me.Item(left), key) > 0 Then _
Throw New System.ArgumentException
If Me.CompareProperty(Me.Item(left), key) = 0 Then Return left
If Me.CompareProperty(Me.Item(right), key) < 0 Then _
Throw New System.ArgumentException
If Me.CompareProperty(Me.Item(right), key) = 0 Then Return right
Do While left < right
'Calculate the mid point
mid = System.Convert.ToInt16(System.Convert.ToDouble(left + right) / 2)
'Check the mid point
Select Case Me.CompareProperty(Me.Item(mid), key)
Case Is > 0
right = mid
Case Is = 0
Return mid
Case Is < 0
left = mid
End Select
'If there are only two options left check them to avoid a repeating loop
If right - left = 1 Then
If Me.CompareProperty(Me.Item(left), key) = 0 Then Return left
If Me.CompareProperty(Me.Item(right), key) = 0 Then Return left
Throw New System.ArgumentException
End If
Loop
End Function 'Find
Public Event ListChanged(ByVal sender As Object, _
ByVal e As System.ComponentModel.ListChangedEventArgs) _
Implements System.ComponentModel.IBindingList.ListChanged
#End Region 'Binding List Supported Members
#Region " Binding List Not Supported Members "
Public Sub AddIndex(ByVal [property] As System.ComponentModel.PropertyDescriptor) _
Implements System.ComponentModel.IBindingList.AddIndex
Throw New System.NotSupportedException
End Sub 'AddIndex
Public Sub RemoveIndex(ByVal [property] As System.ComponentModel.PropertyDescriptor) _
Implements System.ComponentModel.IBindingList.RemoveIndex
Throw New System.NotSupportedException
End Sub 'RemoveIndex
Public Sub RemoveSort() Implements System.ComponentModel.IBindingList.RemoveSort
Throw New System.NotSupportedException
End Sub 'RemoveSort
#End Region 'Binding List Not Supported Members
#Region " Collection Base Supported Members "
'Implement a default item object
Default Public Overridable Property Item(ByVal index As Integer) _
As MyNamespace.MyClass
Get
Return CType(Me.List.Item(index), MyNamespace.MyClass)
End Get
Set(ByVal Value As MyNamespace.MyClass)
'Set the value
Me.List.Item(index) = Value
'If auto sort is set then apply the sort
If Me.AutoSort Then Me.ApplySort(Me.SortProperty, Me.SortDirection)
End Set
End Property 'Item
'Implement Add, Insert and Remove methods
Public Overridable Function Add( _
ByVal value As MyNamespace.MyClass) As Integer
'Add the item
Return Me.List.Add(value)
'If auto sort is set then apply the sort
If Me.AutoSort Then Me.ApplySort(Me.SortProperty, Me.SortDirection)
End Function 'Add
Public Overridable Sub Insert(ByVal index As Integer, _
ByVal value As MyNamespace.MyClass)
'Insert the item
Me.Insert(index, value)
'If auto sort is set then apply the sort
If Me.AutoSort Then Me.ApplySort(Me.SortProperty, Me.SortDirection)
End Sub 'Insert
Public Overridable Sub Remove(ByVal value As MyNamespace.MyClass)
'Remove the item
Me.Remove(value)
End Sub 'Remove
'Implement IndexOf and Contains methods
Public Overridable Function IndexOf( _
ByVal value As MyNamespace.MyClass) As Integer
Return Me.IndexOf(value)
End Function 'IndexOf
Public Overridable Function Contains( _
ByVal value As MyNamespace.MyClass) As Boolean
Return Me.Contains(value)
End Function 'Contains
'Override some of the change validation methods
Protected Overrides Sub OnInsert(ByVal index As Integer, ByVal value As Object)
If Not value.GetType Is Type.GetType("MyNamespace.MyClass ") Then
Throw New System.ArgumentException( _
"Value must be of type MyNamespace.MyClass ", "Value")
End If
End Sub 'OnInsert
Protected Overrides Sub OnRemove(ByVal index As Integer, ByVal value As Object)
If Not value.GetType Is Type.GetType("MyNamespace.MyClass ") Then
Throw New System.ArgumentException( _
"Value must be of type MyNamespace.MyClass ", "Value")
End If
End Sub 'OnRemove
Protected Overrides Sub OnSet(ByVal index As Integer, _
ByVal oldValue As Object, _
ByVal newValue As Object)
If Not newValue.GetType Is Type.GetType("MyNamespace.MyClass ") Then
Throw New System.ArgumentException( _
"Value must be of type MyNamespace.MyClass ", _
"NewValue")
End If
End Sub 'OnSet
Protected Overrides Sub OnValidate(ByVal value As Object)
If Not value.GetType Is Type.GetType("MyNamespace.MyClass ") Then
Throw New System.ArgumentException( _
"Value must be of type MyNamespace.MyClass ")
End If
End Sub 'OnValidate
#End Region 'Collection Base Supported Members
#Region " Collection Base Not Supported Members "
'None
#End Region 'Collection Base Not Supported Members
#Region " Sorting "
Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer _
Implements System.Collections.IComparer.Compare
'This method compares the two objects based upon the proerty identified by the
'SortProperty
'Collect the values of the properties in the SortProperty
Dim xValue As Object = Me.SortProperty.GetValue(x)
Dim yValue As Object = Me.SortProperty.GetValue(y)
'Compare the two values
If Me.SortDirection = System.ComponentModel.ListSortDirection.Ascending Then
Return New CaseInsensitiveComparer().Compare(xValue, yValue)
Else
Return New CaseInsensitiveComparer().Compare(yValue, xValue)
End If
End Function 'Compare
Public Function CompareProperty(ByVal item As Object, _
ByVal value As Object) As Integer
'This method compares the sorted property of the item against the value
'Collect the values of the properties in the SortProperty
Dim xValue As Object = Me.SortProperty.GetValue(item)
'Compare the two values
If Me.SortDirection = System.ComponentModel.ListSortDirection.Ascending Then
Return New CaseInsensitiveComparer().Compare(xValue, value)
Else
Return New CaseInsensitiveComparer().Compare(value, xValue)
End If
End Function 'Compare
'Provide a property to identify if sorting is automatic when items are added,
'removed or changed
Private mAutoSort As Boolean
Public Property AutoSort() As Boolean
Get
Return Me.mAutoSort
End Get
Set(ByVal Value As Boolean)
Me.mAutoSort = Value
End Set
End Property 'AutoSort
#End Region 'Sorting
End Class