📄 sortedlist.cls
字号:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 1 'Persistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "SortedList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
' CopyRight (c) 2004 Kelly Ethridge
'
' This file is part of VBCorLib.
'
' VBCorLib is free software; you can redistribute it and/or modify
' it under the terms of the GNU Library General Public License as published by
' the Free Software Foundation; either version 2.1 of the License, or
' (at your option) any later version.
'
' VBCorLib is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU Library General Public License for more details.
'
' You should have received a copy of the GNU Library General Public License
' along with Foobar; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
'
' Module: SortedList
'
''
' Provides a means to maintain a list of sorted items based on an associated key.
'
' @remarks The SortedList maintains sort order for every key/value pair
' added to the list. The list is expanded as needed with the addition of new items.
' If a key already exists in the list, an exception is thrown.
'
' @see Constructors
' @see IDictionary
' @see ICollection
' @see IEnumerable
'
Option Explicit
Implements IObject
Implements IEnumerable
Implements ICollection
Implements IDictionary
Private Const DEF_CAPACITY As Long = 16
Private mKeys() As Variant
Private mValues() As Variant
Private mComparer As IComparer
Private mCapacity As Long
Private mCount As Long
Private mVersion As Long
''
' Adds a key/value pair to the list.
'
' @param key The value to used to maintain a sorted order.
' @param value The value associated with the key.
' @remark key must be unique.
Public Sub Add(ByRef Key As Variant, ByRef Value As Variant)
Dim i As Long
i = cArray.BinarySearch(mKeys, Key, 0, mCount, mComparer)
If i >= 0 Then _
Throw Cor.NewArgumentException("An element with this key already exists.", "key")
i = Not i
Call EnsureCapacity(mCount + 1)
If i < mCount Then
Call CopyMemory(mKeys(i + 1), mKeys(i), (mCount - i) * 16)
Call ZeroMemory(mKeys(i), 16)
Call CopyMemory(mValues(i + 1), mValues(i), (mCount - i) * 16)
Call ZeroMemory(mValues(i), 16)
End If
Call VariantCopyInd(mKeys(i), Key)
Call VariantCopyInd(mValues(i), Value)
mCount = mCount + 1
mVersion = mVersion + 1
End Sub
''
' Returns the size of the underlying array.
'
' @return The number of elements the underlying array can hold
' before needing to be resized.
'
Public Property Get Capacity() As Long
Capacity = mCapacity
End Property
''
' Sets the size of the underlying array.
'
' @param RHS The number of elements the underlying array can contain
' before it needs to be resized.
' @remarks If the capacity is set less than the number of items in the
' array, an ArgumentOutOfRangeException exception will be thrown.
'
Public Property Let Capacity(ByVal RHS As Long)
If RHS < mCount Then _
Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_SmallCapacity), "Capacity", RHS)
If RHS = mCapacity Then Exit Property
If RHS = 0 Then RHS = DEF_CAPACITY
mCapacity = RHS
ReDim Preserve mKeys(0 To mCapacity - 1)
ReDim Preserve mValues(0 To mCapacity - 1)
mVersion = mVersion + 1
End Property
''
' Removes all of the items from the list.
'
' @remarks The Count is set to 0, but the capacity remains unchanged.
'
Public Sub Clear()
ReDim mKeys(0 To mCapacity - 1)
ReDim mValues(0 To mCapacity - 1)
mCount = 0
mVersion = mVersion + 1
End Sub
''
' Returns a cloned version of this instance.
'
' @remarks Reference types are not cloned. If there are object types
' in the list, then a new reference to the object is created, but the
' object itself is not cloned.
'
Public Function Clone() As SortedList
Set Clone = New SortedList
Call Clone.CloneHelper(mKeys, mValues, mCount, mComparer)
End Function
''
' Searches the list to determine if the key is contained in the list.
'
' @param Key The key to check if exists in the list.
' @return Indication of the key existing in the list.
' @remarks Internally this function calls <b>ContainsKey</b>.
'
Public Function Contains(ByRef Key As Variant) As Boolean
Contains = ContainsKey(Key)
End Function
''
' Searches the list to determine if the key is contained in the list.
'
' @param Key The key to check if exists in the list.
' @return Indication of the key existing in the list.
'
Public Function ContainsKey(ByRef Key As Variant) As Boolean
ContainsKey = (cArray.BinarySearch(mKeys, Key, 0, mCount, mComparer) >= 0)
End Function
''
' Searches the list to determine if the value is contained in the list.
'
' @param value The value to search for in the list.
' @param comparer A user-supplied IComparer object to perform special comparisons as necessary.
' @return Indication of the value being found in the list.
'
Public Function ContainsValue(ByRef Value As Variant, Optional ByVal Comparer As IComparer) As Boolean
ContainsValue = (cArray.IndexOf(mValues, Value, 0, mCount, Comparer) >= 0)
End Function
''
' Creates a DictionaryEntry for each Key/Value pair and places it in the array.
'
' @param dstArray The array to copy the DictionaryEntry objects to.
' @param Index The starting index in dstArray to begin copying to.
' @remarks Since DictionaryEntry objects are being stored in the array,
' the array must be able to accept that type of object.
'
Public Sub CopyTo(ByRef DstArray As Variant, ByVal Index As Long)
Dim i As Long
If cArray.IsNull(DstArray) Then _
Throw Cor.NewArgumentNullException(Environment.GetResourceString(ArgumentNull_Array), "dstArray")
If Index < LBound(DstArray) Then _
Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_LBound), "index", Index)
If cArray.GetRank(DstArray) <> 1 Then _
Throw Cor.NewRankException(Environment.GetResourceString(Rank_MultiDimension))
If Index + mCount - 1 > UBound(DstArray) Then _
Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_ArrayPlusOffTooSmall))
For i = 0 To mCount - 1
Set DstArray(Index + i) = Cor.NewDictionaryEntry(mKeys(i), mValues(i))
Next i
End Sub
''
' Returns the number of items in the list.
'
' @return The number of items in the list.
'
Public Property Get Count() As Long
Count = mCount
End Property
''
' Returns a boolean indicating if the value and this object
' instance are the same instance.
'
' @param value The value to compare equality to.
' @return Boolean indicating equality.
Public Function Equals(ByRef Value As Variant) As Boolean
Equals = Object.Equals(Me, Value)
End Function
''
' Retrieves a value in the list by an index.
'
' @param Index The index into the list from which to retrieve the value.
' @return The value at the specified index in the list.
' @remarks Since the list maintains sort order with each addition
' and removal of a key/value pair, there is no garauntee the same value
' will be returned by the same index in future calls.
'
Public Function GetByIndex(ByVal Index As Long) As Variant
If Index < 0 Or Index >= mCount Then _
Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_Index), "index", Index)
Call VariantCopy(GetByIndex, mValues(Index))
End Function
''
' Returns an enumerator that can be used to iterate through the key/value pairs.
'
' @return An IEnumerator object to be use for iterating the key/value pairs.
'
Public Function GetEnumerator() As IEnumerator
Dim Ret As New SortedListEnumerator
Call Ret.Init(Me, SAPtr(mKeys), SAPtr(mValues), slEntries)
Set GetEnumerator = Ret
End Function
''
' Returns a pseudo-unique number identifying this instance.
'
' @return Pseudo-unique number identifying this instance.
Public Function GetHashCode() As Long
GetHashCode = ObjPtr(CUnk(Me))
End Function
''
' Returns the key at the specified index in the list.
'
' @param Index The index into the list from which to retrieve the key.
' @return The key at the specified index.
' @remarks Since the list maintains sort order, when an item is
' added or removed, there is no garauntee that the same key will be
' found at the same index in future calls.
'
Public Function GetKey(ByVal Index As Long) As Variant
If Index < 0 Or Index >= mCount Then _
Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_Index), "index", Index)
Call VariantCopy(GetKey, mKeys(Index))
End Function
''
' Returns a ReadOnly IList object that is used to access the keys in the list.
'
' @return An IList object containing the keys in the list.
' @remarks The IList object maintains a reference to the original sorted list.
' It will reflect any changes in the sorted list.
'
Public Function GetKeyList() As IList
Set GetKeyList = NewSortedKeyList
End Function
''
' Returns a ReadOnly IList object that is used to access the values in the list.
'
' @return An IList object used to access the values in the list.
' @remarks The IList object maintains a reference to the original sorted list.
' Any changes in the sorted list will be reflected in the IList object.
'
Public Function GetValueList() As IList
Set GetValueList = NewSortedValueList
End Function
''
' Searches for a key in the list and returns the index it was found.
'
' @param Key The key to find the index of.
' @return The index for the specified key. If a -1 is returned, then
' the key was not found in the list.
'
Public Function IndexOfKey(ByRef Key As Variant) As Long
IndexOfKey = cArray.IndexOf(mKeys, Key, 0, mCount, mComparer)
End Function
''
' Searches for a value in the list and returns the index it was found.
'
' @param Value The value to search for.
' @param Comparer A user-supplied comparer for special comparison, especially for user-defined types.
' @return The index the value was found, or a -1 if the value was not found.
'
Public Function IndexOfValue(ByRef Value As Variant, Optional ByVal Comparer As IComparer) As Long
IndexOfValue = cArray.IndexOf(mValues, Value, 0, mCount, Comparer)
End Function
''
' Returns if the list can change in size or not.
'
' @return Indication if the list is fixed or not.
' @remarks Fixed size means items cannot be added or removed from the list.
' It does not prevent the existing items from being modified.
'
Public Property Get IsFixedSize() As Boolean
IsFixedSize = False
End Property
''
' Returns if the list can be modified in any way.
'
' @return Indication if the list can be modified.
' @remarks A ReadOnly list cannot have items added or removed, nor
' can the existing items be altered. This does not mean properties
' on objects in the list are prohibited.
'
Public Property Get IsReadOnly() As Boolean
IsReadOnly = False
End Property
''
' Returns the value associated with the given key.
'
' @param Key The key of the value to be returned.
' @return The value associated with the key.
' @remarks If the key was not found, then Empty is returned.
'
Public Property Get Item(ByRef Key As Variant) As Variant
Attribute Item.VB_UserMemId = 0
Dim i As Long
i = cArray.BinarySearch(mKeys, Key, 0, mCount, mComparer)
If i < 0 Then Exit Property
Call VariantCopy(Item, mValues(i))
End Property
''
' Sets a value to a key.
'
' @param Key The key to associate the value with.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -