VB实现6大排序算法---动态过程展示（建议收藏）

Posted 2021-06-30 刘一哥GIS

VB实现6大排序算法：插入排序、基数排序、快速排序、希尔排序、选择排序、归并排序。可以随机生成指定个数的数据，显示排序过程，给出排序结果，计算排序算法消耗的时间。

生成随机数：

排序结果：

插入排序：

选择排序：

归并排序：

快速排序：

希尔排序：

基数排序：

核心代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Sort"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Num As Long
Private Aux() As Integer
Private R() As Integer
Private Sub Class_Initialize()
Num = 0
End Sub
Public Property Let SetNum(ByVal NumberOfData As Long)
    Num = NumberOfData - 1
    ReDim Aux(NumberOfData)
End Property
Public Property Let SetRArray(ByRef RArray() As Integer)
    R = RArray
End Property
Public Sub selectSort(L() As Integer)
Dim i As Long
Dim j As Long
Dim m As Long
Dim t As Integer
For i = 0 To Num
    m = i
    t = L(i)
    For j = i + 1 To Num
        If t > L(j) Then
            t = L(j)
            m = j
        End If
    Next j
    If m <> j Then
        t = L(i)
        L(i) = L(m)
        L(m) = t
    End If
Next i
End Sub
Sub Merge(ByRef A() As Integer, ByVal Left As Long, ByVal m As Long, ByVal Right As Long)
Dim i As Long
Dim j As Long
Dim k As Long
i = m + 1
While i > Left
    Aux(i - 1) = A(i - 1)
    i = i - 1
Wend
For j = m To Right - 1
    Aux(Right + m - j) = A(j + 1)
Next j
For k = Left To Right
    If Aux(j) < Aux(i) Then
        A(k) = Aux(j)
        j = j - 1
    Else
        A(k) = Aux(i)
        i = i + 1
    End If
Next k
End Sub
Public Sub mergeSort(ByRef L() As Integer, ByVal Left As Long, ByVal Right As Long)
Dim m As Long
m = Int(Left / 2 + Right / 2)
If Right <= Left Then Exit Sub
mergeSort L, Left, m
mergeSort L, m + 1, Right
Merge L, Left, m, Right
End Sub
Public Sub QuickSort(L() As Integer, ByVal Low As Long, ByVal High As Long)
Dim i As Long
Dim j As Long
Dim Pivotkey As Integer
i = Low: j = High
Pivotkey = L(Low)
While (i < j)
    While (i < j And Pivotkey <= L(j))
        j = j - 1
    Wend
    If (i < j) Then
        L(i) = L(j)
        i = i + 1
    End If
    While (i < j And L(i) < Pivotkey)
        i = i + 1
    Wend
    If (i < j) Then
        L(j) = L(i)
        j = j - 1
    End If
Wend
L(i) = Pivotkey
If (Low < i) Then QuickSort L, Low, i - 1
If (i < High) Then QuickSort L, j + 1, High
End Sub
Private Function Less(ByVal V As Long, Rx() As Integer, ByVal Item As Long) As Boolean
    If Item < 0 Then Less = False: Exit Function
    Less = V < Rx(Item)
End Function
Public Sub ShellSort(A() As Integer, ByVal Left As Long, ByVal Right As Long)
Dim i As Long
Dim j As Long
Dim h As Long
Dim V As Integer
Dim pa As Integer
h = 1
For i = 1 To (Right - Left) / (Num - 1)
    h = 3 * h + 1
Next i
While (h > 0 And DoEvents)
    For i = Left + h To Right
        j = i
        V = A(i)
        While (j >= L + h And Less(V, A, j - h))
            A(j) = A(j - h)
            j = j - h
        Wend
        A(j) = V
        If En Then Disp
    Next i
    h = Int(h / 3)
Wend
End Sub
Sub RadixSort(A() As Integer, ByVal n As Long)
Dim Max As Integer
Dim Count As Long
Dim m As Long
Max = 0
For i = 0 To n
    If Max < A(i) Then Max = A(i)
Next i

ReDim Aux(Max + 1)
For i = 0 To n
    m = A(i)
    Aux(m) = Aux(m) + 1
Next i

m = 0
For i = 0 To Max
    Count = Aux(i)
    If Count <> 0 Then
    For j = 0 To Count - 1
        A(m) = i
        m = m + 1
    Next j
    End If
Next i
End Sub
Public Sub InsertSort(ByRef A() As Integer, ByVal n As Long)
Dim i As Long
Dim j As Long
Dim Tmp As Integer
For i = 1 To n
    If (A(i) < A(i - 1)) Then
        Tmp = A(i)
        A(i) = A(i - 1)
        j = i - 2
        While (Less(Tmp, A, j))
            j = j - 1
            If (j >= 0) Then
                A(j + 1) = A(j)
            End If
        Wend
        A(j + 1) = Tmp
    End If
Next i
End Sub

Private Sub Class_Terminate()
Erase Aux
End Sub

获取完整源代码，请私信博主。