📄 formb41d.frm
字号:
Frame2.Visible = False
Command3.Caption = "返 回"
Command3.Enabled = True
End Sub
Private Sub P_ww32() ' 无种子 32 位
Zm = Log(bytWs) / Log(2) ' Zm: 抽签轮数
Select Case strYz
Case "0"
Label3 = "随机分布 ..."
Case "1"
Label3 = "按序号分布 ..."
Case "2"
Label3 = "参照种子方式分布 ..."
Case "3"
Label3 = "均匀分布 ..."
Case "4"
Label3 = "同队选手分在相同的半区 ..."
End Select
StrMsg = StrMsg & "抽签排位"
Label3 = Zm & " 轮 " & StrMsg
If MsgBox(" 开始" & StrMsg & " ... ", 33, " 请确认 ") <> 1 Then Exit Sub
Select Case strYz
Case "0"
Call P_m320 ' 随机分布
Case "1"
Call P_w321 ' 按序号分布
Case "2"
Call P_w322 ' 参照种子方式分布
Case "3"
Call P_m322 ' 均匀分布
Case "4"
Call P_w324 ' 同队选手分在相同的半区
End Select
End Sub
Private Sub P_w320() ' 随机分布
Call P_mzfb
ReDim arrCq(bytRs), arrWz(bytRs)
For i = 1 To bytRs
arrCq(i) = arrWh(i) ' 待按排序号
arrWz(i) = i
Next
m = bytRs
For i = 1 To bytRs
l = F_ranu(m) ' 随机抽出一代号
s = arrWz(l)
n = F_ranu(m) ' 随机抽出一空位
k = arrCq(n)
With MSFlexGrid1
.Row = k: .Col = 2: ' arrxh(k, 2)=s
.Text = s & " ": .CellBackColor = intCy1
End With
m = m - 1
For k = n To m ' 调整抽签空位数组
arrCq(k) = arrCq(k + 1)
Next
For k = l To m ' 调整代号数组
arrWz(k) = arrWz(k + 1)
Next
Next
Command2.Enabled = True
End Sub
Function F_ranu(X As Byte) As Byte ' 从 1 - x 中随机取一整数
Randomize
F_ranu = IIf(X = 1, 1, Int(X * Rnd()) + 1)
End Function
Private Sub P_mzfb() ' 默认种子分布
Dim w As Byte, m As Byte, n As Byte
ReDim arrWh(bytWs)
arrWh(1) = 1
arrWh(bytWs) = 2 ' 位号
Zm = Log(bytWs) / Log(2) ' Zm: 抽签轮数
For i = 1 To Zm - 1
Zn = 2 ^ i ' Zn: 每轮抽签数
Zp = Zn ' Zp: 每轮小区数
Zq = bytWs / Zp ' Zq: 小区容量
ReDim arrCq(Zn)
For j = 1 To Zn
arrCq(j) = j + Zn ' 待按排序号
Next
For j = 1 To Zn
w = (j - 1) * Zq + IIf(j Mod 2 = 1, Zq, 1) ' 待按排位号
n = (j - 1) * Zq + IIf(j Mod 2 = 1, 1, Zq)
m = arrWh(n) ' 某区已有种子号
arrWh(w) = arrCq(Zn + 1 - m)
Next
StrMsg = StrMsg & " " & vbCrLf ' 每轮空位号
Next
End Sub
Private Sub P_w321() ' 按序号分布
Call P_mzfb
For i = 1 To bytRs
MSFlexGrid1.TextMatrix(arrWh(i), 2) = i & " "
Next
Command2.Enabled = True
End Sub
Private Sub P_w322() ' 参照种子方式分布
With MSFlexGrid1
.Col = 2: arrZz(1, 2) = 1
.Row = 1: .Text = "1 ": .CellBackColor = intCy1
arrZz(bytZs, 2) = 2:
.Row = bytWs: .Text = "2 ": .CellBackColor = intCy1
Label3 = "1、2 号选手分别安排在上半区顶部和下半区底部"
For i = 1 To Zm - 1 ' i: 抽签轮次
Zn = 2 ^ i ' Zn: 每轮抽签数
Zp = Zn ' Zp: 每轮小区数
Zq = bytWs / Zn ' Zq: 小区容量
For j = 1 To Zp
For k = 1 To Zq
.TextMatrix(k + (j - 1) * Zq, 1) = j & "/" & Zp & " "
Next
Next
ReDim arrCq(Zn) ' 抽签空位数组
StrMsg = ""
Zx = 0: k = 1
For j = 1 To Zp / 2
Zy = Zx + Zq: arrCq(k) = Zy
arrCq(k + 1) = Zy + 1
k = k + 2: Zx = Zx + 2 * Zq
StrMsg = StrMsg & Zy & "," & Zy + 1 & ","
Next
Call P_lksz ' 处理轮空 & 抽签数 k
strKwh = "空位号: " & StrMsg
StrSQL = "抽签号: " & Zn + 1 & " ～ " & Zn + k
StrMsg = StrSQL & vbCrLf & vbCrLf & strKwh & " " & vbCrLf & vbCrLf & " 抽签选位 ... "
If MsgBox(StrMsg, 1 + 32 + 0, " 请确认 ") <> 1 Then Exit Sub
Command2.Enabled = True
m = k
For j = Zn + 1 To Zn + k ' j: 抽签号
n = F_ranu(m)
arrZz(j, 2) = arrCq(n) ' 随机抽出一个空位
.Row = Val(arrZz(j, 2)): .Col = 2
.Text = j & " ": .CellBackColor = intCy1
m = m - 1
For k = n To m ' 调整抽签空位数组
arrCq(k) = arrCq(k + 1)
Next
Next
Label3 = i + 1 & ": " & Zn + 1 & " ～ " & 2 * Zn & " 号抽签完毕 ..."
Next
End With
Label3 = "抽签全部完成 ..."
strKwh = ""
Command4.Enabled = False
End Sub
Private Sub P_w323() ' 同队选手分在不同的半区
End Sub
Private Sub P_w324() ' 同队选手分在相同的半区
End Sub
Private Sub P_lksz() ' 处理轮空 & 抽签数 k
With MSFlexGrid1
n = bytRs - Zn ' n: 尚未抽签人数
If n >= Zn Then
For j = 1 To Zp
.Row = arrCq(j): .Col = 2: .CellBackColor = intCx1
StrMsg = StrMsg & arrCq(j) & ","
Next
k = Zn ' k: 抽签数
Else
n = bytWs - bytRs ' n; 轮空位数
For j = 1 To .Rows - 1
m = Val(.TextMatrix(j, 2))
If m > 0 And m <= n Then
m = .TextMatrix(j, 0)
m = m + IIf(m Mod 2 = 1, 1, -1)
For k = 1 To Zn
If Val(arrCq(k)) = m Then arrCq(k) = "": Exit For
Next
End If
Next
k = 0
For j = 1 To Zp
If arrCq(j) <> "" Then ' 累计抽签数 k
k = k + 1: arrCq(k) = arrCq(j)
.Row = arrCq(j): .Col = 2: .CellBackColor = intCx1
StrMsg = StrMsg & arrCq(j) & ","
End If
Next
End If
End With
End Sub
Private Sub P_mmzz() ' 有种子
With MSFlexGrid1
arrZz(1, 2) = 1
arrBg(1, 0) = 1
arrBg(1, 1) = arrZm(1, 1) ' Yh
arrBg(1, 2) = arrZm(1, 2) ' Ym
arrBg(1, 3) = arrZm(1, 3) ' Hm
arrBg(1, 4) = arrZm(1, 4) ' Dh
arrBg(1, 5) = F_fhdw(arrZm(1, 4))
.Row = 1: .Col = 2: .Text = "1 ": .CellBackColor = intCy1
.Col = 3: .Text = " " & arrBg(1, 2): .CellBackColor = intCy1
.Col = 4: .Text = " " & arrBg(1, 3): .CellBackColor = intCy1
.Col = 5: .Text = " " & arrBg(1, 5): .CellBackColor = intCy1
arrZz(bytZs, 2) = 2: k = bytWs
arrBg(k, 0) = 2
arrBg(k, 1) = arrZm(2, 1)
arrBg(k, 2) = arrZm(2, 2)
arrBg(k, 3) = arrZm(2, 3)
arrBg(k, 4) = arrZm(2, 4)
arrBg(k, 5) = F_fhdw(arrZm(2, 4))
.Row = k: .Col = 2: .Text = "2 ": .CellBackColor = intCy1
.Col = 3: .Text = " " & arrBg(k, 2): .CellBackColor = intCy1
.Col = 4: .Text = " " & arrBg(k, 3): .CellBackColor = intCy1
.Col = 5: .Text = " " & arrBg(k, 5): .CellBackColor = intCy1
.Visible = True
Label3 = "1、2 号种子分别安排在上半区顶部和下半区底部"
For i = 1 To Zm - 1 ' i: 抽签轮次
Zn = 2 ^ i ' Zn: 每轮抽签数
Zp = Zn ' Zp: 每轮小区数
Zq = bytWs / Zn ' Zq: 小区容量
For j = 1 To Zp
For k = 1 To Zq
.TextMatrix(k + (j - 1) * Zq, 1) = j & "/" & Zp & " "
Next
Next
ReDim arrCq(Zn) ' 抽签空位数组
StrMsg = ""
Zx = 0: k = 1
For j = 1 To Zp / 2
Zy = Zx + Zq: arrCq(k) = Zy
arrCq(k + 1) = Zy + 1
k = k + 2: Zx = Zx + 2 * Zq
.Row = Zy: .Col = 2: .CellBackColor = intCx1
.Row = Zy + 1: .Col = 2: .CellBackColor = intCx1
StrMsg = StrMsg & Zy & "," & Zy + 1 & ","
Next
strKwh = "空位号 " & StrMsg
StrSQL = "抽签种子号: " & Zn + 1 & " ～ " & 2 * Zn
StrMsg = StrSQL & vbCrLf & vbCrLf & strKwh & " " & vbCrLf & vbCrLf & " 抽签选位 ... "
' If MsgBox(StrMsg, 1 + 32 + 0, " 请确认 ") <> 1 Then Exit Sub
Command2.Enabled = True
m = Zn
For j = Zn + 1 To 2 * Zn ' j: 抽签种子号
n = F_ranu(m)
arrZz(j, 2) = arrCq(n) ' 随机抽出一个空位
k = arrZz(j, 2)
arrBg(k, 0) = j
arrBg(k, 1) = arrZm(j, 1)
arrBg(k, 2) = arrZm(j, 2)
arrBg(k, 3) = arrZm(j, 3)
arrBg(k, 4) = arrZm(j, 4)
arrBg(k, 5) = F_fhdw(arrZm(j, 4))
.Row = k
.Col = 2: .Text = j & " ": .CellBackColor = intCy1
.Col = 3: .Text = " " & arrBg(k, 2): .CellBackColor = intCy1
.Col = 4: .Text = " " & arrBg(k, 3): .CellBackColor = intCy1
.Col = 5: .Text = " " & arrBg(k, 5): .CellBackColor = intCy1
m = m - 1
For k = n To m ' 调整抽签空位数组
arrCq(k) = arrCq(k + 1)
Next
Next
Label3 = Zn + 1 & " ～ " & 2 * Zn & " 号种子抽签完毕 ..."
Next
' If MsgBox(" 种子抽签完毕，非种子继续抽签 ... ", 1 + 32 + 0, " 请确认 ") <> 1 Then Exit Sub
Label3 = "种子抽签完毕 ..."
bytRo1 = 1
End With
With MSFlexGrid3 ' 显示种子的位号
.Clear
.Rows = bytZs + 1
.Cols = 6
.Height = 225 * IIf(bytZs > 16, 17, bytZs + 1) + 90 ' 16
.Width = 4980
.Top = 600
.Row = 0: .Col = 0: .Text = " 位号": .ColWidth(0) = 620
.Col = 1: .Text = " 区号": .ColWidth(1) = 620
.Col = 2: .Text = "种子号": .ColWidth(2) = 620
.Col = 3: .Text = " 姓 名 ": .ColWidth(3) = 1000
.Col = 4: .Text = " 号码 ": .ColWidth(4) = 620
.Col = 5: .Text = " 代 表 队": .ColWidth(5) = 1400 - IIf(bytZs > 16, 270, 0)
.MergeCol(1) = True
.MergeCells = flexMergeRestrictColumns ' 单元格合并
.Visible = True
Label2 = "种子： " & bytZs
Label2.Top = .Top - 300
Label2.Left = .Left + 200
End With
k = 0
With MSFlexGrid1
For i = 1 To .Rows - 1
If .TextMatrix(i, 3) <> "" Then
k = k + 1
For j = 0 To .Cols - 1
s = .TextMatrix(i, j)
MSFlexGrid3.TextMatrix(k, j) = s ' MSFlexGrid3 显示种子
Next
End If
Next
End With
Command3.Enabled = True
Command3.SetFocus
' call P_xxxx
strKwh = ""
Command4.Enabled = False
End Sub
Function F_fhdw(Dh As String) As String ' 返回队名
Dim i As Byte, m As String
For i = 1 To bytDs
If Trim(arrDw(i, 1)) = Trim(Dh) Then
m = arrDw(i, 2): Exit For
End If
Next
F_fhdw = m
End Function
Function F_fhym(yh As String) As String ' 返回人名
Dim i As Byte, m As String
For i = 1 To bytRs
If Trim(arrYm(i, 1)) = Trim(yh) Then
m = arrYm(i, 2): Exit For
End If
Next
F_fhym = m
End Function
Private Sub Command5_Click() ' 选定非种子抽签原则
Frame1.Visible = False
For i = 0 To 3
If Option1(i).Value Then
strYz = i: Exit For
End If
Next
Label4 = ""
Select Case strYz
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -