|
|
Here is an example that does a bubble sort on the document collection using two fields as the sort key:
Sub Swap(doc1 As NotesDocument ,doc2 As NotesDocument) Dim d As NotesDocument Set d = doc1 Set doc1 = doc2 Set doc2 = d End Sub
Sub CollectionToSortedArray(col As NotesDocumentCollection, docs() As NotesDocument)
Dim i As Integer
Dim doc As NotesDocument
Dim n As Integer, sorted As Integer
Dim s1, s2 As String
n = col.count
Redim docs(n) As NotesDocument
' push to array
For i = 0 To n - 1
Set docs(i) = col.GetNthDocument(i+1)
Next
'bubble sort array
sorted = False
Do While (sorted = False)
sorted = True
For i = 0 To n - 2
' sort based on QuoteNo and ItemNo fields
s1 = docs(i).QuoteNo(0) & docs(i).ItemNo(0)
s2 = docs(i+1).QuoteNo(0) & docs(i+1).ItemNo(0)
If(Strcomp(s1, s2, 5) = 1) Then 'No Pitch, No Case Compare
Call Swap(docs(i),docs(i+1))
sorted = False
End If
Next
Loop
End Sub
Here's another sample using a Merge Sort which is faster for large collections:
Sub qsort(element, sortkeys)
' To be called by REFERENCE
Call mergesort(element, sortkeys, Lbound(sortkeys), Ubound(sortkeys), False)
End Sub
Sub mergesort(element, sortkeys, l As Integer, r As Integer, isclass As Variant)
' From Paul Hudson (paulh@harlequin.co.uk)
' Called by qsort, but can be used on its own
Dim i As Integer, j As Integer, k As Integer, m As Integer
Dim b1(), b2()
If (r - l > 0) Then
m = (r + l) \ 2
Call mergesort(element, sortkeys, l, m, isclass)
Call mergesort(element, sortkeys, m + 1, r, isclass)
Redim b1(l To r)
Redim b2(l To r)
For i = l To m
If isclass Then
Set b1(i) = element(i)
Else
b1(i) = element(i)
End If
b2(i) = sortkeys(i)
Next
For j = m+1 To r
If isclass Then
Set b1(r + m + 1 - j) = element(j)
Else
b1(r + m + 1 - j) = element(j)
End If
b2(r + m + 1 - j) = sortkeys(j)
Next
i = l
j = r
For k = l To r
If b2(i) < b2(j) Then
If isclass Then
Set element(k) = b1(i)
Else
element(k) = b1(i)
End If
sortkeys(k) = b2(i)
i = i + 1
Else
If isclass Then
Set element(k) = b1(j)
Else
element(k) = b1(j)
End If
sortkeys(k) = b2(j)
j = j - 1
End If
Next
End If
End Sub