Версия для печати темы

Автор: LuMee 19:07:2007, 08:33

Данное решение не претендует на сильно большую практическую ценность, однако может быть кому-то пригодится. Представляет оно собой простеньку библиотечку для сортировки массивов, которую я лично использую при создании отчетов.
Библиотека включает в себя такие компоненты:
1. функция CollectionToArray, которая тупо перегоняет NotesDocumentCollection в массив документов:

Function CollectionToArray(collection As NotesDocumentCollection) As Variant
    Dim documents() As NotesDocument
    Dim doc As NotesDocument
    Dim counter As Integer
    
    Redim documents(collection.Count - 1)
    
    counter = 0
    Set doc = collection.GetFirstDocument()
    While Not doc Is Nothing
        Set documents(counter) = doc
        counter = counter + 1
        Set doc = collection.GetNextDocument(doc)
    Wend
    
    CollectionToArray = documents
End Function

2. Базовый класс Comparer. Объекты этого класса используются для сравнения между собой элементов сорируемого массива (по аналогии с Comparator'ом в Java):

Class Comparer
    'Возвращает результат сравнения элементов:
    'отрицательное значение - если leftElement меньше rightElement
    'положительное значение - если leftElement больше rightElement
    'ноль - если элементы равны
    Public Function Compare(leftElement As Variant, rightElement As Variant) As Integer
        Compare = 0
    End Function
End Class

3. Наконец, собственно класс, выполняющий сортировку (использует метод быстрой сортировки):

Class ArraySorter
    'Данный объект будет использоваться для сравнения элементов массива при сортировке
    Private comparer As Comparer
    
    'Конструктор. В качестве параметра принимает объект-компаратор, с помощью которого 
    'будут сравниваться элементы массива. Параметр не должен иметь значение Nothing
    Public Sub New(comparer As Comparer)
        Set Me.comparer = comparer
    End Sub
    
    'Данный метод сортирует переданный в качестве параметра массив
    Public Sub Sort(array As Variant)
        If Not Isarray(array) Then Exit Sub            
        
        Dim low As Integer, high As Integer
        low = Lbound(array)
        high = Ubound(array)
        'Сортируем методом быстрой сортировки
        QuickSort array, low, high, IsArrayOfObjects(array)
    End Sub
    
    'Алгоритм быстрой сортировки был позаимствован с Wikipedia, так что его не 
    'комментирую. Единственное замечание - параметр isObjectArray - показывающий, какого 
    'типа - примитивного или объектного - элементы находятся в массиве. Это необходимо 
    'потому, что в LS для присвоения значений переменных примитивного и объектного типов
    'используются разные синтаксические конструкции, так что для успешного присвоения 
    'необходимо знать, с каким типов в данный момент осуществляется работа
    Private Sub QuickSort(array As Variant, low As Integer, high As Integer,_ 
    isObjectArray As Variant)
        Dim i As Integer, j As Integer
        Dim pivot As Variant, tmp As Variant
        
        If isObjectArray Then
            Set pivot = array((low + high) \ 2)
        Else
            pivot = array((low + high) \ 2)
        End If
        i = low
        j = high
        
        Do Until i > j
            While comparer.Compare(pivot, array(i)) > 0 
                i = i + 1
            Wend
            While comparer.Compare(pivot, array(j)) < 0
                j = j - 1
            Wend
            If i <= j Then
                If isObjectArray Then
                    Set tmp = array(i)
                    Set array(i) = array(j)
                    Set array(j) = tmp
                Else
                    tmp = array(i)
                    array(i) = array(j)
                    array(j) = tmp
                End If
                i = i + 1
                j = j - 1
            End If            
        Loop
        If low < j Then QuickSort array, low, j, isObjectArray
        If high > i Then QuickSort array, i, high, isObjectArray
    End Sub
    
    'Возвращает True, если array представляет собой динамический или фиксированный массив 
    'пользовательских или встроенных объектов
    Private Function IsArrayOfObjects(array As Variant) As Variant
        Dim t As Integer
        t = Datatype(array)
        
        'Расшифровка типа array:
        '8192 - код фиксированного массива
        '8704 - динамического массива
        '34 - код пользовательского объекта
        '35 - код встроенного объекта
        't будет равнятся сумме одного из элементов первой пары и одного из элементов 
        'второй пары
        If _
        (t = 8192 + 34) Or _ 'Фиксированный массив пользовательских объектов
        (t = 8192 + 35) Or _ 'Динамический массив пользовательских объектов
        (t = 8704 + 34) Or _ 'Фиксированный массив встроенных объектов
        (t = 8704 + 35) _    'Динамический массив встроенных объектов
        Then
            IsArrayOfObjects = True
        Else
            IsArrayOfObjects = False
        End If
    End Function
End Class

Идея использования всего этого безобразия проста: имеем массив, который надо отсортировать. Создаем для этого массива подкласс Comparer'а, который содержит нужную реализацию метода Compare (знающую, как правильно сравнивать элементы данного конкретного массива). Далее объект-компарер передается сортировщику, и тот уже сортирует массив.
В качестве примера накатал класс DocumentFieldsComparer, который сравнивает два документа (NotesDocument) по значениям полей. Список полей, по которым надо сравнивать, передается в виде массива. В теории он способен адекватно переварить даже многозначные поля:

Class DocumentFieldsComparer As Comparer
    'Массив, содержащий названия полей, по которым надо произвести сравнение
    Private fields() As String
    
    'Конструктор
    'Параметр fieldsList - массив с названиями полей. Может статическим или динамическим
    Public Sub New(fieldsList() As String)
        Dim i As Integer
        Redim Me.fields(Lbound(fieldsList) To Ubound(fieldsList)) As String
        
        For i = Lbound(fields) To Ubound(fields)
            fields(i) = fieldsList(i)
        Next
    End Sub
    
    'Возвращает -1, если левый документ "меньше" правого, 1 - если "больше", 0 - в случае
    '"равенства"
    Public Function Compare(leftElement As Variant, rightElement As Variant) As Integer
        Dim leftDoc As NotesDocument, rightDoc As NotesDocument
        Dim leftValue As Variant, rightValue As Variant
        Dim result As Integer, i As Integer
        
        Set leftDoc = leftElement
        Set rightDoc = rightElement
        
        result = 0
        i = Lbound(fields)
        'Поля документов сравниваются одно за другим, пока не будет получен результат, 
        'отличный от равенства (одно поле "больше" другого) - тогда этот результат и будет 
        'результатом сравнения документов, либо не закончится список полей, в этом случае 
        'документы считаются "равными"
        While (result = 0) And (i <= Ubound(fields))
            result = CompareItemValues(leftDoc.GetItemValue(fields(i)),_
            rightDoc.GetItemValue(fields(i)))
            i = i + 1
        Wend
        
        Compare = result
    End Function
    
    'Вспомогательная функция, предназначенная для сравнения массивов значений полей 
    'документов. Элементы сравниваются один за другим, пока не будет получен результат, 
    'отличный от равенства, либо не будет достигнуто максимальное количество элементов в 
    'одном из полей. В этом случае "большим" будет считаться то поле, в котором больше 
    'элементов. Если количество элементов одинаково, поля считаются "равными"
    Private Function CompareItemValues(leftItem As Variant, rightItem As Variant) As Integer
        Dim endIndex As Integer
        Dim result As Integer, i As Integer
        
        'По умолчанию поля считаются "равными"
        result = 0        
        
        'Определяем минимальное количество элементов в полях
        If Ubound(leftItem) <= Ubound(rightItem) Then
            endIndex = Ubound(leftItem)
        Else
            endIndex = Ubound(rightItem)
        End If
        
        'Сравниваем элементы один за другим, пока не будет выявлено "большее" поле или 
        'не будут перебраны все элементы в одном из полей
        i = 0
        While (i <= endIndex) And (result = 0)
            If leftItem(i) < rightItem(i) Then
                result = -1
            Elseif leftItem(i) > rightItem(i) Then
                result = 1
            End If
            i = i + 1
        Wend
        
        'Если все элементы одного из полей уже обработаны, а превосходство одного поля 
        'над другим не установлено, сравниваем поля по количеству элементов
        If result = 0 Then
            If Ubound(leftItem) < Ubound(rightItem) Then
                result = -1
            Elseif Ubound(leftItem) > Ubound(rightItem) Then
                result = 1
            End If
        End If
        
        CompareItemValues = result        
    End Function
End Class

Использовать это можно следующим образом:

Dim fields(0 To 1) As String 'поля, по которым будем сравнивать
Dim collection As NotesDocumentCollection
Dim documents As Variant
Dim comparer As DocumentFieldsComparer
Dim sorter As ArraySorter

fields(0) = "FieldA"
fields(1) = "FieldB"

Set comparer = New DocumentFieldsComparer(fields)
Set sorter = New ArraySorter(comparer)

Set collection = ... 'получили где-то коллекцию документов, скажем, выполнив поиск по БД
documents = CollectionToArray(collection)
sorter.Sort documents

Dim doc As NotesDocument
Forall varDoc in documents
    Set doc = varDoc
    ... 'ну и дальше что-то с документами делаем
End Forall

В общем, вот, выставляю на суд общественности