M
mei7810
Unregistered / Unconfirmed
GUEST, unregistred user!
能把下面的代码转换为delphi吗??vb源码!
Dim nClSl As Integer '车辆数量
Dim cJlMc As String '教练列表
Dim nii As Integer '临时变量
Dim cDot As String '临时变量
Dim nDotX As Integer '判断教练列表中有几个 , 号
Me.List1.Clear '存放显示最后结果
cJlMc = Trim(Me.Text2.Text)
cJlMc = Replace(cJlMc, ",", ","
For nii = 1 To Len(cJlMc)
cDot = Mid(cJlMc, nii, 1)
If cDot = ","
Then
nDotX = nDotX + 1
End If
Next nii
If nDotX = 0 Then '无教练返回
Call MsgBox("无教练返回"
Exit Sub
End If
nDotX = nDotX + 1
Dim aJlList() As String '存放教练的数组
Dim aDhWz() As String '存放,位置的数组
nDotX = 0
For nii = 1 To Len(cJlMc)
cDot = Mid(cJlMc, nii, 1)
If cDot = ","
Then
nDotX = nDotX + 1
ReDim Preserve aDhWz(nDotX)
aDhWz(nDotX) = nii
End If
Next nii
nDotX = UBound(aDhWz)
ReDim Preserve aJlList(nDotX + 1) '教练数组内容
For nii = 1 To nDotX
Select Case nii
Case 1
aJlList(nii) = Mid(cJlMc, 1, Val(aDhWz(nii)) - 1)
Case Else
aJlList(nii) = Mid(cJlMc, Val(aDhWz(nii - 1)) + 1, Val(aDhWz(nii)) - Val(aDhWz(nii - 1)) - 1)
End Select
Next nii
aJlList(nDotX + 1) = Mid(cJlMc, Val(aDhWz(nDotX)) + 1)
Dim aJlZtList() As String '存放教练状态
Dim cCCC As String '存放教练的变量
For nii = 1 To UBound(aJlList)
cCCC = cCCC &
aJlList(nii)
Next nii
'重新形成教练顺序
Dim nAdd As Integer
Dim nRnd As Integer
nAdd = 0
Dim nJJJ As Integer
nJJJ = 0
Do While cCCC <> ""
Randomize
nRnd = Int((UBound(aJlList) * Rnd) + 1) '在教练数目范围内的数据
If nRnd >= 1 And nRnd <= UBound(aJlList) Then
If aJlList(nRnd) <> ""
Then
nAdd = nAdd + 1
ReDim Preserve aJlZtList(nAdd)
aJlZtList(nAdd) = aJlList(nRnd)
aJlList(nRnd) = ""
End If
End If
cCCC = ""
nJJJ = 0
For nii = 1 To UBound(aJlList)
If aJlList(nii) = ""
Then
nJJJ = nJJJ + 1
End If
cCCC = cCCC &
aJlList(nii)
Next nii
If UBound(aJlList) - UBound(aJlZtList) = 1 Then '最后一个
nAdd = UBound(aJlZtList) + 1
ReDim Preserve aJlZtList(nAdd)
aJlZtList(nAdd) = cCCC
Exit Do
End If
Loop
nClSl = Val(Me.Text1.Text) '一车几个人
If nClSl = 0 Then
nClSl = 2
End If
For nii = 1 To UBound(aJlZtList)
If Int(nii / nClSl) <> (nii / nClSl) Then '分组
Me.List1.AddItem Trim(aJlZtList(nii)) &
"
"
&
Int(nii / nClSl) + 1
Else
Me.List1.AddItem Trim(aJlZtList(nii)) &
"
"
&
Int(nii / nClSl)
End If
Next nii
Dim nClSl As Integer '车辆数量
Dim cJlMc As String '教练列表
Dim nii As Integer '临时变量
Dim cDot As String '临时变量
Dim nDotX As Integer '判断教练列表中有几个 , 号
Me.List1.Clear '存放显示最后结果
cJlMc = Trim(Me.Text2.Text)
cJlMc = Replace(cJlMc, ",", ","
For nii = 1 To Len(cJlMc)
cDot = Mid(cJlMc, nii, 1)
If cDot = ","
Then
nDotX = nDotX + 1
End If
Next nii
If nDotX = 0 Then '无教练返回
Call MsgBox("无教练返回"
Exit Sub
End If
nDotX = nDotX + 1
Dim aJlList() As String '存放教练的数组
Dim aDhWz() As String '存放,位置的数组
nDotX = 0
For nii = 1 To Len(cJlMc)
cDot = Mid(cJlMc, nii, 1)
If cDot = ","
Then
nDotX = nDotX + 1
ReDim Preserve aDhWz(nDotX)
aDhWz(nDotX) = nii
End If
Next nii
nDotX = UBound(aDhWz)
ReDim Preserve aJlList(nDotX + 1) '教练数组内容
For nii = 1 To nDotX
Select Case nii
Case 1
aJlList(nii) = Mid(cJlMc, 1, Val(aDhWz(nii)) - 1)
Case Else
aJlList(nii) = Mid(cJlMc, Val(aDhWz(nii - 1)) + 1, Val(aDhWz(nii)) - Val(aDhWz(nii - 1)) - 1)
End Select
Next nii
aJlList(nDotX + 1) = Mid(cJlMc, Val(aDhWz(nDotX)) + 1)
Dim aJlZtList() As String '存放教练状态
Dim cCCC As String '存放教练的变量
For nii = 1 To UBound(aJlList)
cCCC = cCCC &
aJlList(nii)
Next nii
'重新形成教练顺序
Dim nAdd As Integer
Dim nRnd As Integer
nAdd = 0
Dim nJJJ As Integer
nJJJ = 0
Do While cCCC <> ""
Randomize
nRnd = Int((UBound(aJlList) * Rnd) + 1) '在教练数目范围内的数据
If nRnd >= 1 And nRnd <= UBound(aJlList) Then
If aJlList(nRnd) <> ""
Then
nAdd = nAdd + 1
ReDim Preserve aJlZtList(nAdd)
aJlZtList(nAdd) = aJlList(nRnd)
aJlList(nRnd) = ""
End If
End If
cCCC = ""
nJJJ = 0
For nii = 1 To UBound(aJlList)
If aJlList(nii) = ""
Then
nJJJ = nJJJ + 1
End If
cCCC = cCCC &
aJlList(nii)
Next nii
If UBound(aJlList) - UBound(aJlZtList) = 1 Then '最后一个
nAdd = UBound(aJlZtList) + 1
ReDim Preserve aJlZtList(nAdd)
aJlZtList(nAdd) = cCCC
Exit Do
End If
Loop
nClSl = Val(Me.Text1.Text) '一车几个人
If nClSl = 0 Then
nClSl = 2
End If
For nii = 1 To UBound(aJlZtList)
If Int(nii / nClSl) <> (nii / nClSl) Then '分组
Me.List1.AddItem Trim(aJlZtList(nii)) &
"
"
&
Int(nii / nClSl) + 1
Else
Me.List1.AddItem Trim(aJlZtList(nii)) &
"
"
&
Int(nii / nClSl)
End If
Next nii