Keith G Hicks said:
Those "somewhere's" are not always pre-sortable. Look at the bottom of
the
Help on the Dir() function. You'll see the following:
Tip Because file names are retrieved in no particular order, you may
want
to store returned file names in an array, and then sort the array.
Yes...without question, one does and need a handy sort rouinte.
I also have one in my bag of tricks..and amazing enough..it was the result
of usig the dir command!!
I can't say I used, or needed a sort of a arary much..but it dones come up
form time to time.
Because a list box, or a combo box can be stuffed with a vlue stirng of :
5;4;1
Then I make a sort rouinte to sort the above to:
1;4;5
The code to do this follows, and I used a simple insert merge sort. This
sort is less code, but it does make a copy of the data. Perahps I should
remove all the extra stuff..and just post a "clean" rouinte..but the
foolwing is arleady coded!!
Public Function strDSort(mytext As String, delim As String) As String
' This routine simply sorts a delimited string and retruns the result.
' This is NOT a high speed sort, but for listboxes etc that only have
' 100 or less elements, the sort delay time is not perceiable on a
' moderm pc today. This routine assumes non blank values
Dim intCount As Integer
Dim i As Integer
Dim SortBuf() As String
Dim strOne As String
Dim j As Integer
Dim iPoint As Integer
intCount = strDCount(mytext, delim)
If intCount = 0 Then
strDSort = mytext
Exit Function
End If
intCount = intCount + 1 ' One delinter actually means two values
abc;def is two values!
ReDim SortBuf(intCount) ' our results are sorted into this array.
For i = 1 To intCount
strOne = strDField(mytext, delim, i)
GoSub InsertOne
Next i
' now convert results back to a string
For i = 1 To intCount
If strDSort <> "" Then
strDSort = strDSort & delim
End If
strDSort = strDSort & SortBuf(i)
Next i
Exit Function
InsertOne:
' find place to insert
For j = 1 To intCount
If (strOne <= SortBuf(j)) Or (SortBuf(j) = "") Then
iPoint = j
Exit For
End If
Next j
' make a hole for the value by moving everthing down
For j = intCount To iPoint + 1 Step -1
SortBuf(j) = SortBuf(j - 1)
Next j
SortBuf(iPoint) = strOne
Return
End Function
Public Function strDField(mytext As String, delim As String, groupnum As
Integer) As String
' Returnds a group extract from a string via a delimter.
' Hence to grab "cat" from the string dog-cat you get:
' strDField("dog-cat","-",2)
Dim startpos As Integer, endpos As Integer
Dim groupptr As Integer, chptr As Integer
chptr = 1
startpos = 0
For groupptr = 1 To groupnum - 1
chptr = InStr(chptr, mytext, delim)
If chptr = 0 Then
strDField = ""
Exit Function
Else
chptr = chptr + 1
End If
Next groupptr
startpos = chptr
endpos = InStr(startpos + 1, mytext, delim)
If endpos = 0 Then
endpos = Len(mytext) + 1
End If
strDField = Mid$(mytext, startpos, endpos - startpos)
End Function
Private Function strDCount(mytext As String, delim As String) As Integer
' This routine simply returnds a count of a particular delim string.
' Note that delim can be more then one char, and thus we can use
' this for line couting in memo fields
Dim intPtr As Integer
Dim intFound As Integer
Dim delimLen As Integer
delimLen = Len(delim)
intPtr = InStr(mytext, delim)
Do While intPtr
intFound = intFound + 1
intPtr = intPtr + delimLen
intPtr = InStr(intPtr, mytext, delim)
Loop
strDCount = intFound
End Function
