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