Visual Basic 6.0 排序模块

Visual Basic,还是6.0的版本,本就应该是被抛弃的语言,结果学校还是教,也是没办法(嗟乎)

仅限6.0使用

Public Sub sort(ByRef data() As Integer, ByVal UpBond, ByVal DownBond, ByVal Style, ByVal Decending As Boolean) 
    'Wapper for sort cores
    '
    'This work is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License
    Original author : Hzy
    '
    'Style       switch
    '                   1     - select sort
    '                   2     - bubble sort
    '                   3     - quick  sort
    '
    'Decending   switch
    '                    true  - decending sort
    '                    false - ascending sort
    '
    'Return value define
    '                   0     - Operating good
    '                   1     - Unsuitable upbond and downbond
    '                   2     - Unpredicted swap error
    '                   3     - Unknown sort style
    Dim erro As Integer
    Select Case Style
        Case 1
            erro = sort_select_core(data(), UpBond, DownBond)
        Case 2
            erro = sort_bubble_core(data(), UpBond, DownBond)
        Case 3
            erro = sort_quick_core(data(), UpBond, DownBond)
        Case Else
            MsgBox ("Error: 3"): Exit Function
    End Select
    If 0 <> erro Then MsgBox ("Error:" & erro)
    If Decending Then erro = reserve(data(), UpBond, DownBond)
    If 0 <> erro Then MsgBox ("Error:" & erro)
End Sub
Public Function reserve(ByRef data() As Integer, ByVal UpBond, ByVal DownBond) As Integer
    If UpBond < DownBond Then reserve = 1: Exit Function
    For i = DownBond To (UpBond - DownBond) \ 2 + DownBond
        If 0 <> swap(data(i), data(UpBond - i)) Then reserve = 2: Exit Function
    Next i
End Function
Public Function sort_select_core(ByRef data() As Integer, ByVal UpBond, ByVal DownBond) As Integer
    If UpBond < DownBond Then sort_select_core = 1: Exit Function
    For i = DownBond To UpBond - 1
        For j = i To UpBond
            If data(i) > data(j) Then If 0 <> swap(data(i), data(j)) Then sort_select_core = 2: Exit Function
        Next j
    Next i
End Function
Public Function sort_bubble_core(ByRef data() As Integer, ByVal UpBond, ByVal DownBond) As Integer
    If UpBond < DownBond Then sort_bubble_core = 1: Exit Function
    For i = DownBond To UpBond - 1
        For j = DownBond To UpBond - 1
            If data(j) > data(j + 1) Then If 0 <> swap(data(j), data(j + 1)) Then sort_bubble_core = 2: Exit Function
        Next j
    Next i
End Function
Private Function sort_quick_core(ByRef data() As Integer, ByVal UpBond, ByVal DownBond) As Integer
    If UpBond < DownBond Then sort_quick_core = 1: Exit Function
    If UpBond > DownBond Then
        std = data(UpBond)
        rhs = UpBond - 1
        lhs = DownBond
        Do
            While rhs <> lhs And data(rhs) >= std
                rhs = rhs - 1
            Wend
            While lhs <> rhs And data(lhs) <= std
                lhs = lhs + 1
            Wend
            If rhs = lhs Then Exit Do
            If 0 <> swap(data(rhs), data(lhs)) Then sort_quick_core = 2: Exit Function
        Loop
        If data(rhs) > std Then
            If 0 <> swap(data(rhs), data(UpBond)) Then sort_quick_core = 2: Exit Function
        Else
            If 0 <> swap(data(rhs + 1), data(UpBond)) Then sort_quick_core = 2: Exit Function
        End If
        Dim erro As Integer
        erro = sort_quick_core(data(), UpBond, rhs + 1)
        If 0 <> erro Then sort_quick_core = erro
        erro = sort_quick_core(data(), lhs, DownBond)
        If 0 <> erro Then sort_quick_core = erro
    End If
    sort_quick_core = 0
End Function
Public Function swap(ByRef lhs As Integer, ByRef rhs As Integer) As Integer
    Dim mhs As Integer
    mhs = lhs
    lhs = rhs
    rhs = mhs
    swap = 0
End Function

留下评论