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