?? 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 + -