modarrayhelpers.bas

来自「VB 加密----------能够加密解密控件」· BAS 代码 · 共 488 行 · 第 1/2 页

        mSortItems.Buffer = 0
        mHasSortItems = False
    End If
End Sub
Public Sub SwapSortItems(ByRef Items As SortItems, ByVal i As Long, ByVal j As Long)
    With Items.SA
        Select Case .cbElements
            Case 4:     Call Helper.Swap4(ByVal .pvData + i * 4, ByVal .pvData + j * 4)
            Case 8:     Call Helper.Swap8(ByVal .pvData + i * 8, ByVal .pvData + j * 8)
            Case 2:     Call Helper.Swap2(ByVal .pvData + i * 2, ByVal .pvData + j * 2)
            Case 16:    Call Helper.Swap16(ByVal .pvData + i * 16, ByVal .pvData + j * 16)
            Case 1:     Call Helper.Swap1(ByVal .pvData + i, ByVal .pvData + j)
            Case Else
                ' primarily for UDTs
                Call CopyMemory(ByVal Items.Buffer, ByVal .pvData + i * .cbElements, .cbElements)
                Call CopyMemory(ByVal .pvData + i * .cbElements, ByVal .pvData + j * .cbElements, .cbElements)
                Call CopyMemory(ByVal .pvData + j * .cbElements, ByVal Items.Buffer, .cbElements)
        End Select
    End With
End Sub
Public Sub QuickSortLong(ByRef Keys() As Long, ByVal Left As Long, ByVal Right As Long)
    Dim i As Long, j As Long, x As Long, t As Long
    Do While Left < Right
        i = Left: j = Right: x = Keys((i + j) \ 2)
        Do
            Do While Keys(i) < x: i = i + 1: Loop
            Do While Keys(j) > x: j = j - 1: Loop
            If i > j Then Exit Do
            If i < j Then t = Keys(i): Keys(i) = Keys(j): Keys(j) = t: If mHasSortItems Then Call SwapSortItems(mSortItems, i, j)
            i = i + 1: j = j - 1
        Loop While i <= j
        If j - Left <= Right - i Then
            If Left < j Then Call QuickSortLong(Keys, Left, j)
            Left = i
        Else
            If i < Right Then Call QuickSortLong(Keys, i, Right)
            Right = j
        End If
    Loop
End Sub
Public Sub QuickSortString(ByRef Keys() As String, ByVal Left As Long, ByVal Right As Long)
    Dim i As Long, j As Long, x As String
    Do While Left < Right
        i = Left: j = Right: x = StringRef(Keys((i + j) \ 2))
        Do
            Do While Keys(i) < x: i = i + 1: Loop
            Do While Keys(j) > x: j = j - 1: Loop
            If i > j Then Exit Do
            If i < j Then Call Helper.Swap4(Keys(i), Keys(j)): If mHasSortItems Then Call SwapSortItems(mSortItems, i, j)
            i = i + 1: j = j - 1
        Loop While i <= j
        If j - Left <= Right - i Then
            If Left < j Then Call QuickSortString(Keys, Left, j)
            Left = i
        Else
            If i < Right Then Call QuickSortString(Keys, i, Right)
            Right = j
        End If
        StringPtr(x) = 0
    Loop
End Sub
Public Sub QuickSortObject(ByRef Keys() As Object, ByVal Left As Long, ByVal Right As Long)
    Dim i As Long, j As Long, x As Variant, Key As IComparable
    Do While Left < Right
        i = Left: j = Right: Set x = Keys((i + j) \ 2)
        Do
            Set Key = Keys(i): Do While Key.CompareTo(x) < 0: i = i + 1: Set Key = Keys(i): Loop
            Set Key = Keys(j): Do While Key.CompareTo(x) > 0: j = j - 1: Set Key = Keys(j): Loop
            If i > j Then Exit Do
            If i < j Then Call Helper.Swap4(Keys(i), Keys(j)): If mHasSortItems Then Call SwapSortItems(mSortItems, i, j)
            i = i + 1: j = j - 1
        Loop While i <= j
        If j - Left <= Right - i Then
            If Left < j Then Call QuickSortObject(Keys, Left, j)
            Left = i
        Else
            If i < Right Then Call QuickSortObject(Keys, i, Right)
            Right = j
        End If
    Loop
End Sub
Public Sub QuickSortInteger(ByRef Keys() As Integer, ByVal Left As Long, ByVal Right As Long)
    Dim i As Long, j As Long, x As Integer, t As Integer
    Do While Left < Right
        i = Left: j = Right: x = Keys((i + j) \ 2)
        Do
            Do While Keys(i) < x: i = i + 1: Loop
            Do While Keys(j) > x: j = j - 1: Loop
            If i > j Then Exit Do
            If i < j Then t = Keys(i): Keys(i) = Keys(j): Keys(j) = t: If mHasSortItems Then Call SwapSortItems(mSortItems, i, j)
            i = i + 1: j = j - 1
        Loop While i <= j
        If j - Left <= Right - i Then
            If Left < j Then Call QuickSortInteger(Keys, Left, j)
            Left = i
        Else
            If i < Right Then Call QuickSortInteger(Keys, i, Right)
            Right = j
        End If
    Loop
End Sub
Public Sub QuickSortByte(ByRef Keys() As Byte, ByVal Left As Long, ByVal Right As Long)
    Dim i As Long, j As Long, x As Byte, t As Byte
    Do While Left < Right
        i = Left: j = Right: x = Keys((i + j) \ 2)
        Do
            Do While Keys(i) < x: i = i + 1: Loop
            Do While Keys(j) > x: j = j - 1: Loop
            If i > j Then Exit Do
            If i < j Then t = Keys(i): Keys(i) = Keys(j): Keys(j) = t: If mHasSortItems Then Call SwapSortItems(mSortItems, i, j)
            i = i + 1: j = j - 1
        Loop While i <= j
        If j - Left <= Right - i Then
            If Left < j Then Call QuickSortByte(Keys, Left, j)
            Left = i
        Else
            If i < Right Then Call QuickSortByte(Keys, i, Right)
            Right = j
        End If
    Loop
End Sub
Public Sub QuickSortDouble(ByRef Keys() As Double, ByVal Left As Long, ByVal Right As Long)
    Dim i As Long, j As Long, x As Double, t As Double
    Do While Left < Right
        i = Left: j = Right: x = Keys((i + j) \ 2)
        Do
            Do While Keys(i) < x: i = i + 1: Loop
            Do While Keys(j) > x: j = j - 1: Loop
            If i > j Then Exit Do
            If i < j Then t = Keys(i): Keys(i) = Keys(j): Keys(j) = t: If mHasSortItems Then Call SwapSortItems(mSortItems, i, j)
            i = i + 1: j = j - 1
        Loop While i <= j
        If j - Left <= Right - i Then
            If Left < j Then Call QuickSortDouble(Keys, Left, j)
            Left = i
        Else
            If i < Right Then Call QuickSortDouble(Keys, i, Right)
            Right = j
        End If
    Loop
End Sub
Public Sub QuickSortSingle(ByRef Keys() As Single, ByVal Left As Long, ByVal Right As Long)
    Dim i As Long, j As Long, x As Single, t As Single
    Do While Left < Right
        i = Left: j = Right: x = Keys((i + j) \ 2)
        Do
            Do While Keys(i) < x: i = i + 1: Loop
            Do While Keys(j) > x: j = j - 1: Loop
            If i > j Then Exit Do
            If i < j Then t = Keys(i): Keys(i) = Keys(j): Keys(j) = t: If mHasSortItems Then Call SwapSortItems(mSortItems, i, j)
            i = i + 1: j = j - 1
        Loop While i <= j
        If j - Left <= Right - i Then
            If Left < j Then Call QuickSortSingle(Keys, Left, j)
            Left = i
        Else
            If i < Right Then Call QuickSortSingle(Keys, i, Right)
            Right = j
        End If
    Loop
End Sub
Public Sub QuickSortCurrency(ByRef Keys() As Currency, ByVal Left As Long, ByVal Right As Long)
    Dim i As Long, j As Long, x As Currency, t As Currency
    Do While Left < Right
        i = Left: j = Right: x = Keys((i + j) \ 2)
        Do
            Do While Keys(i) < x: i = i + 1: Loop
            Do While Keys(j) > x: j = j - 1: Loop
            If i > j Then Exit Do
            If i < j Then t = Keys(i): Keys(i) = Keys(j): Keys(j) = t: If mHasSortItems Then Call SwapSortItems(mSortItems, i, j)
            i = i + 1: j = j - 1
        Loop While i <= j
        If j - Left <= Right - i Then
            If Left < j Then Call QuickSortCurrency(Keys, Left, j)
            Left = i
        Else
            If i < Right Then Call QuickSortCurrency(Keys, i, Right)
            Right = j
        End If
    Loop
End Sub
Public Sub QuickSortBoolean(ByRef Keys() As Boolean, ByVal Left As Long, ByVal Right As Long)
    Dim i As Long, j As Long, x As Boolean, t As Boolean
    Do While Left < Right
        i = Left: j = Right: x = Keys((i + j) \ 2)
        Do
            Do While Keys(i) < x: i = i + 1: Loop
            Do While Keys(j) > x: j = j - 1: Loop
            If i > j Then Exit Do
            If i < j Then t = Keys(i): Keys(i) = Keys(j): Keys(j) = t: If mHasSortItems Then Call SwapSortItems(mSortItems, i, j)
            i = i + 1: j = j - 1
        Loop While i <= j
        If j - Left <= Right - i Then
            If Left < j Then Call QuickSortBoolean(Keys, Left, j)
            Left = i
        Else
            If i < Right Then Call QuickSortBoolean(Keys, i, Right)
            Right = j
        End If
    Loop
End Sub
Public Sub QuickSortVariant(ByRef Keys() As Variant, ByVal Left As Long, ByVal Right As Long)
    Dim i As Long, j As Long, x As Variant
    Do While Left < Right
        i = Left: j = Right: Call VariantCopyInd(x, Keys((i + j) \ 2))
        Do
            Do While CompareVariants(Keys(i), x) < 0: i = i + 1: Loop
            Do While CompareVariants(Keys(j), x) > 0: j = j - 1: Loop
            If i > j Then Exit Do
            If i < j Then Call Helper.Swap16(Keys(i), Keys(j)): If mHasSortItems Then Call SwapSortItems(mSortItems, i, j)
            i = i + 1: j = j - 1
        Loop While i <= j
        If j - Left <= Right - i Then
            If Left < j Then Call QuickSortVariant(Keys, Left, j)
            Left = i
        Else
            If i < Right Then Call QuickSortVariant(Keys, i, Right)
            Right = j
        End If
    Loop
End Sub
Public Sub QuickSortGeneral(ByRef Keys As Variant, ByVal Left As Long, ByVal Right As Long)
    Dim i As Long, j As Long, x As Variant
    Do While Left < Right
        i = Left: j = Right: Call VariantCopyInd(x, Keys((i + j) \ 2))
        Do
            Do While SortComparer.Compare(Keys(i), x) < 0: i = i + 1: Loop
            Do While SortComparer.Compare(Keys(j), x) > 0: j = j - 1: Loop
            If i > j Then Exit Do
            If i < j Then SwapSortItems mSortKeys, i, j: If mHasSortItems Then Call SwapSortItems(mSortItems, i, j)
            i = i + 1: j = j - 1
        Loop While i <= j
        If j - Left <= Right - i Then
            If Left < j Then Call QuickSortGeneral(Keys, Left, j)
            Left = i
        Else
            If i < Right Then Call QuickSortGeneral(Keys, i, Right)
            Right = j
        End If
    Loop
End Sub