📄 form8.frm
字号:
VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form 项目定义
Caption = "定义比赛项目"
ClientHeight = 3480
ClientLeft = 60
ClientTop = 450
ClientWidth = 4785
LinkTopic = "Form8"
MaxButton = 0 'False
ScaleHeight = 3480
ScaleWidth = 4785
StartUpPosition = 3 '窗口缺省
Begin TabDlg.SSTab SSTab1
Height = 3495
Left = 0
TabIndex = 0
Top = 0
Width = 4815
_ExtentX = 8493
_ExtentY = 6165
_Version = 393216
Tabs = 2
TabsPerRow = 2
TabHeight = 520
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TabCaption(0) = "项目定义"
TabPicture(0) = "Form8.frx":0000
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "Label3"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).Control(1)= "Label2"
Tab(0).Control(1).Enabled= 0 'False
Tab(0).Control(2)= "Label5"
Tab(0).Control(2).Enabled= 0 'False
Tab(0).Control(3)= "Text2"
Tab(0).Control(3).Enabled= 0 'False
Tab(0).Control(4)= "Command1"
Tab(0).Control(4).Enabled= 0 'False
Tab(0).Control(5)= "Command2"
Tab(0).Control(5).Enabled= 0 'False
Tab(0).Control(6)= "Combo1"
Tab(0).Control(6).Enabled= 0 'False
Tab(0).Control(7)= "Combo3"
Tab(0).Control(7).Enabled= 0 'False
Tab(0).ControlCount= 8
TabCaption(1) = "全能定义"
TabPicture(1) = "Form8.frx":001C
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "Label4"
Tab(1).Control(1)= "Label1"
Tab(1).Control(2)= "Command4"
Tab(1).Control(3)= "Combo2"
Tab(1).Control(4)= "List1"
Tab(1).Control(5)= "Command3"
Tab(1).Control(6)= "Text1"
Tab(1).ControlCount= 7
Begin VB.ComboBox Combo3
Height = 300
ItemData = "Form8.frx":0038
Left = 1440
List = "Form8.frx":0042
Style = 2 'Dropdown List
TabIndex = 15
Top = 2400
Width = 1335
End
Begin VB.TextBox Text1
Height = 375
Left = -74760
TabIndex = 12
Top = 1560
Width = 1335
End
Begin VB.CommandButton Command3
Caption = "=>"
Height = 495
Left = -73320
TabIndex = 11
Top = 1440
Width = 735
End
Begin VB.ListBox List1
Height = 1680
Left = -72480
TabIndex = 10
Top = 960
Width = 1695
End
Begin VB.ComboBox Combo2
Height = 300
Left = -72960
Style = 2 'Dropdown List
TabIndex = 9
Top = 480
Width = 1455
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "Form8.frx":0056
Left = 1440
List = "Form8.frx":0063
Style = 2 'Dropdown List
TabIndex = 8
Top = 1800
Width = 1335
End
Begin VB.CommandButton Command4
Caption = "删除"
Height = 495
Left = -72240
TabIndex = 7
Top = 2760
Width = 975
End
Begin VB.CommandButton Command2
Caption = "删除"
Height = 495
Left = 3480
TabIndex = 3
Top = 1800
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "添加"
Height = 495
Left = 3480
TabIndex = 2
Top = 960
Width = 1095
End
Begin VB.TextBox Text2
Height = 375
Left = 1440
TabIndex = 1
Top = 960
Width = 1335
End
Begin VB.Label Label5
Caption = "跑道分类"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 14
Top = 2400
Width = 855
End
Begin VB.Label Label1
Caption = "加入项目"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = -74520
TabIndex = 13
Top = 1200
Width = 855
End
Begin VB.Label Label4
Caption = "全能名称"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = -74160
TabIndex = 6
Top = 480
Width = 855
End
Begin VB.Label Label2
Caption = "项目名称"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 5
Top = 1080
Width = 855
End
Begin VB.Label Label3
Caption = "项目类型"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 4
Top = 1800
Width = 855
End
End
End
Attribute VB_Name = "项目定义"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset, rs1 As ADODB.Recordset
Private Sub Combo2_Click()
strsql3 = "select count(*) from " & Combo2.Text & ""
strsql4 = "select 项目名称 from " & Combo2.Text & ""
Set rs1 = cnn.Execute(strsql3)
Set rs2 = cnn.Execute(strsql4)
For i = 0 To rs1.Fields(0) - 1
List1.List(i) = rs2.Fields(0)
rs2.MoveNext
Next
End Sub
Private Sub Command2_Click()
If Text2.Text = "" Then
MsgBox "请先输入项目或编号", vbOKOnly + vbExclamation, "提示"
Else
strsql = "select * from 运动项目名单 where 项目名称='" & Text2.Text & "'"
Set rs = cnn.Execute(strsql)
If rs.EOF = True Then
MsgBox "该库中没有此项目！", vbOKOnly, "提示"
Text1.Text = ""
Text2.Text = ""
Else
strsql2 = "delete * from 运动项目名单 where 项目名称='" & Text2.Text & "'"
cnn.Execute (strsql2)
MsgBox "该项目已删除！", vbOKOnly, "提示"
Text1.Text = ""
Text2.Text = ""
End If
End If
End Sub
Private Sub Command3_Click()
If Text1.Text = "" Then
MsgBox "请先输入项目", vbOKOnly + vbExclamation, "提示"
Else
strsql11 = "insert into " & Combo2.Text & " values('" & Text1.Text & "')"
cnn.Execute (strsql11)
Text1.Text = ""
strsql3 = "select count(*) from " & Combo2.Text & ""
strsql4 = "select 项目名称 from " & Combo2.Text & ""
Set rs1 = cnn.Execute(strsql3)
Set rs2 = cnn.Execute(strsql4)
For i = 0 To rs1.Fields(0) - 1
List1.List(i) = rs2.Fields(0)
rs2.MoveNext
Next
End If
End Sub
Private Sub Command4_Click()
strsql12 = "delete * from " & Combo2.Text & " where 项目名称='" & List1.Text & "'"
cnn.Execute (strsql12)
List1.RemoveItem List1.ListIndex
Text1.Text = ""
strsql3 = "select count(*) from " & Combo2.Text & ""
strsql4 = "select 项目名称 from " & Combo2.Text & ""
Set rs1 = cnn.Execute(strsql3)
Set rs2 = cnn.Execute(strsql4)
For i = 0 To rs1.Fields(0) - 1
List1.List(i) = rs2.Fields(0)
rs2.MoveNext
Next
End Sub
Private Sub Form_Load()
Dim mypath As String
Dim i As Integer
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set rs1 = New ADODB.Recordset
mypath = App.Path & "/data" '获取当前路径
If Right(mypath, 1) <> "/" Then mypath = mypath + "/"
cnn.Open "Data Source=" & mypath & "db1.mdb" & ";Provider=Microsoft.Jet.OLEDB.4.0 " '连接并打开数据库
strsql1 = "select count(*) from 运动项目名单 where 项目类型='全能项目'"
strsql2 = "select 项目名称 from 运动项目名单 where 项目类型='全能项目'"
Set rs1 = cnn.Execute(strsql1)
Set rs2 = cnn.Execute(strsql2)
For i = 0 To rs1.Fields(0) - 1
Combo2.List(i) = rs2.Fields(0)
rs2.MoveNext
Next
End Sub
Private Sub Command1_Click()
If Text2.Text = "" Then
MsgBox "请先输入项目或编号", vbOKOnly + vbExclamation, "提示"
Else
strsql = "select * from 运动项目名单 where 项目名称='" & Text2.Text & "'"
Set rs = cnn.Execute(strsql)
If rs.EOF = True Then '该项目暂时在库中不存在，可以入库
If Combo1.Text = "全能项目" Then
strsql1 = "insert into 运动项目名单(项目名称,项目类型) values('" + Text2.Text + "','" + Combo1.Text + "')"
strsql2 = "create table " & Text2.Text & "(项目名称 char(20))"
strsql3 = "create table " & Text2.Text & "成绩(姓名 char(20),项目名称 char(20),成绩 char(10))"
cnn.Execute (strsql1)
cnn.Execute (strsql2)
cnn.Execute (strsql3)
MsgBox "该项目已经添加成功！", vbOKOnly, "提示"
Text2.Text = ""
Else
strsql11 = "insert into 运动项目名单 values('" + Text2.Text + "','" + Combo1.Text + "','" & Combo3.Text & "')"
cnn.Execute (strsql11)
MsgBox "该项目已经添加成功！", vbOKOnly, "提示"
Text2.Text = ""
End If
Else
MsgBox "您输入的该项目已经存在于库中！", vbOKOnly, "提示"
Text2.Text = ""
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -