📄 frmscorein.frm
字号:
TabIndex = 22
Top = 2640
Width = 1095
End
Begin VB.Label Label5
BackColor = &H00FFFFFF&
Caption = "课程名称:"
Height = 255
Left = 120
TabIndex = 21
Top = 3120
Width = 975
End
Begin VB.Label label6
BackColor = &H00FFFFFF&
Caption = "学 年:"
Height = 255
Left = 120
TabIndex = 20
Top = 3600
Width = 1095
End
Begin VB.Label Label7
BackColor = &H00FFFFFF&
Caption = "重 修:"
Height = 255
Left = 2640
TabIndex = 19
Top = 3600
Width = 1095
End
Begin VB.Label Label8
BackColor = &H00FFFFFF&
Caption = "成 绩:"
Height = 255
Left = 120
TabIndex = 18
Top = 4080
Width = 1095
End
Begin VB.Label label9
BackColor = &H00FFFFFF&
Caption = "授课老师:"
Height = 255
Left = 2640
TabIndex = 17
Top = 2640
Width = 1215
End
Begin VB.Label Label10
BackColor = &H00FFFFFF&
Caption = "学 期:"
Height = 255
Left = 2640
TabIndex = 16
Top = 3120
Width = 1095
End
End
Attribute VB_Name = "frmscorein"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub add_Click()
'错误检测
On Error GoTo errMsg
If cobclass.Text = "" Then
MsgBox "班别不能为空,请核实!", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
If coblesson.Text = "" Then
MsgBox "课程不能为空,请核实!", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
'判断学号
If Trim(txtID.Text) = "" Then
MsgBox "学号不能为空,请核实!", vbOKOnly + vbExclamation, "系统提示"
txtID.SetFocus
Exit Sub
End If
'判断姓名
If Trim(txtname.Text) = "" Then
MsgBox "姓名不能为空,请核实!", vbOKOnly + vbExclamation, "系统提示"
txtname.SetFocus
Exit Sub
End If
'判断成绩
Dim SQL As String
SQL = "Select * From score Where 学号='" & Trim(txtID.Text) & "'"
SQL = SQL & " And " & " 课程='" & Trim(coblesson.Text) & "'"
SQL = SQL & " And " & " 学年='" & Trim(cobyear.Text) & "'"
SQL = SQL & " And " & " 学期='" & Trim(cobhalf.Text) & "'"
Set adoRS = adoCon.Execute(SQL)
If Not adoRS.EOF Then
MsgBox "编号为:" & Trim(txtID.Text) & "的学生的" & Trim(coblesson.Text) & "成绩已经存在!", vbOKOnly + vbExclamation, "系统提示"
txtID.SetFocus
Exit Sub
End If
'构造插入成绩表的Insert语句
SQL = ""
SQL = "exec scorein"
SQL = SQL & " @id='" & txtID.Text & "'"
SQL = SQL & " ,@name='" & txtname.Text & "'"
SQL = SQL & " ,@college='" & cobcollege.Text & "'"
SQL = SQL & " ,@sp='" & cobsp.Text & "'"
SQL = SQL & " ,@class='" & cobclass.Text & "'"
SQL = SQL & " ,@lesson='" & coblesson.Text & "'"
SQL = SQL & " ,@teacher='" & cobteacher.Text & "'"
SQL = SQL & " ,@reread='" & cobread.Text & "'"
SQL = SQL & " ,@year='" & cobyear.Text & "'"
SQL = SQL & " ,@half='" & cobhalf.Text & "'"
SQL = SQL & " ,@score='" & lalsum.Caption & "'"
'执行插入
adoCon.Execute (SQL)
lalsum.Caption = ""
coblesson.Text = ""
MsgBox "录入成功!", vbOKOnly + vbInformation, "成功提示"
txtID.SetFocus
add.Enabled = False
'错误处理
errMsg:
If Err.Number <> 0 Then
MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "出错提示"
Exit Sub
End If
End Sub
Private Sub cmdCancel_Click()
Unload Me
frmscore.Show
End Sub
Private Sub cmdQuit_Click()
Unload Me
End Sub
Private Sub cobcollege_Click()
'专业
SQL = ""
SQL = "select 专业 from Spcollege where 学院='" & Trim(cobcollege.Text) & "'"
Set adoRS = adoCon.Execute(SQL)
cobsp.Clear
Do While Not adoRS.EOF
cobsp.AddItem Trim(adoRS("专业"))
adoRS.MoveNext
Loop
cobsp.ListIndex = 0
End Sub
Private Sub cobsp_Click()
'班级
SQL = ""
SQL = "select 班级 from Spclass where 专业='" & cobsp.Text & "'"
Set adoRS = adoCon.Execute(SQL)
'cobclass.Clear
Do While Not adoRS.EOF
cobclass.AddItem Trim(adoRS("班级"))
adoRS.MoveNext
Loop
'lesson
SQL = ""
SQL = "select 课程 from Splesson where 专业='" & cobsp.Text & "'"
Set adoRS = adoCon.Execute(SQL)
coblesson.Clear
Do While Not adoRS.EOF
coblesson.AddItem Trim(adoRS("课程"))
adoRS.MoveNext
Loop
coblesson.ListIndex = 0
End Sub
Private Sub Command1_Click()
If UpDown1.Value + UpDown2.Value + UpDown3.Value <> 100 Then
MsgBox "各阶段所占比率出错,请检查!", vbOKOnly + vbCritical, "系统提示"
Exit Sub
End If
If Int(txtscore1.Text) > 100 Then
MsgBox "平时分高于100,请检查!", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
If Int(txtscore2.Text) > 100 Then
MsgBox "期中考分数高于100,请检查!", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
If Int(txtscore3.Text) > 100 Then
MsgBox "期末考分数高于100,请检查!", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
lalsum = Int(txtscore1.Text) * (UpDown1.Value / 100) + Int(txtscore2.Text) * (UpDown2.Value / 100) + Int(txtscore3.Text) * (UpDown3.Value / 100)
lalsum.FontSize = 12
add.Enabled = True
End Sub
Private Sub Form_Load()
Me.Height = 7080
Me.Width = 5220
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 600
ShockwaveFlash1.Movie = App.Path & "\flash\top.swf"
FillControl
fillRecord
End Sub
Private Sub FillControl()
txtscore1.Text = 0
txtscore2.Text = 0
txtscore3.Text = 0
With cobread
.Clear
.AddItem "否"
.AddItem "是"
.ListIndex = 0
End With
With cobyear
.Clear
For i = 1990 To 2020
.AddItem i & "年"
Next i
.ListIndex = 0
End With
With cobhalf
.Clear
.AddItem "上学期"
.AddItem "下学期"
.ListIndex = 0
End With
'学院
Set adoRS = adoCon.Execute("Select Name From College Order By Name")
cobcollege.Clear
Do While Not adoRS.EOF
cobcollege.AddItem Trim(adoRS("Name"))
adoRS.MoveNext
Loop
cobcollege.ListIndex = 0
'课程
'Set adoRS = adoCon.Execute("Select 课程名称 From Lesson Order By 课程名称")
'coblesson.Clear
'Do While Not adoRS.EOF
' coblesson.AddItem Trim(adoRS("课程名称"))
' adoRS.MoveNext
'Loop
'coblesson.ListIndex = 0
'教师
Set adoRS = adoCon.Execute("Select Name From Teacher Order By Name")
cobteacher.Clear
Do While Not adoRS.EOF
cobteacher.AddItem Trim(adoRS("Name"))
adoRS.MoveNext
Loop
cobteacher.ListIndex = 0
'lesson
SQL = ""
SQL = "select 课程 from Splesson where 专业='" & cobsp.Text & "'"
Set adoRS = adoCon.Execute(SQL)
coblesson.Clear
Do While Not adoRS.EOF
coblesson.AddItem Trim(adoRS("课程"))
adoRS.MoveNext
Loop
coblesson.ListIndex = 0
End Sub
Private Sub fillRecord()
Dim SQL As String
If frmscore.Option1.Value = True Then
SQL = "select * from student where ID='" & frmscore.sk & "'"
ElseIf frmscore.Option2.Value = True Then
SQL = "select * from student where Name='" & frmscore.sk & "'"
Else
SQL = "select * from student where ID='" & frmscore.sk & "'"
End If
Set adoRS = adoCon.Execute(SQL)
txtID.Text = Trim(adoRS("ID"))
aID = Trim(adoRS("ID"))
txtname.Text = Trim(adoRS("Name"))
cobsp.Text = Trim(adoRS("Speciality"))
cobclass.Text = Trim(adoRS("Class"))
Set adoRS = Nothing
End Sub
Private Sub UpDown1_Change()
Label13.Caption = "×" & UpDown1.Value & "%"
End Sub
Private Sub UpDown2_Change()
Label15.Caption = "×" & UpDown2.Value & "%"
End Sub
Private Sub UpDown3_Change()
Label17.Caption = "×" & UpDown3.Value & "%"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -