各位大侠,帮小弟解决一下问题!!!!!!!! ( 积分: 100 )

  • 主题发起人 主题发起人 mei7810
  • 开始时间 开始时间
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 = ",&quot
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 = ",&quot
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 &amp
aJlList(nii)
Next nii

'重新形成教练顺序
Dim nAdd As Integer
Dim nRnd As Integer
nAdd = 0
Dim nJJJ As Integer
nJJJ = 0
Do While cCCC <> &quot;&quot;
Randomize
nRnd = Int((UBound(aJlList) * Rnd) + 1) '在教练数目范围内的数据

If nRnd >= 1 And nRnd <= UBound(aJlList) Then
If aJlList(nRnd) <> &quot;&quot
Then
nAdd = nAdd + 1
ReDim Preserve aJlZtList(nAdd)
aJlZtList(nAdd) = aJlList(nRnd)
aJlList(nRnd) = &quot;&quot;
End If
End If
cCCC = &quot;&quot;
nJJJ = 0
For nii = 1 To UBound(aJlList)
If aJlList(nii) = &quot;&quot
Then
nJJJ = nJJJ + 1
End If
cCCC = cCCC &amp
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)) &amp
&quot
&quot
&amp
Int(nii / nClSl) + 1
Else
Me.List1.AddItem Trim(aJlZtList(nii)) &amp
&quot
&quot
&amp
Int(nii / nClSl)
End If
Next nii
 
能把下面的代码转换为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, &quot;,&quot;, &quot;,&quot;)


For nii = 1 To Len(cJlMc)
cDot = Mid(cJlMc, nii, 1)
If cDot = &quot;,&quot
Then
nDotX = nDotX + 1
End If
Next nii

If nDotX = 0 Then '无教练返回
Call MsgBox(&quot;无教练返回&quot;)
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 = &quot;,&quot
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 &amp
aJlList(nii)
Next nii

'重新形成教练顺序
Dim nAdd As Integer
Dim nRnd As Integer
nAdd = 0
Dim nJJJ As Integer
nJJJ = 0
Do While cCCC <> &quot;&quot;
Randomize
nRnd = Int((UBound(aJlList) * Rnd) + 1) '在教练数目范围内的数据

If nRnd >= 1 And nRnd <= UBound(aJlList) Then
If aJlList(nRnd) <> &quot;&quot
Then
nAdd = nAdd + 1
ReDim Preserve aJlZtList(nAdd)
aJlZtList(nAdd) = aJlList(nRnd)
aJlList(nRnd) = &quot;&quot;
End If
End If
cCCC = &quot;&quot;
nJJJ = 0
For nii = 1 To UBound(aJlList)
If aJlList(nii) = &quot;&quot
Then
nJJJ = nJJJ + 1
End If
cCCC = cCCC &amp
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)) &amp
&quot
&quot
&amp
Int(nii / nClSl) + 1
Else
Me.List1.AddItem Trim(aJlZtList(nii)) &amp
&quot
&quot
&amp
Int(nii / nClSl)
End If
Next nii
 
你还不如把你要做什么说一下的好啊!
 
一个动态数组,数组元素是每台车,然后每个元素随即1-X(X代表不定数量的监考~~)不知道这样可以吗?
 
是可以用数组,能用代码实现吗?
 
这是别人的VB代码,有人能改为delphi吗??
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, &quot;,&quot;, &quot;,&quot;)


For nii = 1 To Len(cJlMc)
cDot = Mid(cJlMc, nii, 1)
If cDot = &quot;,&quot
Then
nDotX = nDotX + 1
End If
Next nii

If nDotX = 0 Then '无教练返回
Call MsgBox(&quot;无教练返回&quot;)
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 = &quot;,&quot
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 &amp
aJlList(nii)
Next nii

'重新形成教练顺序
Dim nAdd As Integer
Dim nRnd As Integer
nAdd = 0
Dim nJJJ As Integer
nJJJ = 0
Do While cCCC <> &quot;&quot;
Randomize
nRnd = Int((UBound(aJlList) * Rnd) + 1) '在教练数目范围内的数据

If nRnd >= 1 And nRnd <= UBound(aJlList) Then
If aJlList(nRnd) <> &quot;&quot
Then
nAdd = nAdd + 1
ReDim Preserve aJlZtList(nAdd)
aJlZtList(nAdd) = aJlList(nRnd)
aJlList(nRnd) = &quot;&quot;
End If
End If
cCCC = &quot;&quot;
nJJJ = 0
For nii = 1 To UBound(aJlList)
If aJlList(nii) = &quot;&quot
Then
nJJJ = nJJJ + 1
End If
cCCC = cCCC &amp
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)) &amp
&quot
&quot
&amp
Int(nii / nClSl) + 1
Else
Me.List1.AddItem Trim(aJlZtList(nii)) &amp
&quot
&quot
&amp
Int(nii / nClSl)
End If
Next nii
 
这个分配不难的,给你个思路比代码好吧
两个数组, A[n]为监考人员数组,B[m]为车辆数组,
那么每个监考人员可能的车辆数应该为 k := (m div n)或者(m div n)+1辆,记r:=m mod n;
好,简单点,我们依次来给A[n]数组里的监考人员随机分配他们的车辆,
for i := 0 to n-1 do...

先随机生成次人可能分配到的车辆数 k + p
其中如果r>0那么p为0或者1的随机数否则p为0,如果p为1那么r--,
得到了这个需要分配的随机车辆数以后我们只要在B[m]里随机找出k+p辆车就可以
for j := 0 to k+p-1 do
。。。
 
很简单的:
var
Teachers: TStringList
// 教练列表
Cars: TStringList
// 车号列表
n, m: Integer;
begin
...
while Cars.Count > 0 do
begin
n := Random(Teachers.Count);
m := Random(Cars.Count);
Teachers.Strings[n] := Teachers.Strings[n] + ','+Cars.Strings[m];
Cars.Delete(m);
end;
...
end;
 
多人接受答案了。
 
后退
顶部