IComparable sorting equivalent for VB6

Has anyone encountered/created a decent implementation of gene开发者_StackOverflow社区ric sorting of collections of objects in VB6?

If so, anyone care to provide code or link?

This one does the trick for me.

Please note that I'm not the author. The original source is mentioned in the Function header, but that site seems to be gone by now.

The part to get it going is VB's little known or often overlooked CallByName command.

Public Function SortItemCollection(col As Collection, ByVal sPropertyName As String, _
   ByVal bolSortAscending As Boolean, ByVal bolCompareNumeric As Boolean) As Collection
'------------------------------------------------------------------------------
'Purpose  : Sort a collection of objects using one of the object's properties
'           as the sorting field. That property must be of a primitive
'           data type (string or numeric)
'
'Prereq.  : !!! Important !!! The scope of property sPropertyName needs to be
'           declared as Public.
'Parameter: -
'Returns  : -
'Note     : The idea is to have a class that is added to a collection object.
'           Pass that collection to this function below and the property name
'           is the “field” within the class that is to be sorted on.
'
'   Author: Original author unknown, refined by Branko Pedisic
'   Source: http://www.ifnottruethenfalse.com/sort-a-collection-object-in-vb6/
'  Changed: 19.03.2014
'           - Source reformatted and variable names changed to accommodate my
'           naming conventions.
'------------------------------------------------------------------------------
   Dim colNew As Collection
   Dim oCurrent As Object
   Dim oCompare As Object
   Dim lCompareIndex As Long
   Dim sCurrent As String
   Dim sCompare As String
   Dim bolGreaterValueFound As Boolean

   'make a copy of the collection, ripping through it one item
   'at a time, adding to new collection in right order...

   Set colNew = New Collection

   For Each oCurrent In col

      'get value of current item...
      sCurrent = CallByName(oCurrent, sPropertyName, VbGet)

      'setup for compare loop
      bolGreaterValueFound = False
      lCompareIndex = 0

      For Each oCompare In colNew
         lCompareIndex = lCompareIndex + 1

         sCompare = CallByName(oCompare, sPropertyName, VbGet)

         'optimization - instead of doing this for every iteration,
         'have 2 different loops...
         If bolCompareNumeric = True Then
            'this means we are looking for a numeric sort order...

            If (bolSortAscending = True) Then
               If Val(sCurrent) < Val(sCompare) Then
                  'found an item in compare collection that is greater...
                  'add it to the new collection...
                  bolGreaterValueFound = True
                  colNew.Add oCurrent, , lCompareIndex
                  Exit For
               End If
            Else
               If Val(sCurrent) > Val(sCompare) Then
                  'found an item in compare collection that is greater...
                  'add it to the new collection...
                  bolGreaterValueFound = True
                  colNew.Add oCurrent, , lCompareIndex
                  Exit For
               End If
            End If

         Else     '// If bolCompareNumeric = True
            'this means we are looking for a string sort...

            If (bolSortAscending = True) Then
               If sCurrent < sCompare Then
                  'found an item in compare collection that is greater...
                  'add it to the new collection...
                  bolGreaterValueFound = True
                  colNew.Add oCurrent, , lCompareIndex
                  Exit For
               End If
            Else
               If sCurrent > sCompare Then
                  'found an item in compare collection that is greater...
                  'add it to the new collection...
                  bolGreaterValueFound = True
                  colNew.Add oCurrent, , lCompareIndex
                  Exit For
               End If
            End If

         End If   '// If bolCompareNumeric = True
      Next oCompare

      'if we didn't find something bigger, just add it to the end of
      'the new collection...
      If bolGreaterValueFound = False Then
         colNew.Add oCurrent
      End If

   Next oCurrent

   'return the new collection...
   Set SortItemCollection = colNew
   Set colNew = Nothing

End Function