📄 formb4.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form FormB4
BackColor = &H00C0C0FF&
Caption = " 分组与抽签 "
ClientHeight = 5535
ClientLeft = 60
ClientTop = 345
ClientWidth = 6675
DrawStyle = 1 'Dash
LinkTopic = "FormA3"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5535
ScaleWidth = 6675
StartUpPosition = 2 '屏幕中心
Visible = 0 'False
Begin VB.Frame Frame1
BackColor = &H00C0C0FF&
BorderStyle = 0 'None
Caption = "Frame1"
Height = 855
Left = 840
TabIndex = 4
Top = 2640
Width = 5055
Begin VB.OptionButton Option1
Caption = "大循环"
Height = 375
Index = 2
Left = 3720
TabIndex = 7
Top = 240
Width = 1095
End
Begin VB.OptionButton Option1
Caption = "分组循环"
Height = 375
Index = 1
Left = 2520
TabIndex = 6
Top = 240
Value = -1 'True
Width = 1215
End
Begin VB.OptionButton Option1
Caption = "淘汰"
Height = 375
Index = 0
Left = 1680
TabIndex = 5
Top = 240
Width = 855
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请选择赛制："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 210
Left = 120
TabIndex = 8
Top = 240
Width = 1365
End
End
Begin VB.CommandButton Command3
BackColor = &H00C0C0FF&
Caption = "退 出"
Height = 375
Left = 2280
TabIndex = 1
Top = 4440
Width = 1095
End
Begin VB.CommandButton Command1
BackColor = &H00C0C0FF&
Caption = "确 认"
Enabled = 0 'False
Height = 375
Left = 3480
TabIndex = 0
Top = 4440
Width = 1095
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 1215
Left = 840
TabIndex = 3
Top = 1080
Width = 5040
_ExtentX = 8890
_ExtentY = 2143
_Version = 393216
BackColor = 16777088
GridColor = 12582912
GridColorFixed = 16711680
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请选择项目："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 210
Left = 960
TabIndex = 2
Top = 600
Width = 1365
End
End
Attribute VB_Name = "FormB4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
' ┃ FormB3 分组与抽签 ┃
' ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
Const intCx1 = &HC0E0FF, intCy1 = &HFFFF80
Dim bytRow As Byte, strSz As String, arrPm()
Dim strGh As String, strGm As String ' 分组名和代号
Dim strPh As String, strPm As String, bytPs As Byte ' 项目名和代号
Dim bytZs As Byte, bytDs As Byte, bytRs As Byte
Dim blnTt As Boolean
'
Private Sub Form_Load()
'BlnGf = False
BlnTc = False
If myF_ConnT(Db_fN2) = False Then Unload Me: Exit Sub ' 连接库 T ' 打开数据库 2
StrT0 = "T_gm" ' 分组表 T_gm
StrT1 = "T_pm" ' 项目表 T_pm
StrT3 = "T_dw" ' 单位表 T_dw
StrT4 = "T_md" ' 登记表 T_md
StrT5 = "T_bm" ' 报名表 T_bm
If myF_ChekTRec(StrT1) < 1 Then BlnTc = True: Exit Sub
If myF_ChekTRec(StrT3) < 1 Then BlnTc = True: Exit Sub
If myF_ChekTRec(StrT4) < 1 Then BlnTc = True: Exit Sub
If myF_ChekTRec(StrT5) < 1 Then BlnTc = True: Exit Sub
If BlnGf = True Then
If myF_ChekTRec(StrT0) < 1 Then ' 检查 T_gm 记录
BlnTc = True: Exit Sub
Else
Set MyRs1 = New Recordset
StrSQL = "SELECT " & StrT1 & ".Ph," & StrT1 & ".Pm," & StrT1 & ".Gh," & StrT0 & ".Gm," & StrT1 & ".Zs," & StrT1 & ".Ds," & StrT1 & ".Rs" & _
" FROM " & StrT0 & "," & StrT1 & _
" WHERE " & StrT0 & ".Gh=" & StrT1 & ".Gh" & _
" ORDER BY " & StrT1 & ".Xh"
MyRs1.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
bytPs = MyRs1.RecordCount
ReDim arrPm(bytPs, 6) ' 项目数 bytPs
With MSFlexGrid1
.Rows = bytPs + 1
.Cols = 5
.Width = 4950 + IIf(bytPs > 8, 270, 0)
.Height = 225 * IIf(.Rows - 1 > 8, 9, .Rows) + 90
.Left = (Me.Width - .Width) / 2
.Row = 0: .Col = 0: .Text = " 序号": .ColWidth(0) = 620
.Col = 1: .Text = " 组别": .ColWidth(1) = 950
.Col = 2: .Text = " 项目名称": .ColWidth(2) = 1500
.Col = 3: .Text = " 队(人)数": .ColWidth(3) = 960
.Col = 4: .Text = " 种子数": .ColWidth(4) = 820
MyRs1.MoveFirst
For i = 1 To bytPs
arrPm(i, 0) = MyRs1![ph]
arrPm(i, 1) = MyRs1![Pm]
arrPm(i, 2) = MyRs1![Gh]
arrPm(i, 3) = MyRs1![Gm]
arrPm(i, 4) = MyRs1![ds]
arrPm(i, 5) = MyRs1![Rs]
arrPm(i, 6) = MyRs1![zs]
.Row = i: .Col = 0: .Text = i & " "
.Col = 1: .Text = " " & arrPm(i, 3)
.Col = 2: .Text = " " & arrPm(i, 1)
n = IIf(arrPm(i, 1) Like "*团体*", arrPm(i, 4), arrPm(i, 5))
.Col = 3: .Text = n & " "
.Col = 4: .Text = arrPm(i, 6) & " "
MyRs1.MoveNext
Next
.MergeCol(1) = True ' 单元格合并
.MergeCells = flexMergeRestrictColumns
.Visible = True
Frame1.Top = .Top + .Height + 180
End With
End If
Else
Set MyRs1 = New Recordset
StrSQL = "SELECT * FROM " & StrT1 & " ORDER BY Xh"
MyRs1.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
bytPs = MyRs1.RecordCount
ReDim arrPm(bytPs, 6)
With MSFlexGrid1
.Rows = bytPs + 1
.Cols = 4
.Width = 4300 + IIf(bytPs > 8, 270, 0)
.Height = 225 * IIf(.Rows - 1 > 8, 9, .Rows) + 90
.Left = (Me.Width - .Width) / 2
.Row = 0: .Col = 0: .Text = " 序号": .ColWidth(0) = 620
.Col = 1: .Text = " 项目名称": .ColWidth(1) = 1800
.Col = 2: .Text = " 队(人)数": .ColWidth(2) = 960
.Col = 3: .Text = " 种子数": .ColWidth(3) = 820
MyRs1.MoveFirst
For i = 1 To bytPs
arrPm(i, 0) = MyRs1![ph]
arrPm(i, 1) = MyRs1![Pm]
arrPm(i, 4) = MyRs1![ds]
arrPm(i, 5) = MyRs1![Rs]
arrPm(i, 6) = MyRs1![zs]
.Row = i: .Col = 0: .Text = i & " "
.Col = 1: .Text = " " & arrPm(i, 1)
n = IIf(arrPm(i, 1) Like "*团体*", arrPm(i, 4), arrPm(i, 5))
.Col = 2: .Text = n & " "
.Col = 3: .Text = arrPm(i, 6) & " "
MyRs1.MoveNext
Next
Frame1.Top = .Top + .Height + 180
End With
End If
strGh = " "
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
End Sub
Private Sub Form_Activate()
If BlnTc = True Then Unload Me: Exit Sub
bytRow = 1
End Sub
Private Sub MSFlexGrid1_Click()
With MSFlexGrid1
n = .Row
.Row = bytRow
For j = 1 To .Cols - 1
.Col = j: .CellBackColor = intCy1
Next
strPh = arrPm(n, 0)
strPm = arrPm(n, 1)
strGh = arrPm(n, 2)
strGm = arrPm(n, 3)
bytDs = arrPm(n, 4)
bytRs = arrPm(n, 5)
bytZs = arrPm(n, 6)
bytRow = n
.Row = n
For j = 1 To .Cols - 1
.Col = j: .CellBackColor = intCx1
Next
.Col = 2: Command1.Enabled = IIf(Val(.Text) = 0, False, True)
End With
blnTt = IIf(strPm Like "*团*", True, False)
' Option1(0).Visible = IIf(bytZs < 1, True, False)
End Sub
Private Sub Command1_Click() ' 修改&确认处理
If Option1(0).Value Then
strSz = "0"
Else
strSz = IIf(Option1(1).Value, "1", "2")
End If
StrPa1 = strGh ' 传递参数
StrPa2 = strPh
StrPa3 = bytZs
If blnTt Then
Select Case strSz
Case "0"
FormB41t.Show ' 淘汰
Case "1"
FormB42t.Show ' 分组循环
Case "2"
FormB43t.Show ' 大循环
End Select
Else
Select Case strSz
Case "0"
FormB41d.Show ' 淘汰
Case "1"
FormB42d.Show ' 分组循环
Case "2"
FormB43d.Show ' 大循环
End Select
End If
End Sub
Private Sub Command3_Click() ' 退出
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer) ' 结束
On Error Resume Next
MyRs0.Close: Set MyRs0 = Nothing ' 关闭记录集，释放对象
MyRs1.Close: Set MyRs1 = Nothing
MyDb2.Close: Set MyDb2 = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -