⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 module1.vb

📁 Visual.Basic.NET实用编程百例-47.6M.zip
💻 VB
字号:
Module Module1
    Public Const ZERO As Short = 0
    Public Const ASCENDING_ORDER As Short = 0
    Public Const DESCENDING_ORDER As Short = 1
    Public gIterations As Object

    Sub BubbleSort(ByRef MyArray() As Object, ByVal nOrder As Short)
        Dim Index As Object
        Dim TEMP As Object
        Dim NextElement As Object

        NextElement = ZERO
        Do While (NextElement < UBound(MyArray))
            Index = UBound(MyArray)
            Do While (Index > NextElement)
                If nOrder = ASCENDING_ORDER Then
                    If MyArray(Index) < MyArray(Index - 1) Then
                        TEMP = MyArray(Index)
                        MyArray(Index) = MyArray(Index - 1)
                        MyArray(Index - 1) = TEMP
                    End If
                ElseIf nOrder = DESCENDING_ORDER Then
                    If MyArray(Index) >= MyArray(Index - 1) Then
                        TEMP = MyArray(Index)
                        MyArray(Index) = MyArray(Index - 1)
                        MyArray(Index - 1) = TEMP
                    End If
                End If
                Index = Index - 1
                gIterations = gIterations + 1
            Loop
            NextElement = NextElement + 1
            gIterations = gIterations + 1
        Loop

    End Sub

    Sub Bucket(ByRef MyArray() As Object, ByVal nOrder As Short)
        Dim Index As Object
        Dim NextElement As Object
        Dim TheBucket As Object

        NextElement = LBound(MyArray) + 1
        While (NextElement <= UBound(MyArray))
            TheBucket = MyArray(NextElement)
            Index = NextElement
            Do
                If Index > LBound(MyArray) Then
                    If nOrder = ASCENDING_ORDER Then
                        If TheBucket < MyArray(Index - 1) Then
                            MyArray(Index) = MyArray(Index - 1)
                            Index = Index - 1
                        Else
                            Exit Do
                        End If
                    ElseIf nOrder = DESCENDING_ORDER Then
                        If TheBucket >= MyArray(Index - 1) Then
                            MyArray(Index) = MyArray(Index - 1)
                            Index = Index - 1
                        Else
                            Exit Do
                        End If
                    End If
                Else
                    Exit Do
                End If
                gIterations = gIterations + 1
            Loop
            MyArray(Index) = TheBucket
            NextElement = NextElement + 1
            gIterations = gIterations + 1
        End While

    End Sub

    Sub Heap(ByRef MyArray() As Object)
        Dim Index As Object
        Dim Size As Object
        Dim TEMP As Object

        Size = UBound(MyArray)

        Index = 1
        While (Index <= Size)
            Call HeapSiftup(MyArray, Index)
            Index = Index + 1
            gIterations = gIterations + 1
        End While

        Index = Size
        While (Index > 0)
            TEMP = MyArray(0)
            MyArray(0) = MyArray(Index)
            MyArray(Index) = TEMP
            Call HeapSiftdown(MyArray, Index - 1)
            Index = Index - 1
            gIterations = gIterations + 1
        End While

    End Sub


    Sub HeapSiftdown(ByRef MyArray() As Object, ByRef M As Object)
        Dim Index As Object
        Dim Parent As Object
        Dim TEMP As Object

        Index = 0
        Parent = 2 * Index

        Do While (Parent <= M)

            If (Parent < M And MyArray(Parent) < MyArray(Parent + 1)) Then
                Parent = Parent + 1
            End If

            If MyArray(Index) >= MyArray(Parent) Then
                Exit Do
            End If

            TEMP = MyArray(Index)
            MyArray(Index) = MyArray(Parent)
            MyArray(Parent) = TEMP

            Index = Parent
            Parent = 2 * Index

            gIterations = gIterations + 1
        Loop
    End Sub

    Sub HeapSiftup(ByRef MyArray() As Object, ByRef M As Object)
        Dim Index As Object
        Dim Parent As Object
        Dim TEMP As Object

        Index = M
        Do While (Index > 0)
            Parent = Int(Index / 2)

            If MyArray(Parent) >= MyArray(Index) Then
                Exit Do
            End If

            TEMP = MyArray(Index)
            MyArray(Index) = MyArray(Parent)
            MyArray(Parent) = TEMP
            Index = Parent
            gIterations = gIterations + 1
        Loop

    End Sub

    Sub Insertion(ByRef MyArray() As Object, ByVal nOrder As Short)
        Dim Index As Object
        Dim TEMP As Object
        Dim NextElement As Object

        NextElement = LBound(MyArray) + 1
        While (NextElement <= UBound(MyArray))
            Index = NextElement
            Do
                If Index > LBound(MyArray) Then
                    If nOrder = ASCENDING_ORDER Then
                        If MyArray(Index) < MyArray(Index - 1) Then
                            TEMP = MyArray(Index)
                            MyArray(Index) = MyArray(Index - 1)
                            MyArray(Index - 1) = TEMP
                            Index = Index - 1
                        Else
                            Exit Do
                        End If
                    ElseIf nOrder = DESCENDING_ORDER Then
                        If MyArray(Index) >= MyArray(Index - 1) Then
                            TEMP = MyArray(Index)
                            MyArray(Index) = MyArray(Index - 1)
                            MyArray(Index - 1) = TEMP
                            Index = Index - 1
                        Else
                            Exit Do
                        End If
                    End If
                Else
                    Exit Do
                End If
                gIterations = gIterations + 1
            Loop
            NextElement = NextElement + 1
            gIterations = gIterations + 1
        End While

    End Sub

    Sub QuickSort(ByRef MyArray() As Object, ByRef L As Object, ByRef R As Object)
        Dim X, I, J, Y As Object

        I = L
        J = R
        X = MyArray((L + R) / 2)

        While (I <= J)
            While (MyArray(I) < X And I < R)
                I = I + 1
            End While
            While (X < MyArray(J) And J > L)
                J = J - 1
            End While
            If (I <= J) Then
                Y = MyArray(I)
                MyArray(I) = MyArray(J)
                MyArray(J) = Y
                I = I + 1
                J = J - 1
            End If
            gIterations = gIterations + 1
        End While

        If (L < J) Then Call QuickSort(MyArray, L, J)
        If (I < R) Then Call QuickSort(MyArray, I, R)

    End Sub

    Sub Selection(ByRef MyArray() As Object, ByVal nOrder As Short)
        Dim Index As Object
        Dim Min As Object
        Dim NextElement As Object
        Dim TEMP As Object

        NextElement = 0
        While (NextElement < UBound(MyArray))
            Min = UBound(MyArray)
            Index = Min - 1
            While (Index >= NextElement)
                If nOrder = ASCENDING_ORDER Then
                    If MyArray(Index) < MyArray(Min) Then
                        Min = Index
                    End If
                ElseIf nOrder = DESCENDING_ORDER Then
                    If MyArray(Index) >= MyArray(Min) Then
                        Min = Index
                    End If
                End If
                Index = Index - 1
                gIterations = gIterations + 1
            End While
            TEMP = MyArray(Min)
            MyArray(Min) = MyArray(NextElement)
            MyArray(NextElement) = TEMP
            NextElement = NextElement + 1
            gIterations = gIterations - 1
        End While

    End Sub

    Sub ShellSort(ByRef MyArray() As Object, ByVal nOrder As Short)
        Dim Distance As Object
        Dim Size As Object
        Dim Index As Object
        Dim NextElement As Object
        Dim TEMP As Object

        Size = UBound(MyArray) - LBound(MyArray) + 1
        Distance = 1
        While (Distance <= Size)
            Distance = 2 * Distance
        End While

        Distance = (Distance / 2) - 1

        While (Distance > 0)

            NextElement = LBound(MyArray) + Distance

            While (NextElement <= UBound(MyArray))
                Index = NextElement
                Do
                    If Index >= (LBound(MyArray) + Distance) Then
                        If nOrder = ASCENDING_ORDER Then
                            If MyArray(Index) < MyArray(Index - Distance) Then
                                TEMP = MyArray(Index)
                                MyArray(Index) = MyArray(Index - Distance)
                                MyArray(Index - Distance) = TEMP
                                Index = Index - Distance
                                gIterations = gIterations + 1
                            Else
                                Exit Do
                            End If
                        ElseIf nOrder = DESCENDING_ORDER Then
                            If MyArray(Index) >= MyArray(Index - Distance) Then
                                TEMP = MyArray(Index)
                                MyArray(Index) = MyArray(Index - Distance)
                                MyArray(Index - Distance) = TEMP
                                Index = Index - Distance
                                gIterations = gIterations + 1
                            Else
                                Exit Do
                            End If
                        End If
                    Else
                        Exit Do
                    End If
                Loop
                NextElement = NextElement + 1
                gIterations = gIterations + 1
            End While
            Distance = (Distance - 1) / 2
            gIterations = gIterations + 1
        End While

    End Sub
End Module

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -