Subversion Repositories DevTools

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CSorter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Sub SwapRows(ary, row1, row2)
    '== This proc swaps two rows of an array
    Dim x, tempvar
    
    For x = 0 To UBound(ary, 1)
        tempvar = ary(x, row1)
        ary(x, row1) = ary(x, row2)
        ary(x, row2) = tempvar
    Next
    
End Sub

Sub QuickSort(vec, loBound, hiBound, SortField)
    
    '==--------------------------------------------------------==
    '== Sort a 2 dimensional array on SortField                ==
    '==                                                        ==
    '== This procedure is adapted from the algorithm given in: ==
    '==    ~ Data Abstractions & Structures using C++ by ~     ==
    '==    ~ Mark Headington and David Riley, pg. 586    ~     ==
    '== Quicksort is the fastest array sorting routine for     ==
    '== unordered arrays.  Its big O is  n log n               ==
    '==                                                        ==
    '== Parameters:                                            ==
    '== vec       - array to be sorted                         ==
    '== SortField - The field to sort on (2nd dimension value) ==
    '== loBound and hiBound are simply the upper and lower     ==
    '==   bounds of the array's 1st dimension.  It's probably  ==
    '==   easiest to use the LBound and UBound functions to    ==
    '==   set these.                                           ==
    '==--------------------------------------------------------==
    
    
    
    Dim pivot(), loSwap, hiSwap, temp, counter
    ReDim pivot(UBound(vec, 1))
    
    '== Two items to sort
    If hiBound - loBound = 1 Then
        If IsGreater(vec(SortField, loBound), vec(SortField, hiBound)) Then Call SwapRows(vec, hiBound, loBound)
    End If
    
    '== Three or more items to sort
    For counter = 0 To UBound(vec, 1)
        pivot(counter) = vec(counter, Int((loBound + hiBound) / 2))
        vec(counter, Int((loBound + hiBound) / 2)) = vec(counter, loBound)
        vec(counter, loBound) = pivot(counter)
    Next
    
    loSwap = loBound + 1
    hiSwap = hiBound
    
    Do
        '== Find the right loSwap
        While loSwap < hiSwap And (Not IsGreater(vec(SortField, loSwap), pivot(SortField)))
            loSwap = loSwap + 1
        Wend
        
        '== Find the right hiSwap
        While IsGreater(vec(SortField, hiSwap), pivot(SortField))
        hiSwap = hiSwap - 1
        Wend
        
        
        '== Swap values if loSwap is less then hiSwap
        If loSwap < hiSwap Then Call SwapRows(vec, loSwap, hiSwap)
        
    Loop While loSwap < hiSwap
    
    For counter = 0 To UBound(vec, 1)
        vec(counter, loBound) = vec(counter, hiSwap)
        vec(counter, hiSwap) = pivot(counter)
    Next
    
    '== Recursively call function .. the beauty of Quicksort
    '== 2 or more items in first section
    If loBound < (hiSwap - 1) Then Call QuickSort(vec, loBound, hiSwap - 1, SortField)
    
    '== 2 or more items in second section
    If hiSwap + 1 < hiBound Then Call QuickSort(vec, hiSwap + 1, hiBound, SortField)
    
End Sub

Function IsNaN(sString)
    Dim objRegEx
    
    Set objRegEx = New RegExp
    
    objRegEx.Global = True
    objRegEx.IgnoreCase = True
    objRegEx.Pattern = "\D"
    
    IsNaN = objRegEx.Test(sString)
    
    Set objRegEx = Nothing
    
    
End Function

Function IsGreater(ByVal sStringA, ByVal sStringB)
    Dim nMinLen, i, aCharsA, aCharsB, valA, valB
    
    'Dim tt
    
    'tt = Timer
    
    
    IsGreater = False
    
    
    '----------
    'IsGreater = Eval(sStringA > sStringB)
    'Exit Function
    '----------
    
    sStringA = Replace(sStringA, "-", ".")
    sStringB = Replace(sStringB, "-", ".")
    
    
    aCharsA = Split(sStringA, ".")
    aCharsB = Split(sStringB, ".")
    
    
    ' Find which Ubound is smallest
    nMinLen = UBound(aCharsA)
    If nMinLen > UBound(aCharsB) Then nMinLen = UBound(aCharsB)
    
    
    
    
    'Response.write "======================================================<br>"
    
    'Response.write sStringA &" is greater then "& sStringB  &"<br>"
    
    For i = 0 To nMinLen
        
        
        valA = aCharsA(i)
        valB = aCharsB(i)
        
        
        If Not IsNaN(valA) And Not IsNaN(valB) Then
            ' Do number compare
            If CInt(valA) <> CInt(valB) Then
                
                If CInt(valA) > CInt(valB) Then
                    IsGreater = True
                    'Response.write IsGreater &". Exiting number...<br>"
                    
                    Exit For
                Else
                    'Response.write IsGreater &". Exiting number...<br>"
                    
                    Exit For
                End If
                
            End If
            
        Else
            ' Do string compate
            If valA <> valB Then
                
                If valA > valB Then
                    IsGreater = True
                    'Response.write IsGreater &". Exiting string...<br>"
                    
                    Exit For
                Else
                    'Response.write IsGreater &". Exiting string...<br>"
                    
                    Exit For
                End If
                
            End If
            
        End If
        
        
    Next
    
    'Response.write "RESULT is greater:"& IsGreater  &"<br>"
    'globaltt = globaltt + Timer - tt
    'Response.write "SwapRowsTIME " & Timer - tt & " Globaltt=" & globaltt & "<br>"
End Function