L
LuMee
Данное решение не претендует на сильно большую практическую ценность, однако может быть кому-то пригодится. Представляет оно собой простеньку библиотечку для сортировки массивов, которую я лично использую при создании отчетов.
Библиотека включает в себя такие компоненты:
1. функция CollectionToArray, которая тупо перегоняет NotesDocumentCollection в массив документов:
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">код</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='ls'>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[/CODE]
2. Базовый класс Comparer. Объекты этого класса используются для сравнения между собой элементов сорируемого массива (по аналогии с Comparator'ом в Java):
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">код</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='ls'>Class Comparer
'Возвращает результат сравнения элементов:
'отрицательное значение - если leftElement меньше rightElement
'положительное значение - если leftElement больше rightElement
'ноль - если элементы равны
Public Function Compare(leftElement As Variant, rightElement As Variant) As Integer
Compare = 0
End Function
End Class[/CODE]
3. Наконец, собственно класс, выполняющий сортировку (использует метод быстрой сортировки):
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">код</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='ls'>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[/CODE]
Идея использования всего этого безобразия проста: имеем массив, который надо отсортировать. Создаем для этого массива подкласс Comparer'а, который содержит нужную реализацию метода Compare (знающую, как правильно сравнивать элементы данного конкретного массива). Далее объект-компарер передается сортировщику, и тот уже сортирует массив.
В качестве примера накатал класс DocumentFieldsComparer, который сравнивает два документа (NotesDocument) по значениям полей. Список полей, по которым надо сравнивать, передается в виде массива. В теории он способен адекватно переварить даже многозначные поля:
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">код</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='ls'>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[/CODE]
Использовать это можно следующим образом:
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">код</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='ls'>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[/CODE]
В общем, вот, выставляю на суд общественности
Библиотека включает в себя такие компоненты:
1. функция CollectionToArray, которая тупо перегоняет NotesDocumentCollection в массив документов:
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">код</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='ls'>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[/CODE]
2. Базовый класс Comparer. Объекты этого класса используются для сравнения между собой элементов сорируемого массива (по аналогии с Comparator'ом в Java):
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">код</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='ls'>Class Comparer
'Возвращает результат сравнения элементов:
'отрицательное значение - если leftElement меньше rightElement
'положительное значение - если leftElement больше rightElement
'ноль - если элементы равны
Public Function Compare(leftElement As Variant, rightElement As Variant) As Integer
Compare = 0
End Function
End Class[/CODE]
3. Наконец, собственно класс, выполняющий сортировку (использует метод быстрой сортировки):
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">код</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='ls'>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[/CODE]
Идея использования всего этого безобразия проста: имеем массив, который надо отсортировать. Создаем для этого массива подкласс Comparer'а, который содержит нужную реализацию метода Compare (знающую, как правильно сравнивать элементы данного конкретного массива). Далее объект-компарер передается сортировщику, и тот уже сортирует массив.
В качестве примера накатал класс DocumentFieldsComparer, который сравнивает два документа (NotesDocument) по значениям полей. Список полей, по которым надо сравнивать, передается в виде массива. В теории он способен адекватно переварить даже многозначные поля:
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">код</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='ls'>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[/CODE]
Использовать это можно следующим образом:
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">код</div></div><div class="sp-body"><div class="sp-content"><!--shcode--><pre><code class='ls'>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[/CODE]
В общем, вот, выставляю на суд общественности