Visual Basic 跳蚤算法模块

Attribute VB_Name = "modFleaRandom"
'FleaRandom Module
'KiteGirl 2005

Public Sub FleaRandom(ByRef pList() As Long, Optional ByVal pSet_Scan As Boolean = False, Optional ByVal pSet_Swap As Boolean = False, Optional ByVal pScan_Start As Long = 0, Optional ByVal pScan_End As Long = 0, Optional ByVal pSwap_Start As Long = 0, Optional pSwap_End As Long = 0)
'FleaRandom函数
'语法：FleaRandom(pList() ,[pSet_Scan,] [pSet_Swap,] [pScan_Start,] [pScan_End,] [pSwap_Start,] [pSwap_End] )
'说明：以“跳蚤算法”对序列进行乱序处理。
'参数： long pList() 必要参数。作为序列容器的数组。
' boolean pSet_Scan 可选参数。扫描域设置开关。使其为true则用户设置的扫描域参数有效。
' boolean pSet_Swap 可选参数。交换域设置开关。使其为true则用户设置的交换域参数有效。
' long pScan_Start 可选参数。扫描域开始。
' long pScan_End 可选参数。扫描域结束。
' long pSwap_Start 可选参数。交换域开始。
' long pSwap_End 可选参数。交换域结束。
'说明：序列初始状态可以有序地储存在该数组当中。
' 虽然序列本身可以适合某些应用，但单一的long类型不能满足更多需要。
' 更多场合则以long类型的序列作为某个其他类型数组的索引，这样可以获得更丰富的应用。
' 交换区的绝对长度，也就是Abs(pSwap_End-pSwap_Start)不能超过2^31。

'

'交换设置导入

Dim tSwap_Start As Long '交换域开始
Dim tSwap_End As Long '交换域结束

If pSet_Swap Then
  tSwap_Start = pSwap_Start
  tSwap_End = pSwap_End
Else
  tSwap_Start = LBound(pList())
  tSwap_End = UBound(pList())
End If

'交换范围

Dim tSwap_Count As Long '交换域元素数

tSwap_Count = (tSwap_End - tSwap_Start) + 1

'交换补偿

Dim tSwap_Rep As Long '交换补偿

tSwap_Rep = tSwap_Start

'扫描设置导入

Dim tScan_Start As Long '扫描开始
Dim tScan_End As Long '扫描结束

If pSet_Scan Then
  tScan_Start = pScan_Start
  tScan_End = pScan_End
ElseIf (Not pSet_Scan) And pSet_Swap Then
  tScan_Start = tSwap_Start
  tScan_End = tSwap_End
Else
  tScan_Start = LBound(pList())
  tScan_End = UBound(pList())
End If

'序列扰乱

Dim tList_Index As Long '序列索引

Dim tList_Index_Sur As Long '序列索引_源
Dim tList_Index_Des As Long '序列索引_目的

For tList_Index = tScan_Start To tScan_End

tList_Index_Sur = tList_Index
tList_Index_Des = Int(Rnd * tSwap_Count) + tSwap_Rep

'交换pList(tList_Index_Sur)和pList(tList_Index_Des)

FleaRandom_ValueSwap pList(tList_Index_Sur), pList(tList_Index_Des)

Next

End Sub

Private Sub FleaRandom_ValueSwap(ByRef pA As Long, ByRef pB As Long)
'FleaRandom_ValueSwap过程
'语法：FleaRandom_ValueSwap pA, pB
'说明：以“跳蚤算法”对序列进行乱序处理。

Dim tTemp As Long

tTemp = pA: pA = pB: pB = tTemp

End Sub