Мож кому пригодится?
'###############################################################################################################################
' Реализация алгоритма быстрой сортировки
'###############################################################################################################################
Option Explicit
'###############################################################################################################################
' Процедура быстрой сортировки массива (QuickSort)
' [in,out] aArrayToSort - подлежащий сортировке массив
' [in] oSortCompareFunction - функция-делегат для вычисления позиции элемента в результирующем массиве
' должна иметь прототип SomeFunction(a,b,vCustomData)
' должна возвращать true если элемент "а" д.б. расположен выше элемента "b"
' [in] bDesc - признак обратной сортировки
' [in] vCustomData - дополнительные пользовательские данные, передаваемые в функцию-делегат
Sub X_QuickSortArray(ByRef aArrayToSort, oSortCompareFunction, bDesc, ByRef vCustomData)
If Not IsArray(aArrayToSort) Then
' Сортировать то нечего!
Exit Sub
End If
If 0=(UBound(aArrayToSort)-LBound(aArrayToSort)+1) Then
' Сортировать то нечего!
Exit Sub
End If
' А теперь отсортируем
X_QuickSortArrayPartial aArrayToSort, _
oSortCompareFunction, _
bDesc, _
vCustomData, _
LBound(aArrayToSort), _
UBound(aArrayToSort), _
IsObject( aArrayToSort( LBound( aArrayToSort)))
End Sub
'###############################################################################################################################
' Процедура быстрой сортировки части массива (QuickSort)
' [in,out] aArrayToSort - подлежащий сортировке массив
' [in] oSortCompareFunction - функция-делегат для вычисления позиции элемента в результирующем массиве
' должна иметь прототип SomeFunction(a,b,vCustomData)
' должна возвращать true если элемент "а" д.б. расположен выше элемента "b"
' [in] bDesc - признак обратной сортировки
' [in] vCustomData - дополнительные пользовательские данные, передаваемые в функцию-делегат
' [in] nLeft - первый элемент границ сортировки
' [in] nRight - последний элемент границ сортировки
' [in] bIsObjectArray - признак работы с массивом объектов
Sub X_QuickSortArrayPartial(ByRef aArrayToSort, oSortCompareFunction, bDesc, ByRef vCustomData, _
nLeft, nRight, bIsObjectArray)
'##################################################################################
'# #
'# Это стандартная реализация алгоритма быстрой сортировки, без комментариев! #
'# #
'##################################################################################
'# #
'# The QuickSort algorithm is explained in thorough detail in the #
'# Visual Basic Language Developer's Handbook #
'# by Ken Getz and Mike Gilbert (Sybex, 2000) #
'# #
'##################################################################################
Dim I, J, P, L, R, T
L = nLeft
R = nRight
Do
I = L
J = R
P = ((L + R) \ 2)
Do
If bDesc Then
While oSortCompareFunction( aArrayToSort(P), aArrayToSort(I), vCustomData)
I = I + 1
Wend
While oSortCompareFunction( aArrayToSort(J), aArrayToSort(P), vCustomData)
J = J - 1
Wend
Else
While oSortCompareFunction( aArrayToSort(I), aArrayToSort(P), vCustomData)
I = I + 1
Wend
While oSortCompareFunction( aArrayToSort(P), aArrayToSort(J), vCustomData)
J = J - 1
Wend
End If
If I <= J Then
If bIsObjectArray Then
Set T = aArrayToSort(I)
Set aArrayToSort(I) = aArrayToSort(J)
Set aArrayToSort(J) = T
Set T = Nothing
Else
T = aArrayToSort(I)
aArrayToSort(I) = aArrayToSort(J)
aArrayToSort(J) = T
T = Null
End If
If P = I Then
P = J
ElseIf P = J Then
P = I
End If
I = I + 1
J = J - 1
End If
Loop Until I > J
If L < J Then
X_QuickSortArrayPartial aArrayToSort, oSortCompareFunction, bDesc, vCustomData, L, J, bIsObjectArray
End If
L = I
Loop Until I >= R
End Sub
'###############################################################################################################################
' Функция - делегат для сравнения произвольных скалярных данных
Function X_AnyCompare(a,b,vUseless)
X_AnyCompare = a<b
End Function
'###############################################################################################################################
' Функция - делегат для сравнения произвольных строковых данных
Function X_StringCompare(a,b,nCompareMode)
X_StringCompare=(-1=StrComp(a,b,nCompareMode))
End Function
... << RSDN@Home 1.0 beta 7a >>