In order to test this code, you can add the following code to a VB project
Form1.frm
Private Sub Command1_Click()
Dim SortArray() As typElement
Dim i As Long
Dim j As Long
Dim Elements As Long
Dim Start As Double
Dim Length As Double
Command1.Enabled = False
'Create the array to be sorted
Elements = 100000
Randomize Timer
ReDim SortArray(0 To Elements - 1)
For i = 0 To Elements - 1
SortArray(i).Index = i
SortArray(i).Value = Rnd()
Next i
Start = Timer
'Sort the array
QuickSort VarPtr(SortArray(0)), Elements, VarPtr(SortArray(1)) - VarPtr(SortArray(0)), AddressOf CompareElement
Length = Length + Timer - Start
'Ensure correct sorting
For i = 0 To Elements - 1 - 1
Debug.Assert SortArray(i).Value < SortArray(i + 1).Value
Next i
Text1.Text = Length
Command1.Enabled = True
End Sub
Global Module.bas
Option Explicit
Public Type typElement
Value As Double
Spacer As Byte
Index As Long
End Type
'The compare function - this will get called a lot so should be optimised if speed is important
Public Function CompareElement(ByRef Element1 As typElement, ByRef Element2 As typElement, ByVal Unused1 As Long, ByVal Unused2 As Long) As Long
If Element1.Value > Element2.Value Then
CompareElement = 1
ElseIf Element1.Value < Element2.Value Then
CompareElement = -1
End If
End Function
Comments