?? formb41d.frm
字號:
Case "0"
Call P_m320 ' 隨機分布
Case "1"
Call P_m321 ' 按序號分布
Case "2"
Call P_m322 ' 均勻分布
Case "3"
Call P_m323 ' 同隊選手分在相同的半區
End Select
Label3 = "全部抽簽完畢 ..."
Command3.Caption = "返 回"
Command3.Enabled = True
Command4.Enabled = True
End Sub
Private Sub Command6_Click() ' 放棄
Frame1.Visible = False
MSFlexGrid3.Visible = True
Command3.Caption = "繼 續"
Command3.Enabled = True
Label2 = "種子： " & bytZs
End Sub
Private Sub P_m320() ' 非種子隨機抽簽
Label4 = ""
Do While True
Call P_m3201
If F_cqjc Then Exit Do ' 檢查
Loop
End Sub
Private Sub P_m3201() ' 非種子抽簽 隨機
Dim d As Byte, w As Byte, v As Byte, u As Byte
w = 0
ReDim arrWz(bytWs) ' 抽簽空位數組
With MSFlexGrid1
For i = 1 To .Rows - 1
If .TextMatrix(i, 3) = "" Then
w = w + 1 ' w: 空位數
arrWz(w) = i
End If
Next
d = bytDs
For i = 1 To bytDs
n = F_ranu(d)
strDh = arrDs(n, 1) ' 隨機抽出一隊
strDw = arrDs(n, 2)
ReDim arrCq(arrDs(n, 3), 4)
m = 0 ' m: 某隊待抽簽非種子數
For j = 1 To bytFs
If arrFz(j, 4) = strDh Then
m = m + 1
arrCq(m, 1) = arrFz(j, 1) ' 待抽簽非種子數組
arrCq(m, 2) = arrFz(j, 2)
arrCq(m, 3) = arrFz(j, 3)
arrCq(m, 4) = arrFz(j, 4)
End If
Next
u = m
For j = 1 To m
p = F_ranu(u) ' 隨機抽出一個非種子
v = F_ranu(w) ' 隨機抽出一個空位
.Row = arrWz(v)
.Col = 3: .Text = " " & arrCq(p, 2): .CellBackColor = intCy1
.Col = 4: .Text = " " & arrCq(p, 3): .CellBackColor = intCy1
.Col = 5: .Text = " " & F_fhdw(arrCq(p, 4)): .CellBackColor = intCy1
w = w - 1
For k = v To w ' 調整空位數組
arrWz(k) = arrWz(k + 1)
Next
u = u - 1
For k = p To u ' 調整非種子數組
arrCq(k, 1) = arrCq(k + 1, 1)
arrCq(k, 2) = arrCq(k + 1, 2)
arrCq(k, 3) = arrCq(k + 1, 3)
arrCq(k, 4) = arrCq(k + 1, 4)
Next
Next
d = d - 1
For j = n To d ' 調整隊名數組
arrDs(j, 1) = arrDs(j + 1, 1)
arrDs(j, 2) = arrDs(j + 1, 2)
arrDs(j, 3) = arrDs(j + 1, 3)
Next
Next
Label3 = StrSQL & "全部抽簽完畢 ..."
End With
End Sub
Private Sub P_m321() ' 非種子按序號分布
With MSFlexGrid1
k = 0
For i = 1 To .Rows - 1
If Trim(.TextMatrix(i, 3)) = "" Then
k = k + 1
.TextMatrix(i, 3) = " " & arrFz(k, 2)
.TextMatrix(i, 4) = " " & arrFz(k, 3)
.TextMatrix(i, 5) = " " & F_fhdw(arrFz(k, 4))
End If
Next
End With
End Sub
Private Sub P_m323() ' 非種子 相同半區
End Sub
Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer) ' 選中一個項目
If KeyAscii = 13 Then Call MSFlexGrid1_Click
End Sub
Private Sub MSFlexGrid1_Click() ' 選中一行
If Not Command3.Caption Like "*回*" Then Exit Sub
ReDim arrXs(10, 5)
With MSFlexGrid1
n = 0: strDw = Trim(.TextMatrix(.Row, 5))
For i = 1 To .Rows - 1
.Row = i
If strDw = Trim(.TextMatrix(i, 5)) Then
n = n + 1 ' 人數
For j = 0 To 5
.Col = j: If j > 1 Then .CellBackColor = intCy1 ' 設置顏色
arrXs(n, j) = .Text
Next
Else
If .CellBackColor <> &HFFFFFF Then ' 原色
For j = 2 To 5
.Col = j: .CellBackColor = intCy0 ' 顏色復原
Next
End If
End If
Next
k = .Row
.Row = bytRo1
bytRo1 = k
.Row = k
.Col = 1: c = Trim(.Text)
l = Len(c): For i = 1 To l
s = Mid(c, i, 1)
If s = "/" Then
v = i: Exit For
End If
Next
m = Val(Mid(c, v + 1, l - v)) ' m: 小區數
End With
If blnYx Then ' 有預選
Label2 = ""
With MSFlexGrid3 ' 顯示某隊選手的位號
.Clear
.Cols = 5
.Width = 3570
.Top = 1200
.Left = 7000
.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
.MergeCol(1) = True
.MergeCells = flexMergeRestrictColumns ' 單元格合并
.Visible = True
Label2 = "代表隊： " & strDw
Label2.Top = .Top - 400
Label2.Left = .Left
End With
Else ' 無預選
With MSFlexGrid4
.Clear ' 顯示某隊選手的位號
.Cols = 5
.Width = 3850
.Top = 5200
.Left = 6600
.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) = 900
.MergeCol(1) = True
.MergeCells = flexMergeRestrictColumns ' 單元格合并
.Visible = True
Label9 = "代表隊： " & strDw
Label9.Top = .Top - 400
Label9.Left = .Left
.Visible = True
End With
End If
If blnZz Then ' 顯示某隊選手的位號
Call P_aaa
Else
Call P_bbb
End If
MSFlexGrid2.Visible = False
Label4 = ""
Label10 = IIf(bytWs = 64, "64", "")
Frame4.Visible = True
End Sub
Private Sub P_aaa() ' 顯示某隊 有種子
If blnYx Then ' 有預選
Label2 = ""
With MSFlexGrid3 ' 顯示某隊選手的位號
.Rows = m + 1
.Height = 225 * (m + 1) + 90
w = 1
For i = 1 To n
For k = w To .Rows - 1
If Trim(arrXs(i, 1)) = Trim(.TextMatrix(k, 1)) Then
For j = 0 To 4
.TextMatrix(k, j) = arrXs(i, j)
Next
w = k + 1
Else
.TextMatrix(k, 0) = ""
End If
Next
Next
For i = 1 To .Rows - 1
k = Int((i + 1) / 2)
.TextMatrix(i, 0) = Trim(.TextMatrix(i, 0)) & " "
.TextMatrix(i, 1) = k & "/4 "
n = bytWs / m
If .TextMatrix(i, 3) = "" Then
.TextMatrix(i, 0) = IIf(i Mod 2 = 1, n * (i - 1) + 1, n * i) & " "
End If
Next
.MergeCol(1) = True
.MergeCells = flexMergeRestrictColumns ' 單元格合并
End With
Else ' 無預選
With MSFlexGrid4
.Rows = m + 1 ' 顯示某隊選手的位號
.Height = 225 * IIf(m > 8, 9, m + 1) + 90
.Width = 3850
.Top = 5200
.Left = 6600
w = bytWs / m
For i = 1 To m
.TextMatrix(i, 0) = w * (i - 1) + 1
.TextMatrix(i, 1) = i & "/" & m
Next
.Row = 0: .Col = 4: .Text = " 號碼 ": .ColWidth(4) = 900 - IIf(m > 8, 270, 0)
w = 1
For i = 1 To n
For k = w To .Rows - 1
If Trim(arrXs(i, 1)) = Trim(.TextMatrix(k, 1)) Then
For j = 0 To 4
.TextMatrix(k, j) = arrXs(i, j)
Next
w = k + 1
Else
.TextMatrix(k, 0) = ""
End If
Next
Next
For i = 1 To .Rows - 1
k = Int((i + 1) / 2)
.TextMatrix(i, 0) = Trim(.TextMatrix(i, 0)) & " "
.TextMatrix(i, 1) = k & "/4 "
n = bytWs / m
If .TextMatrix(i, 3) = "" Then
.TextMatrix(i, 0) = IIf(i Mod 2 = 1, n * (i - 1) + 1, n * i) & " "
End If
Next
.MergeCol(1) = True
.MergeCells = flexMergeRestrictColumns ' 單元格合并
.Visible = True
Label9 = "代表隊： " & strDw
Label9.Top = .Top - 400
Label9.Left = .Left
.Visible = True
End With
If blnZz Then ' 查種子
With MSFlexGrid3
.Row = bytRo3
For j = 3 To .Cols - 1
.Col = j: .CellBackColor = intCx0 ' 原色
Next
For i = 1 To .Rows - 1
.Row = i: .Col = 5
If strDw = Trim(.Text) Then
For j = 3 To 5
.Col = j: .CellBackColor = intCy1 ' 顏色
Next
bytRo3 = i: Exit For
End If
Next
End With
End If
End If
End Sub
Private Sub P_bbb() ' 顯示某隊 無種子
If blnYx Then ' 有預選
Label2 = ""
With MSFlexGrid3 ' 顯示某隊選手的位號
.Rows = n + 1
.Height = 225 * (n + 1) + 90
For i = 1 To n
For j = 0 To 4
.TextMatrix(i, j) = arrXs(i, j)
Next
Next
.MergeCol(1) = True
.MergeCells = flexMergeRestrictColumns ' 單元格合并
End With
With MSFlexGrid4 ' 查預選
.Row = bytRo4
For j = 3 To .Cols - 1
.Col = j: .CellBackColor = intCx0 ' 原色
Next
For i = 1 To .Rows - 1
.Row = i: .Col = 5
If strDw = Trim(.Text) Then
For j = 3 To 5
.Col = j: .CellBackColor = intCy1 ' 顏色
Next
bytRo4 = i: Exit For
End If
Next
End With
Else ' 無預選
With MSFlexGrid4
.Rows = n + 1 ' 顯示某隊選手的位號
.Height = 225 * IIf(n > 8, 9, n + 1) + 90
.Row = 0: .Col = 4: .Text = " 號碼 ": .ColWidth(4) = 900 - IIf(m > 8, 270, 0)
For i = 1 To n
For j = 0 To 4
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -