VB 5/6-Tipp 0547: Sortieren mehrdimensionaler Arrays mit Quicksort

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------ Anfang Projektdatei quicksort.vbp  ------------
'------- Anfang Formular "sorter" alias quicksort.frm -------
' Steuerelement: Schaltfläche "cmd_end"
' Steuerelement: Schaltfläche "cmd_date"
' Steuerelement: Schaltfläche "cmd_shff"
' Steuerelement: Listen-Steuerelement "List2"
' Steuerelement: Schaltfläche "cmd_char"
' Steuerelement: Listen-Steuerelement "List1"
Option Explicit



Dim Feld(0 To 555, 0 To 1)

Private Sub quicksort(ByVal LB As Long, ByVal UB As Long, D As Integer)
Dim A           As Integer
Dim X           As Long
Dim P1          As Long
Dim P2          As Long
Dim Ref(0 To 1) As Variant
Dim TMP(0 To 1) As Variant
A = 0
If D = 0 Then: A = 1
P1 = LB
P2 = UB
X = (P1 + P2) / 2
Ref(D) = Feld(X, D)
Ref(A) = Feld(X, A)
  Do
    Do While (Feld(P1, D) < Ref(D))
    P1 = P1 + 1
    Loop
    Do While (Feld(P2, D) > Ref(D))
    P2 = P2 - 1
    Loop
    If P1 <= P2 Then
    TMP(D) = Feld(P1, D)
    TMP(A) = Feld(P1, A)
    Feld(P1, D) = Feld(P2, D)
    Feld(P1, A) = Feld(P2, A)
    Feld(P2, D) = TMP(D)
    Feld(P2, A) = TMP(A)
    P1 = P1 + 1
    P2 = P2 - 1
    End If
  Loop Until (P1 > P2)
If LB < P2 Then Call quicksort(LB, P2, D)
If P1 < UB Then Call quicksort(P1, UB, D)
End Sub

Private Sub Form_Load()
Call Shuffle
End Sub

Private Sub cmd_shff_Click()
Call Shuffle
End Sub

Private Sub cmd_char_Click()
Dim X   As Integer
List2.Clear
Call quicksort(LBound(Feld), UBound(Feld), 0)
  For X = 0 To UBound(Feld)
  List2.AddItem Feld(X, 0) & ",  " & Feld(X, 1)
  Next X
End Sub

Private Sub cmd_date_Click()
Dim X   As Integer
List2.Clear
Call quicksort(LBound(Feld), UBound(Feld), 1)
  For X = 0 To UBound(Feld)
  List2.AddItem Feld(X, 1) & ",  " & Feld(X, 0)
  Next X
End Sub

Private Sub cmd_end_Click()
End
End Sub

Private Sub Shuffle()
Dim X   As Integer
Dim Y   As Integer
Dim aa  As String
Dim bb  As Date
Call Randomize(Timer)
List1.Clear
List2.Clear
  For X = 0 To UBound(Feld)
  aa = ""
    For Y = 0 To 7
    aa = aa & Chr$(Rnd * 25 + 97)
    Next Y
  bb = CDate(Int(Rnd * 27 + 1) & "." & _
             Int(Rnd * 11 + 1) & "." & _
             Int(Rnd * 33 + 1969) & " " & _
             Int(Rnd * 24) & ":" & _
             Int(Rnd * 58 + 1) & ":" & _
             Int(Rnd * 58 + 1))
  List1.AddItem aa & ",  " & bb
  Feld(X, 0) = aa
  Feld(X, 1) = bb
  Next X
End Sub
'-------- Ende Formular "sorter" alias quicksort.frm --------
'------------- Ende Projektdatei quicksort.vbp  -------------