VB6的IComparable排序等价物

Question

有没有人遇到/创建了VB6中对象集合的通用排序的体面实现？

如果是这样,任何人都在乎提供代码或链接？

Answer 1

这对我来说很有效。

\n\n

请注意，我不是作者。函数标题中提到了原始来源，但该网站现在似乎已经消失了。

\n\n

让它运行的部分是 VB 鲜为人知或经常被忽视的CallByName命令。

\n\n

Public Function SortItemCollection(col As Collection, ByVal sPropertyName As String, _\n   ByVal bolSortAscending As Boolean, ByVal bolCompareNumeric As Boolean) As Collection\n'------------------------------------------------------------------------------\n'Purpose  : Sort a collection of objects using one of the object's properties\n'           as the sorting field. That property must be of a primitive\n'           data type (string or numeric)\n'\n'Prereq.  : !!! Important !!! The scope of property sPropertyName needs to be\n'           declared as Public.\n'Parameter: -\n'Returns  : -\n'Note     : The idea is to have a class that is added to a collection object.\n'           Pass that collection to this function below and the property name\n'           is the \xe2\x80\x9cfield\xe2\x80\x9d within the class that is to be sorted on.\n'\n'   Author: Original author unknown, refined by Branko Pedisic\n'   Source: http://www.ifnottruethenfalse.com/sort-a-collection-object-in-vb6/\n'  Changed: 19.03.2014\n'           - Source reformatted and variable names changed to accommodate my\n'           naming conventions.\n'------------------------------------------------------------------------------\n   Dim colNew As Collection\n   Dim oCurrent As Object\n   Dim oCompare As Object\n   Dim lCompareIndex As Long\n   Dim sCurrent As String\n   Dim sCompare As String\n   Dim bolGreaterValueFound As Boolean\n\n   'make a copy of the collection, ripping through it one item\n   'at a time, adding to new collection in right order...\n\n   Set colNew = New Collection\n\n   For Each oCurrent In col\n\n      'get value of current item...\n      sCurrent = CallByName(oCurrent, sPropertyName, VbGet)\n\n      'setup for compare loop\n      bolGreaterValueFound = False\n      lCompareIndex = 0\n\n      For Each oCompare In colNew\n         lCompareIndex = lCompareIndex + 1\n\n         sCompare = CallByName(oCompare, sPropertyName, VbGet)\n\n         'optimization - instead of doing this for every iteration,\n         'have 2 different loops...\n         If bolCompareNumeric = True Then\n            'this means we are looking for a numeric sort order...\n\n            If (bolSortAscending = True) Then\n               If Val(sCurrent) < Val(sCompare) Then\n                  'found an item in compare collection that is greater...\n                  'add it to the new collection...\n                  bolGreaterValueFound = True\n                  colNew.Add oCurrent, , lCompareIndex\n                  Exit For\n               End If\n            Else\n               If Val(sCurrent) > Val(sCompare) Then\n                  'found an item in compare collection that is greater...\n                  'add it to the new collection...\n                  bolGreaterValueFound = True\n                  colNew.Add oCurrent, , lCompareIndex\n                  Exit For\n               End If\n            End If\n\n         Else     '// If bolCompareNumeric = True\n            'this means we are looking for a string sort...\n\n            If (bolSortAscending = True) Then\n               If sCurrent < sCompare Then\n                  'found an item in compare collection that is greater...\n                  'add it to the new collection...\n                  bolGreaterValueFound = True\n                  colNew.Add oCurrent, , lCompareIndex\n                  Exit For\n               End If\n            Else\n               If sCurrent > sCompare Then\n                  'found an item in compare collection that is greater...\n                  'add it to the new collection...\n                  bolGreaterValueFound = True\n                  colNew.Add oCurrent, , lCompareIndex\n                  Exit For\n               End If\n            End If\n\n         End If   '// If bolCompareNumeric = True\n      Next oCompare\n\n      'if we didn't find something bigger, just add it to the end of\n      'the new collection...\n      If bolGreaterValueFound = False Then\n         colNew.Add oCurrent\n      End If\n\n   Next oCurrent\n\n   'return the new collection...\n   Set SortItemCollection = colNew\n   Set colNew = Nothing\n\nEnd Function\n

\n