SortMsFlexg




Public Sub QSort(Grid As MSFlexGrid, ByVal Column As Integer, _
ByVal min As Long, ByVal max As Long, _
ByVal Ascending As Boolean, ByVal NumComp As Boolean)
Dim tmp() ' when swap rows keep copy here
ReDim tmp(Grid.Cols)
Dim med_value, hi As Long, lo As Long, i As Integer
If min >= max Then Exit Sub
med_value = Grid.TextMatrix(min, Column)
SaveRow Grid, min, tmp
lo = min
hi = max
Do
Do While Compare(Grid.TextMatrix(hi, Column), med_value, _
NumComp, Ascending) >= 0
hi = hi - 1
If hi <= lo Then Exit Do
Loop
If hi <= lo Then
RestoreRow Grid, lo, tmp
Exit Do
End If
For i = 0 To Grid.Cols - 1
Grid.TextMatrix(lo, i) = Grid.TextMatrix(hi, i)
Next i
lo = lo + 1
Do While Compare(Grid.TextMatrix(lo, Column), med_value, _
NumComp, Ascending) < 0
lo = lo + 1
If lo >= hi Then Exit Do
Loop
If lo >= hi Then
lo = hi
RestoreRow Grid, hi, tmp
Exit Do
End If
For i = 0 To Grid.Cols - 1
Grid.TextMatrix(hi, i) = Grid.TextMatrix(lo, i)
Next i
Loop
QSort Grid, Column, min, lo - 1, Ascending, NumComp
QSort Grid, Column, lo + 1, max, Ascending, NumComp
End Sub

Private Function Compare(ByVal X, ByVal Y, ByVal _
NumComp As Boolean, ByVal Ascending As Boolean) _
As Integer
Dim b As Integer
If NumComp Then
X = CDbl(X)
Y = CDbl(Y)
End If
If X > Y Then b = 1
If X < Y Then b = -1
If X = Y Then b = 0
If Not Ascending Then b = -b
Compare = b
End Function

Private Sub RestoreRow(Grid As MSFlexGrid, _
ByVal RowNum As Long, tmpArr())
Dim i As Long
For i = 0 To Grid.Cols - 1
Grid.TextMatrix(RowNum, i) = tmpArr(i)
Next i
End Sub

Private Sub SaveRow(Grid As MSFlexGrid, ByVal RowNum As Long, _
tmpArr())
Dim i As Long
For i = 0 To Grid.Cols - 1
tmpArr(i) = Grid.TextMatrix(RowNum, i)
Next i
End Sub










( sortmsflexg.html )- by Paolo Puglisi - Modifica del 17/12/2023