VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 1  'NoTransaction
END
Attribute VB_Name = "TestSortableObject"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
' To be sortable, a Compare method must be implemented
' This object contains just a lng, for demonstration
' The compare statement should return -1 if smaller, 1 if larger and 0 if equal

' To be compatible with asp, all Objects are declared as variants
Dim lng As Long
Dim str As String
Public Function Compare(ByRef obj As Variant, ByRef SortArg As Variant)
    If SortArg = "lng" Then
        If lng < obj.GetLng Then
            Compare = -1
        ElseIf lng > obj.GetLng Then
            Compare = 1
        Else
            Compare = 0
        End If
    ElseIf SortArg = "str" Then
        If str < obj.GetStr Then
            Compare = -1
        ElseIf str > obj.GetStr Then
            Compare = 1
        Else
            Compare = 0
        End If
    Else
        Err.Raise vbObjectError & 1, "ISIT.TestSortableObject", "Unsupported SortArg"
    End If
End Function
Public Property Get GetLng() As Long
    GetLng = lng
End Property
Public Property Let LetLng(lLng As Long)
    lng = lLng
End Property
Public Property Get GetStr() As String
    GetStr = str
End Property
Public Property Let LetStr(sStr As String)
    str = sStr
End Property

Public Function TestQuickSort() As String
    Dim objArray() As Object
    Dim objArray2() As Object
    Dim i As Long
    Dim lowerbound As Long, upperbound As Long
    Dim qsort As Variant
    Dim strResult As String
    Dim numberOfElements As Long
    strResult = ""
    lowerbound = 0
    upperbound = 10
    numberOfElements = 5
    Randomize
    ReDim objArray(0 To numberOfElements - 1)
    For i = 0 To numberOfElements - 1
        Set objArray(i) = CreateObject("ISIT.TestSortableObject")
        objArray(i).LetLng = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
        Debug.Print objArray(i).GetLng
        strResult = strResult & objArray(i).GetLng & "<br>"
    Next i
    Set qsort = CreateObject("ISIT.QuickSort")
    'You need to assign to another array.
    'If you do objArray = qsort.fSort(objArray)
    'the vb garbage collector will pop in and
    'trash everything that objArray refers to
    'The vb garbage collector is to effective, ie buggy.
    
    'If False Then
    If True Then ' This part works
        objArray2 = qsort.fSort(objArray)
        strResult = strResult & "<hr>"
        For i = 0 To numberOfElements - 1
            Debug.Print objArray2(i).GetLng
            strResult = strResult & objArray2(i).GetLng & "<br>"
        Next i
    End If
    
    
    If False Then ' This part makes vb crash and burn
    'If True Then
        objArray = qsort.fSort(objArray)
        strResult = strResult & "<hr>"
        For i = 0 To numberOfElements - 1
            'Debug.Print objArray(i).GetLng
            strResult = strResult & objArray(i).GetLng & "<br>"
        Next i
    End If
    
    If False Then
    'If True Then
        qsort.SortArray = objArray
        qsort.gSort
        objArray = qsort.GetObjArrayGlobal
        strResult = strResult & "<hr>"
        For i = 0 To numberOfElements - 1
            Debug.Print objArray(i).GetLng
            strResult = strResult & objArray(i).GetLng & "<br>"
        Next i
    End If
    If False Then
    'If True Then
        qsort.Sort (objArray)
        strResult = strResult & "<hr>"
        For i = 0 To numberOfElements - 1
            Debug.Print objArray(i).GetLng
            strResult = strResult & objArray(i).GetLng & "<br>"
        Next i
    End If
    
    
    TestQuickSort = strResult
End Function

Public Function TestQuickSortDictionary() As String
    Debug.Print Time
    Dim d As Object
    Dim o As Object
    Dim objArray() As Variant
    Dim objArray2() As Variant
    Dim i As Long
    Dim lowerbound As Long, upperbound As Long
    Dim lowerchar As Long, upperchar As Long
    Dim qsort As Variant
    Dim strResult As String
    Dim numberOfElements As Long
    strResult = ""
    lowerbound = 0
    upperbound = 9
    lowerchar = 65
    upperchar = 65 + 25

    numberOfElements = 5
    Randomize
    Set d = CreateObject("Scripting.Dictionary")
       
    ReDim objArray(0 To numberOfElements - 1)
    For i = 0 To numberOfElements - 1
        Set o = CreateObject("ISIT.TestSortableObject")
        o.LetLng = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
        o.LetStr = Chr(Int((upperchar - lowerchar + 1) * Rnd + lowerchar))
        'd.Add i, o
        Set d.Item(i) = o
        Debug.Print o.GetLng
        strResult = strResult & o.GetLng & " " & o.GetStr & "<br>" & vbCrLf
    Next i
    Set qsort = CreateObject("ISIT.QuickSortDictionary")
    
    'If False Then
    If True Then ' This part works
        objArray = qsort.SortDictionary(d, "lng") ' By default Asc (true)
        objArray2 = qsort.SortDictionary(d, "str", False)
        strResult = strResult & "<hr>" & vbCrLf
        For i = 0 To numberOfElements - 1
            Debug.Print d.Item(objArray(i)).GetLng
            strResult = strResult & d.Item(objArray(i)).GetLng & " " & d.Item(objArray2(i)).GetStr & "<br>" & vbCrLf
        Next i
    End If
    TestQuickSortDictionary = strResult
End Function
