Sub SEC(arr() As Long) ' Сортировка простым выбором, [S]ort by [E]lementary [C]hoise

    Dim max As Long, i As Long, j As Long
    
    For i = UBound(arr) To 1 Step -1
        NumberOfMaxElement = i
        max = arr(i)
        For j = 0 To i - 1
            If arr(j) > max Then
                NumberOfMaxElement = j
                max = arr(j)
                If NumberOfMaxElement <> i Then
                    arr(NumberOfMaxElement) = arr(i)
                    arr(i) = max
                End If
            End If
        Next
        frmSort.prbSort.Value = UBound(arr) - i
    Next
    
End Sub

Sub SEE(arr() As Long) ' Сортировка простым обменом ' [S]ort by [E]lementary [E]xchange

    Dim i As Long, j As Long
    
    For i = UBound(arr) To 1 Step -1
        For j = 0 To i - 1
            If arr(j) > arr(j + 1) Then
                Call Swap(arr(j), arr(j + 1))
            End If
        Next
        frmSort.prbSort.Value = UBound(arr) - i
    Next
    
End Sub

Sub SC(arr() As Long) ' Сортировка подсчетом [S]ort by [C]ounting
On Error Resume Next

    Dim i As Long, j As Long, Count As Long
    ReDim Temp(UBound(arr)), Temp2(UBound(arr))
    
    For i = UBound(arr) To 1 Step -1
        For j = i - 1 To 0 Step -1
            If arr(i) < arr(j) Then
            Temp(j) = Temp(j) + 1
                Else
            Temp(i) = Temp(i) + 1
            End If
        Next
        If (UBound(arr) - i) Mod 2 = 0 Then frmSort.prbSort.Value = frmSort.prbSort.Value + 1
    Next
    For i = 1 To UBound(arr) + 1
        Temp2(Temp(i - 1)) = arr(i - 1)
        If i Mod 2 = 0 Then frmSort.prbSort.Value = frmSort.prbSort.Value + 1
    Next
    For i = 1 To UBound(arr) + 1
        arr(i - 1) = Temp2(i - 1)
        If i Mod 2 = 0 And frmSort.prbSort.Value < 9 Then frmSort.prbSort.Value = frmSort.prbSort.Value + 1
    Next
    
End Sub

Sub SCWSA(arr() As Long) ' Сортировка подсчетом без дополнительного массива, [S]ort by [C]ounting [W]ithout [S]econd [A]rray
On Error Resume Next

    Dim i As Long, j As Long, Count As Long
    ReDim Temp(UBound(arr))
    
    For i = UBound(arr) To 1 Step -1
        For j = i - 1 To 0 Step -1
            If arr(i) < arr(j) Then
            Temp(j) = Temp(j) + 1
                Else
            Temp(i) = Temp(i) + 1
            End If
        Next
        If (UBound(arr) - i) Mod 2 = 0 Then frmSort.prbSort.Value = frmSort.prbSort.Value + 1
    Next
    For i = 1 To UBound(arr) + 1
        Do While Temp(i - 1) <> i - 1
            Call Swap(arr(i - 1), arr(Temp(i - 1)))
            Call Swap(Temp(i - 1), Temp(Temp(i - 1)))
        Loop
        If i Mod 2 = 0 Then frmSort.prbSort.Value = frmSort.prbSort.Value + 1
    Next
    
End Sub

Sub SBP(arr() As Long)  'Сортировка бинарными вставками, [S}ort by [B]inary [P]aste

    Dim i As Long, j As Long, k As Long, pos As Long
    
    If arr(0) > arr(1) Then Call Swap(arr(0), arr(1))
    For i = 2 To UBound(arr)
        j = i \ 2
        pos = i
        Do While arr(pos) < arr(j - 1) And arr(pos) < arr(j)
            If arr(j) > arr(pos) Then
                j = j \ 2
                If j = 0 Then Exit Do
            Else
                j = j + j \ 2
            End If
        Loop
        Call Swap(arr(pos), arr(j))
        If j + 1 <> i Then
            For k = i To j + 2 Step -1
                Call Swap(arr(k - 1), arr(k))
            Next
        End If
        frmSort.prbSort.Value = i
    Next
    
End Sub

Sub SCf(First As Long, Last As Long, arr() As Long) ' Сортировка слиянием, [S]ort by [C]on[f]luence
On Error Resume Next

    If First < Last Then
        If Last - First = 1 Then
            If arr(Last) < arr(First) Then Call Swap(arr(Last), arr(First))
        Else
            frmSort.prbSort.Value = frmSort.prbSort.Value + 2
            Call SCf(First, First + (Last - First) \ 2, arr)
            Call SCf(First + (Last - First) \ 2 + 1, Last, arr)
            Call Cf(First, Last, arr)
        End If
    End If
    
End Sub

Sub Cf(First As Long, Last As Long, arr() As Long) ' Собственно, слияние, [C]on[f]luence

    Dim i As Long, j As Long, t As Long, MidEl As Long
    Dim Temp() As Long
    ReDim Temp(UBound(arr))
    
    MidEl = First + (Last - First) \ 2
    i = First
    j = MidEl + 1
    t = 0
    Do While i <= MidEl And j <= Last
        If arr(i) < arr(j) Then
            Temp(t) = arr(i)
            i = i + 1
        Else
            Temp(t) = arr(j)
            j = j + 1
        End If
        t = t + 1
    Loop
    Do While i <= MidEl
        Temp(t) = arr(i)
        i = i + 1
        t = t + 1
    Loop
    Do While j <= MidEl
        Temp(t) = arr(j)
        j = j + 1
        t = t = 1
    Loop
    For i = 0 To t - 1
        arr(First + i) = Temp(i)
    Next
    
End Sub

Sub QS(First As Long, Last As Long, arr() As Long) ' Быстрая сортировка, [Q]uick [S]ort
On Error Resume Next

    Dim i As Long, j As Long, MidEl As Long
    
    i = First
    j = Last
    MidEl = arr((First + Last) \ 2)
    Do While i <= j
        If arr(i) < MidEl Then
            i = i + 1
        Else
            If arr(j) > MidEl Then
                j = j - 1
            Else
                Call Swap(arr(i), arr(j))
                i = i + 1
                j = j - 1
            End If
        End If
    Loop
    frmSort.prbSort.Value = frmSort.prbSort.Value + 1
    If First < j Then Call QS(First, j, arr)
    If i < Last Then Call QS(i, Last, arr)
    
End Sub

Sub PS(arr() As Long) ' Пирамидальная сортировка, [P]yramidal [S]ort

    Dim i As Long, Temp_Var As Long
    Temp_Var = UBound(arr) \ 2 + 1
    For i = Temp_Var - 1 To 0 Step -1
        Call CP(i, UBound(arr), arr)
    Next
    For i = UBound(arr) To 1 Step -1
        Call Swap(arr(0), arr(i))
        Call CP(0, i - 1, arr)
        frmSort.prbSort.Value = frmSort.prbSort.Value + 1
    Next
    
End Sub

Sub CP(First As Long, Last As Long, arr() As Long) 'Построение пирамиды, [C]onstruction of a [P]yramid

    Dim Temp_Var As Long, i As Long, j As Long
    Dim PP As Boolean ' [P]lase in a [P]yramyd

    i = First
    Temp_Var = arr(i)
    j = i * 2
    PP = False
    Do While j <= Last And PP = False
        If j < Last Then
            If arr(j) < arr(j + 1) Then j = j + 1
        End If
        If Temp_Var >= arr(j) Then
            PP = True
        Else
            arr(i) = arr(j)
            i = j
            j = i * 2
        End If
    Loop
    arr(i) = Temp_Var
    
End Sub