📄 formb41d.frm
字号:
_ExtentY = 4471
_Version = 393216
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid2
Height = 2535
Left = 4200
TabIndex = 33
Top = 240
Visible = 0 'False
Width = 1935
_ExtentX = 3413
_ExtentY = 4471
_Version = 393216
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid3
Height = 2535
Left = 7080
TabIndex = 39
Top = 840
Visible = 0 'False
Width = 3375
_ExtentX = 5953
_ExtentY = 4471
_Version = 393216
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid4
Height = 2055
Left = 6960
TabIndex = 40
Top = 5040
Visible = 0 'False
Width = 3495
_ExtentX = 6165
_ExtentY = 3625
_Version = 393216
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "64"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 180
Left = 5760
TabIndex = 32
Top = 7080
Width = 225
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "预选赛"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 180
Left = 7320
TabIndex = 23
Top = 4680
Visible = 0 'False
Width = 600
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "1/2"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 180
Left = 5640
TabIndex = 2
Top = 7560
Width = 330
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "抽签种子"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 180
Left = 1200
TabIndex = 1
Top = 7920
Width = 795
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "空位号"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 180
Left = 7080
TabIndex = 0
Top = 480
Width = 600
End
End
Attribute VB_Name = "FormB41d"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' ┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
' ┃ FormB41d 淘汰赛排位抽签(单项) ┃
' ┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
Const intCy0 = &HFFFFFF, intCy1 = &HC0E0FF, intCx1 = &HC040FF ' 4 - 128 人
Dim bytRo1 As Byte, bytRo2 As Byte, bytRo3 As Byte, bytRo4 As Byte
Dim strYh As String, strY1 As String, strY2 As String
Dim arrDw() As String, bytDs As Byte, arrDs(), arrBg() As String
Dim arrWz() As String, bytWs As Byte, arrCq() As String, arrWh() As String
Dim arrZz() As String, bytZs As Byte, blnZz As Boolean, arrKq(), arrXs() As String
Dim arrYm() As String, bytRs As Byte, blnCq As Boolean
Dim arrYx() As String, bytYs As Byte, blnYx As Boolean, blnLk As Boolean
Dim arrZm() As String, bytWm As Byte, zs As Byte
Dim arrFz() As String, bytFs As Byte, strYz As String
Dim Zm As Byte, Zn As Byte, Zp As Byte, Zq As Byte, Zx As Byte, Zy As Byte, Zg As Byte
Dim strTm As String
Dim strDw As String
Dim strGh As String, strGm As String ' 分组名和代号
Dim strPh As String, strPm As String ' 项目名和代号
Dim strTj1 As String, strTj2 As String, strTj3 As String
Dim strKwh As String
Dim bytLc As Byte, r As Integer, w As Integer, h As Integer
Dim ds As Integer, ps As Integer
Dim Rn As Integer, arrRh() As Byte
Dim qn As Integer, arrQh() As Byte, q As Byte
Dim Wn As Integer ', arrWh() As Byte
Dim Wh() As Byte
Dim intRy2, intRw2, intRoh As Integer
Dim intRok, intRop As Integer, blnPx, blnJh As Boolean
Dim arrGm(), arrYdg(), arrFg()
Dim arrWs(), Gs() As Integer, Rm() As String
Dim strZcy As String
Dim Rs As Integer, Gn As Integer
Dim strZcm, strBwm, strFsg As String, blnTh As Boolean
Dim y0 As Integer, yu As Integer, yd As Integer, yy As Integer
'
Private Sub Form_Load()
If myF_ConnT(Db_fN2) = False Then Unload Me: Exit Sub ' 连接库 T ' 打开数据库 2
StrT0 = "T_gm" ' 分组表 T_gm MyRs0
StrT1 = "T_pm" ' 项目表 T_pm MyRs1
StrT2 = "T_zz"
StrT3 = "T_dw" ' 单位表 T_dw MyRs2
StrT4 = "T_md" ' 登记表 T_md MyRs4
StrT5 = "T_bm" ' 报名表 T_bm MyRs3
bytRo1 = 1
bytRo2 = 1
bytRo3 = 1
bytRo4 = 1
Label2 = ""
Label4 = ""
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
End Sub
Private Sub Form_Activate()
If BlnTc = True Then Unload Me: Exit Sub
strGh = StrPa1 ' "Gm003" '
strPh = StrPa2 ' "Pm004" '
StrSQL = "Select * From " & StrT2 & " Where Gh='" & strGh & "' And Ph='" & strPh & "'"
Set MyRs1 = New Recordset
MyRs1.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
If MyRs1.EOF = True And MyRs1.BOF = True Then
bytZs = 0 ' 空表
Else
bytZs = MyRs1.RecordCount ' 返回记录数
End If
'bytZs = 0
blnZz = IIf(bytZs < 1, False, True)
BlnGf = IIf(strGh = "", False, True)
If BlnGf Then
Set MyRs1 = New Recordset
StrSQL = "SELECT " & StrT1 & ".Pm," & StrT0 & ".Gm," & _
StrT1 & ".Ds," & StrT1 & ".Rs," & StrT1 & ".Zs" & _
" FROM " & StrT0 & "," & StrT1 & _
" WHERE " & StrT0 & ".Gh=" & StrT1 & ".Gh " & _
" And " & StrT1 & ".Gh='" & strGh & "' And " & StrT1 & ".Ph='" & strPh & "'"
MyRs1.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
N1 = MyRs1.RecordCount
If N1 > 0 Then
strGm = MyRs1![Gm]
strPm = MyRs1![Pm]
bytDs = MyRs1![ds]
bytRs = MyRs1![Rs]
bytZs = MyRs1![zs]
Else
MsgBox " ", 48, " Error"
Unload Me: Exit Sub
End If
Else
Set MyRs1 = New Recordset
StrSQL = "SELECT * FROM " & StrT1 & " WHERE Ph='" & strPh & "'"
MyRs1.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
N1 = MyRs1.RecordCount
If N1 > 0 Then
strGm = ""
strPm = MyRs1![Pm]
bytDs = MyRs1![ds]
bytRs = MyRs1![Rs]
bytZs = MyRs1![zs]
Else
MsgBox " ", 48, " Error"
Unload Me: Exit Sub
End If
End If
Me.Caption = " " & srtGm & " " & strPm & Me.Caption
'bytZs = 0
Set MyRsT = New Recordset ' T_dw T_bm 表
StrSQL = "Select Distinct " & StrT3 & ".Xh," & StrT3 & ".Dh," & StrT3 & ".Dw" & _
" From " & StrT3 & "," & StrT5 & _
" Where " & StrT3 & ".Dh=" & StrT5 & ".Dh" & _
" And " & StrT5 & ".Gh='" & strGh & "' And " & StrT5 & ".Ph='" & strPh & "'" & _
" Order By " & StrT3 & ".Dh"
MyRsT.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
bytDs = MyRsT.RecordCount ' 队数
ReDim arrDw(bytDs, 3), arrDs(bytDs, 3)
For i = 1 To bytDs
arrDw(i, 1) = MyRsT![Dh]
arrDw(i, 2) = MyRsT![Dw]
MyRsT.MoveNext
Next
MyRsT.Close
Set MyRsT = New Recordset ' T_bm 表
StrSQL = "Select Dh,Count(*) As Rn" & _
" From " & StrT5 & _
" Where Gh='" & strGh & "' And Ph='" & strPh & "'" & _
" Group By Dh Order By Dh"
MyRsT.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
If MyRsT.RecordCount <> bytDs Then
MsgBox " ??? !!! ", 48, " Error"
Exit Sub
End If
bytDs = MyRsT.RecordCount ' 队数
For i = 1 To bytDs
arrDw(i, 3) = MyRsT![Rn] ' 每队人数
MyRsT.MoveNext
Next
MyRsT.Close
strTj1 = IIf(BlnGf = True, "And Gh='" & strGh & "'", "")
Set MyRs3 = New Recordset ' T_bm 表
StrSQL = "SELECT a.Yh,a.Dh,b.Hm,b.Ym " & _
" FROM T_bm a,T_md b,T_dw c " & _
" WHERE a.Dh=b.Dh And a.Dh=c.Dh " & _
" And a.Gh ='" & strGh & "' And a.Ph ='" & strPh & "'" & _
" Order By c.Xh,a.Dh,a.Yh" ' ?????
StrSQL = "Select Distinct " & StrT4 & ".Xh," & StrT4 & ".Yh," & StrT4 & ".Ym," & StrT4 & ".Hm," & StrT4 & ".Dh" & _
" From " & StrT4 & "," & StrT5 & _
" Where " & StrT4 & ".Yh=" & StrT5 & ".Yh" & _
" And " & StrT5 & ".Gh='" & strGh & "' And " & StrT5 & ".Ph='" & strPh & "'" & _
" Order By " & StrT4 & ".Dh," & StrT4 & ".Xh"
MyRs3.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
bytRs = MyRs3.RecordCount ' bytRs: 人数
If bytRs > 0 Then
MyRs3.MoveLast
N3 = MyRs3.RecordCount
ReDim arrYm(bytRs, 5)
MyRs3.MoveFirst
For i = 1 To bytRs ' arrYm() 运动员数组
arrYm(i, 1) = MyRs3![yh]
arrYm(i, 2) = MyRs3![Ym]
arrYm(i, 3) = MyRs3![Hm]
arrYm(i, 4) = MyRs3![Dh]
arrYm(i, 5) = ""
MyRs3.MoveNext
Next
MyRs3.Close
Else
MsgBox " ??? ", 48, " Error": Exit Sub
End If
bytWm = 0 ' bytWm: 默认位数
For i = 1 To 100
If 2 ^ i >= bytRs Then: bytWm = 2 ^ i: Exit For
Next
Text1 = " " & bytRs
Text2 = " " & bytWm
Label3 = ""
Label10 = ""
If bytRs = m Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -