Sorting Source

Option Explicit

Dim unit As Integer
Dim maxItem As Integer

Public Sub restart()

    Dim a() As Integer
    
    Dim i As Integer
    Dim timeElapsed As Single
    
    Let ScaleHeight = ScaleWidth
       
    Let maxItem = Val(txtItem.Text)
    If Not (maxItem >= 10) Or _
       Not (maxItem <= 500) Then
       MsgBox "Please enter the item value between 10-500"
       Exit Sub
    End If
    
    ReDim a(0 To maxItem) As Integer
    
    Let unit = ScaleWidth / maxItem
    
    Let Label1.Caption = "initializing..."
    
    If comboCase.ListIndex = 0 Then
       randomCase a()
    ElseIf comboCase.ListIndex = 1 Then
           worstCase a()
    ElseIf comboCase.ListIndex = 2 Then
           bestCase a()
    End If
        
    Let Label1.Caption = "Sorting..."
    Let timeElapsed = Timer
    
    If ComboSort.ListIndex = 0 Then
       selectSort a()
    ElseIf ComboSort.ListIndex = 1 Then
           bubbleSort a()
    ElseIf ComboSort.ListIndex = 2 Then
           insertSort a()
    ElseIf ComboSort.ListIndex = 3 Then
           shakerSort a()
    ElseIf ComboSort.ListIndex = 4 Then
           quickSort 1, maxItem, a()
    End If
    Let Label1.Caption = (Timer - timeElapsed) & "second(s) elapsed"
   
End Sub

Private Sub quickSort(l As Integer, r As Integer, ByRef a() As Integer)

    Dim min As Integer, temp As Integer
    Dim i As Integer, j As Integer
    Dim m As Integer, w As Integer
    
    Let i = l
    Let j = r
    Let temp = a((l + r) / 2)
    Do
        Do While a(i) < temp
           Let i = i + 1
        Loop
        Do While a(j) > temp
           Let j = j - 1
        Loop
        If i <= j Then
           Let w = a(i)
           Let a(i) = a(j)
           Let a(j) = w
           Let i = i + 1
           Let j = j - 1
        End If
    Loop Until i > j
    
    showDots a()
    
    If l < j Then quickSort l, j, a()
    If i < r Then quickSort i, r, a()
    
End Sub

Private Sub selectSort(ByRef a() As Integer)

    Dim i As Integer, j As Integer
    Dim min As Integer, index As Integer
    Dim temp As Integer
    
    For i = 1 To UBound(a) - 1
        Let min = a(i)
        Let index = i
        For j = i + 1 To UBound(a)
            If a(j) < min Then
               Let min = a(j)
               Let index = j
            End If
        Next
        Let temp = a(i)
        Let a(i) = a(index)
        Let a(index) = temp
        
        showDots a()
        
    Next
    
End Sub

Private Sub bubbleSort(ByRef a() As Integer)
    Dim i As Integer
    Dim j As Integer
    Dim temp As Integer
    For i = UBound(a) To 1 Step -1
        For j = 2 To i
            If a(j - 1) > a(j) Then
               Let temp = a(j - 1)
               Let a(j - 1) = a(j)
               Let a(j) = temp
            End If
        Next
        showDots a()
    Next
End Sub

Private Sub insertSort(ByRef a() As Integer)
    Dim i As Integer
    Dim j As Integer
    Dim temp As Integer
    
    For i = 2 To UBound(a)
        Let temp = a(i)
        Let a(0) = temp
        Let j = i
        Do While a(j - 1) > temp
            Let a(j) = a(j - 1)
            Let j = j - 1
        Loop
        Let a(j) = temp
        
        showDots a()
        
    Next
End Sub

Private Sub shakerSort(ByRef a() As Integer)
    Dim i As Integer, j As Integer, k As Integer
    Dim r As Integer, l As Integer, temp As Integer
    
    Let l = 2
    Let r = UBound(a)
    Let k = UBound(a)
    Do
        For j = r To l Step -1
            If a(j - 1) > a(j) Then
                Let temp = a(j - 1)
                Let a(j - 1) = a(j)
                Let a(j) = temp
                Let k = j
            End If
        Next
        Let l = k + 1
        For j = l To r
            If a(j - 1) > a(j) Then
                Let temp = a(j - 1)
                Let a(j - 1) = a(j)
                Let a(j) = temp
                Let k = j
            End If
        Next
        Let r = k - 1
        showDots a()
    Loop Until l > r
End Sub


Private Sub showDots(ByRef a() As Integer)
    Dim i As Integer
    
    Cls
    For i = 1 To UBound(a)
         Circle (a(i) * unit, ScaleHeight - i * unit), 10, QBColor(Int(Rnd * 15) + 1)
    Next
    
End Sub

Private Sub bestCase(ByRef a() As Integer)
        Dim i As Integer
              
        Randomize Timer
        For i = 1 To maxItem
            Let a(i) = i
        Next
End Sub

Private Sub worstCase(ByRef a() As Integer)
        Dim i As Integer
        
        Randomize Timer
        For i = 1 To maxItem
            Let a(i) = (maxItem - i) + 1
        Next
End Sub

Private Sub randomCase(ByRef a() As Integer)
        Dim i As Integer
        
        Randomize Timer
        For i = 1 To maxItem
            Let a(i) = Int(Rnd * maxItem) + 1
        Next
End Sub

Private Sub start_Click()
    Call restart
End Sub

Private Sub UserControl_Show()
    comboCase.ListIndex = 0
    comboCase.Text = comboCase.List(comboCase.ListIndex)

    ComboSort.ListIndex = 0
    ComboSort.Text = ComboSort.List(ComboSort.ListIndex)
End Sub