Список c# like в VBA

дженерики появились в C# 2.0; в VB6/VBA ближе всего вы получаете Collection. Позволяет Add, Remove и Count, но вам нужно будет обернуть его своим собственным классом, если вы хотите больше функциональности, например AddRange, Clear и Contains.

Collection принимает Variant (т. е. все, что вы бросаете на него), поэтому вам придется применять <T> путем проверки типа добавляемых элементов. The TypeName() функция вероятно была бы полезна для этот.

я принял вызов :)

Обновлено посмотреть исходный код здесь

список.cls

добавьте новый модуль класса в проект VB6/VBA. Это определит функциональность List<T> мы реализуем. Как показывает ответ [Santosh], мы немного ограничены в выборе что структура коллекции, которую мы собираемся обернуть. Мы могли бы сделать с массивами, но коллекции, являющиеся объектами, делают лучшего кандидата, так как мы хотим, чтобы перечислитель использовал наш List на For Each строительство.

Безопасность Типа

с List<T> это T говорит этот список-это список того, что именно, и ограничение подразумевает, как только мы определяем тип T этот экземпляр списка прилипает к ней. В VB6 мы можем использовать TypeName чтобы получить строку, представляющую имя типа, с которым мы имеем дело, поэтому мой подход был бы сделать список знаю имя типа, который он держит в тот самый момент, когда добавляется первый элемент: что c# делает декларативно в VB6, мы можем реализовать как вещь времени выполнения. Но это VB6, поэтому давайте не будем сходить с ума по сохранению безопасности типов числовых типов значений - я имею в виду, что мы можем быть умнее, чем VB6 здесь все, что мы хотим, в конце концов, это не код C#; язык не очень жесткий об этом, поэтому компромиссом может быть только разрешить неявное преобразование типов о числовых типах меньшего размера, чем размер первого элемента в списке.

Private Type tList
    Encapsulated As Collection
    ItemTypeName As String
End Type
Private this As tList
Option Explicit

Private Function IsReferenceType() As Boolean
    If this.Encapsulated.Count = 0 Then IsReferenceType = False: Exit Function
    IsReferenceType = IsObject(this.Encapsulated(1))
End Function

Public Property Get NewEnum() As IUnknown
    Attribute NewEnum.VB_Description = "Gets the enumerator from encapsulated collection."
    Attribute NewEnum.VB_UserMemId = -4
    Attribute NewEnum.VB_MemberFlags = "40"

    Set NewEnum = this.Encapsulated.[_NewEnum]
End Property

Private Sub Class_Initialize()
    Set this.Encapsulated = New Collection
End Sub

Private Sub Class_Terminate()
    Set this.Encapsulated = Nothing
End Sub

проверка, если значение соответствующего типа может быть роль функции, которая может быть сделана public для удобства, поэтому значение может быть проверено на действительность клиентским кодом, прежде чем оно будет добавлено. Каждый раз, когда мы инициализируем New List, this.ItemTypeName является пустой строкой для этого экземпляра; в остальное время мы, вероятно, увидим правильный тип, поэтому давайте не будем проверять все возможности (не C#, оценка не сломается при первом Or что соответствует true заявления):

Public Function IsTypeSafe(value As Variant) As Boolean

    Dim result As Boolean
    result = this.ItemTypeName = vbNullString Or this.ItemTypeName = TypeName(value)
    If result Then GoTo QuickExit

    result = result _
        Or this.ItemTypeName = "Integer" And StringMatchesAny(TypeName(value), "Byte") _
        Or this.ItemTypeName = "Long" And StringMatchesAny(TypeName(value), "Integer", "Byte") _
        Or this.ItemTypeName = "Single" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte") _
        Or this.ItemTypeName = "Double" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte", "Single") _
        Or this.ItemTypeName = "Currency" And StringMatchesAny(TypeName(value), "Long", "Integer", "Byte", "Single", "Double")

QuickExit:
    IsTypeSafe = result
End Function

теперь это начало.

у нас есть Collection. Это покупает нас Count, Add, Remove и Item. Теперь последнее интересно, потому что это также Collection ' s свойство по умолчанию, и в C# это будет называться индексатор собственность. В VB6 мы устанавливаем 0, и мы получаем свойство по умолчанию:

Public Property Get Item(ByVal index As Long) As Variant
    Attribute Item.VB_Description = "Gets/sets the item at the specified index."
    Attribute Item.VB_UserMemId = 0

    If IsReferenceType Then
        Set Item = this.Encapsulated(index)
    Else
        Item = this.Encapsulated(index)
    End If
End Property

Процедура Атрибутами

в VBA IDE не предоставляет никакого способа их редактирования, но вы можете редактировать код в блокноте и импортировать отредактированный .cls-файл в ваш проект VBA. В VB6 у вас есть меню инструментов для редактирования:

Attribute NewEnum.VB_UserMemId = -4 говорит VB использовать это свойство для предоставления перечислителя - мы просто передаем его, что инкапсулированного Collection, и это скрытое свойство начинается с подчеркивания (не пытайтесь сделать это дома!). Attribute NewEnum.VB_MemberFlags = "40" предполагается также сделать его скрытым свойством, но я еще не понял, почему VB не возьмет его. Поэтому, чтобы вызвать геттер для этого скрытого свойства, нам нужно окружить его [] квадратные скобки, потому что идентификатор не может юридически начинаться с подчеркивания в VB6 / VBA.

одна хорошая вещь о (F2) в качестве описания/мини-документации для вашего кода.

Элементы Доступа / "Сеттеры"

в в VB6/VBA в Collection не позволяет напрямую записывать значения в свои элементы. Мы можем назначить ссылки, но не значения. Мы можем реализовать запись с поддержкой List путем предоставления сеттеров для Item собственность - потому что мы не знаю, если наши T будет значением или ссылкой / объектом, мы предоставим оба Let и Set аксессоры. С Collection не поддерживает это, нам придется сначала удалить элемент по указанному индексу, а затем вставить новое значение в этом месте.

хорошие новости RemoveAt и Insert есть два метода, которые нам все равно придется реализовать, и RemoveAt поставляется бесплатно, потому что его семантика такая же, как у инкапсулированных Collection:

Public Sub RemoveAt(ByVal index As Long)
    this.Encapsulated.Remove index
End Sub

Public Sub RemoveRange(ByVal Index As Long, ByVal valuesCount As Long)
    Dim i As Long
    For i = Index To Index + valuesCount - 1
        RemoveAt Index
    Next
End Sub

реализация Insert чувствует, что это может стать намного лучше, но по существу читается как "захватить все после указанный индекс, сделать копию; удалить все после указанного индекса; добавить указанное значение, добавить обратно остальные элементы":

Public Sub Insert(ByVal index As Long, ByVal value As Variant)
    Dim i As Long, isObjRef As Boolean
    Dim tmp As New List

    If index > Count Then Err.Raise 9  'index out of range

    For i = index To Count
        tmp.Add Item(i)
    Next

    For i = index To Count
        RemoveAt index
    Next

    Add value
    Append tmp

End Sub

InsertRange можно взять ParamArray поэтому мы можем поставить рядный значения:

Public Sub InsertRange(ByVal Index As Long, ParamArray values())
    Dim i As Long, isObjRef As Boolean
    Dim tmp As New List

    If Index > Count Then Err.Raise 9  'index out of range

    For i = Index To Count
        tmp.Add Item(i)
    Next

    For i = Index To Count
        RemoveAt Index
    Next

    For i = LBound(values) To UBound(values)
        Add values(i)
    Next
    Append tmp

End Sub

Reverse не имеет ничего общего с сортировкой, поэтому мы можем реализуйте его сразу:

Public Sub Reverse()
    Dim i As Long, tmp As New List

    Do Until Count = 0
        tmp.Add Item(Count)
        RemoveAt Count
    Loop

    Append tmp

End Sub

здесь я подумал, так как VB6 не поддерживает перегрузок. что было бы неплохо иметь метод, который может добавить все элементы из другого списка, так что Append:

Public Sub Append(ByRef values As List)
    Dim value As Variant, i As Long
    For i = 1 To values.Count
        Add values(i)
    Next
End Sub

Add наша List становится больше, чем просто инкапсулируются Collection с несколькими дополнительными методами: если это первый элемент, добавляемый в список, у нас есть часть логики для выполнения здесь-не что мне все равно, сколько элементов есть в инкапсулированной коллекции, поэтому, если все элементы будут удалены из списка, Тип T остается ограниченным:

Public Sub Add(ByVal value As Variant)
    If this.ItemTypeName = vbNullString Then this.ItemTypeName = TypeName(value)
    If Not IsTypeSafe(value) Then Err.Raise 13, ToString, "Type Mismatch. Expected: '" & this.ItemTypeName & "'; '" & TypeName(value) & "' was supplied." 'Type Mismatch
    this.Encapsulated.Add value
End Sub

источник ошибки, вызванной, когда Add сбой является результатом вызова ToString метод, который возвращает... имя типа включая тип T - Итак, мы можем сделать это List<T> вместо List(Of T):

Public Function ToString() As String
    ToString = TypeName(Me) & "<" & Coalesce(this.ItemTypeName, "Variant") & ">"
End Function

List<T> позволяет добавлять много предметы сразу. Сначала я реализовал AddRange с массивом значений для параметра, но затем с использованием мне пришло в голову, что снова, это не C#, и принимая ParamArray гораздо, гораздо удобнее:

Public Sub AddRange(ParamArray values())
    Dim value As Variant, i As Long
    For i = LBound(values) To UBound(values)
        Add values(i)
    Next
End Sub

...И тогда мы доберемся до тех Item сеттеры:

Public Property Let Item(ByVal index As Long, ByVal value As Variant)
    RemoveAt index
    Insert index, value
End Property

Public Property Set Item(ByVal index As Long, ByVal value As Variant)
    RemoveAt index
    Insert index, value
End Property

удаление элемента, предоставляя значение вместо индекса, потребует другого метода, который дает нам индекс этого значения, и потому что мы не только поддерживаем значение типы, но и ссылка типа, это будет очень весело, потому что теперь нам нужен способ определить равенство между ссылочными типами-мы можем получить равенство ссылок сравнение ObjPtr(value), но нам понадобится больше , чем просто это-.net framework научил меня о IComparable и IEquatable. Давайте просто запихнем эти два интерфейса в один и назовем его IComparable - да, вы можете писать и реализовывать интерфейсы в В VB6/VBA В.

интерфейс icomparable.cls

добавьте новый модуль класса и назовите его IComparable - если вы действительно планируете использовать их для чего-то еще, вы можете поместить их в два отдельных модуля класса и вызвать другой IEquatable, но это сделает вас двумя интерфейсами для реализации вместо одного для всех ссылочных типов, с которыми вы хотите работать.

это не макет кода, все, что нужно, это метод подписи:

Option Explicit

Public Function CompareTo(other As Variant) As Integer
'Compares this instance with another; returns one of the following values:
'   -1 if [other] is smaller than this instance.
'    1 if [other] is greater than this instance.
'    0 otherwise.
End Function

Public Function Equals(other As Variant) As Boolean
'Compares this instance with another; returns true if the two instances are equal.
End Function

список.cls

установка интерфейса IComparable для использования

учитывая, что мы упаковали наши IComparable с CompareTo и Equals, теперь мы можем найти индекс любого значения в нашем списке, мы можем также определить, если список содержит любое заданное значение:

Public Function IndexOf(value As Variant) As Long
    Dim i As Long, isRef As Boolean, comparable As IComparable
    isRef = IsReferenceType
    For i = 1 To this.Encapsulated.Count
        If isRef Then
            If TypeOf this.Encapsulated(i) Is IComparable And TypeOf value Is IComparable Then
                Set comparable = this.Encapsulated(i)
                If comparable.Equals(value) Then
                    IndexOf = i
                    Exit Function
                End If
            Else
                'reference type isn't comparable: use reference equality
                If ObjPtr(this.Encapsulated(i)) = ObjPtr(value) Then
                    IndexOf = i
                    Exit Function
                End If
            End If
        Else
            If this.Encapsulated(i) = value Then
                IndexOf = i
                Exit Function
            End If
        End If
    Next
    IndexOf = -1
End Function

Public Function Contains(value As Variant) As Boolean
    Dim v As Variant, isRef As Boolean, comparable As IComparable
    isRef = IsReferenceType
    For Each v In this.Encapsulated
        If isRef Then
            If TypeOf v Is IComparable And TypeOf value Is IComparable Then
                Set comparable = v
                If comparable.Equals(value) Then Contains = True: Exit Function
            Else
                'reference type isn't comparable: use reference equality
                If ObjPtr(v) = ObjPtr(value) Then Contains = True: Exit Function
            End If
        Else
            If v = value Then Contains = True: Exit Function
        End If
    Next
End Function

на CompareTo метод вступает в игру, когда мы начинаем спрашивать, что Min и Max значения могут быть:

Public Function Min() As Variant
    Dim i As Long, isRef As Boolean
    Dim smallest As Variant, isSmaller As Boolean, comparable As IComparable

    isRef = IsReferenceType
    For i = 1 To Count

        If isRef And IsEmpty(smallest) Then
            Set smallest = Item(i)
        ElseIf IsEmpty(smallest) Then
            smallest = Item(i)
        End If

        If TypeOf Item(i) Is IComparable Then
            Set comparable = Item(i)
            isSmaller = comparable.CompareTo(smallest) < 0
        Else
            isSmaller = Item(i) < smallest
        End If

        If isSmaller Then
            If isRef Then
                Set smallest = Item(i)
            Else
                smallest = Item(i)
            End If
        End If
    Next

    If isRef Then
        Set Min = smallest
    Else
        Min = smallest
    End If

End Function

Public Function Max() As Variant
    Dim i As Long, isRef As Boolean
    Dim largest As Variant, isLarger As Boolean, comparable As IComparable

    isRef = IsReferenceType
    For i = 1 To Count

        If isRef And IsEmpty(largest) Then
            Set largest = Item(i)
        ElseIf IsEmpty(largest) Then
            largest = Item(i)
        End If

        If TypeOf Item(i) Is IComparable Then
            Set comparable = Item(i)
            isLarger = comparable.CompareTo(largest) > 0
        Else
            isLarger = Item(i) > largest
        End If

        If isLarger Then
            If isRef Then
                Set largest = Item(i)
            Else
                largest = Item(i)
            End If
        End If
    Next

    If isRef Then
        Set Max = largest
    Else
        Max = largest
    End If

End Function

эти две функции позволяют очень удобочитаемую сортировку-из-за того, что здесь происходит (добавление и удаление элементов), нам придется не быстро:

Public Sub Sort()
    If Not IsNumeric(First) And Not this.ItemTypeName = "String" And Not TypeOf First Is IComparer Then Err.Raise 5, ToString, "Invalid operation: Sort() requires a list of numeric or string values, or a list of objects implementing the IComparer interface."
    Dim i As Long, value As Variant, tmp As New List, minValue As Variant, isRef As Boolean

    isRef = IsReferenceType
    Do Until Count = 0

        If isRef Then
            Set minValue = Min
        Else
            minValue = Min
        End If

        tmp.Add minValue
        RemoveAt IndexOf(minValue)
    Loop

    Append tmp

End Sub

Public Sub SortDescending()
    If Not IsNumeric(First) And Not this.ItemTypeName = "String" And Not TypeOf First Is IComparer Then Err.Raise 5, ToString, "Invalid operation: SortDescending() requires a list of numeric or string values, or a list of objects implementing the IComparer interface."
    Dim i As Long, value As Variant, tmp As New List, maxValue As Variant, isRef As Boolean

    isRef = IsReferenceType
    Do Until Count = 0

        If isRef Then
            Set maxValue = Max
        Else
            maxValue = Max
        End If

        tmp.Add maxValue
        RemoveAt IndexOf(maxValue)
    Loop

    Append tmp

End Sub

последние штрихи

остальное просто тривиальный материал:

Public Sub Remove(value As Variant)
    Dim index As Long
    index = IndexOf(value)
    If index <> -1 Then this.Encapsulated.Remove index
End Sub

Public Property Get Count() As Long
    Count = this.Encapsulated.Count
End Property

Public Sub Clear()
    Do Until Count = 0
        this.Encapsulated.Remove 1
    Loop
End Sub

Public Function First() As Variant
    If Count = 0 Then Exit Function
    If IsObject(Item(1)) Then
        Set First = Item(1)
    Else
        First = Item(1)
    End If
End Function

Public Function Last() As Variant
    If Count = 0 Then Exit Function
    If IsObject(Item(Count)) Then
        Set Last = Item(Count)
    Else
        Last = Item(Count)
    End If
End Function

одна забавная вещь о List<T> заключается в том, что его можно скопировать в массив, просто вызвав ToArray() на это - мы можем сделать точно что:

Public Function ToArray() As Variant()

    Dim result() As Variant
    ReDim result(1 To Count)

    Dim i As Long
    If Count = 0 Then Exit Function

    If IsReferenceType Then
        For i = 1 To Count
            Set result(i) = this.Encapsulated(i)
        Next
    Else
        For i = 1 To Count
            result(i) = this.Encapsulated(i)
        Next
    End If

    ToArray = result
End Function

вот и все!

я использую несколько вспомогательных функций, вот они - они, вероятно, принадлежат в некоторых StringHelpers модуль код:

Public Function StringMatchesAny(ByVal string_source As String, find_strings() As Variant) As Boolean

    Dim find As String, i As Integer, found As Boolean

    For i = LBound(find_strings) To UBound(find_strings)

        find = CStr(find_strings(i))
        found = (string_source = find)

        If found Then Exit For
    Next

    StringMatchesAny = found

End Function

Public Function Coalesce(ByVal value As Variant, Optional ByVal value_when_null As Variant = 0) As Variant

    Dim return_value As Variant
    On Error Resume Next 'supress error handling

    If IsNull(value) Or (TypeName(value) = "String" And value = vbNullString) Then
        return_value = value_when_null
    Else
        return_value = value
    End If

    Err.Clear 'clear any errors that might have occurred
    On Error GoTo 0 'reinstate error handling

    Coalesce = return_value

End Function

и MyClass.cls

эта реализация требует, когда T является ссылочным типом / объектом, который класс реализует IComparable интерфейс для сортировки и поиска индекса значения. Вот как это делается-скажем, у вас есть класс под названием MyClass с числовым или String свойство SomeProperty:

Implements IComparable
Option Explicit

Private Function IComparable_CompareTo(other As Variant) As Integer
    Dim comparable As MyClass
    If Not TypeOf other Is MyClass Then Err.Raise 5

    Set comparable = other
    If comparable Is Nothing Then IComparable_CompareTo = 1: Exit Function

    If Me.SomeProperty < comparable.SomeProperty Then
        IComparable_CompareTo = -1
    ElseIf Me.SomeProperty > comparable.SomeProperty Then
        IComparable_CompareTo = 1
    End If

End Function

Private Function IComparable_Equals(other As Variant) As Boolean
    Dim comparable As MyClass
    If Not TypeOf other Is MyClass Then Err.Raise 5

    Set comparable = other
    IComparable_Equals = comparable.SomeProperty = Me.SomeProperty

End Function

на List можно использовать так:

Dim myList As New List
myList.AddRange 1, 12, 123, 1234, 12345 ', 123456 would blow up because it's a Long
myList.SortDescending

Dim value As Variant
For Each value In myList
   Debug.Print Value
Next

Debug.Print myList.IndexOf(123) 'prints 3
Debug.Print myList.ToString & ".IsTypeSafe(""abc""): " & myList.IsTypeSafe("abc")
    ' prints List<Integer>.IsTypeSafe("abc"): false