📄 dlgach.frm
字号:
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form DlgAch
BorderStyle = 3 'Fixed Dialog
Caption = "成绩录入"
ClientHeight = 2880
ClientLeft = 3075
ClientTop = 2505
ClientWidth = 5400
Icon = "DlgAch.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2880
ScaleWidth = 5400
ShowInTaskbar = 0 'False
Begin MSAdodcLib.Adodc Adodc1
Height = 375
Left = 120
Top = 2400
Width = 3855
_ExtentX = 6800
_ExtentY = 661
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = ""
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Frame Frame2
Caption = "学生成绩"
Height = 1815
Left = 120
TabIndex = 1
Top = 480
Width = 5175
Begin VB.ComboBox Combo1
Height = 300
Left = 1200
TabIndex = 7
Top = 300
Width = 2295
End
Begin VB.TextBox Text3
Height = 300
Left = 1200
TabIndex = 6
Top = 720
Width = 2295
End
Begin VB.TextBox Text4
DataSource = "Adodc1"
Height = 300
Left = 1200
TabIndex = 5
Text = "Text4"
Top = 1140
Width = 2295
End
Begin VB.CommandButton Command4
Caption = "增加"
Height = 375
Left = 3600
TabIndex = 4
Top = 300
Width = 1455
End
Begin VB.CommandButton Command5
Caption = "更改"
Height = 375
Left = 3600
TabIndex = 3
Top = 720
Width = 1455
End
Begin VB.CommandButton Command6
Caption = "删除"
Height = 375
Left = 3600
TabIndex = 2
Top = 1140
Width = 1455
End
Begin VB.Label Label3
Caption = "学号："
Height = 255
Left = 240
TabIndex = 10
Top = 780
Width = 735
End
Begin VB.Label Label4
Caption = "课程："
Height = 255
Left = 240
TabIndex = 9
Top = 360
Width = 855
End
Begin VB.Label Label5
Caption = "成绩："
Height = 255
Left = 240
TabIndex = 8
Top = 1200
Width = 735
End
End
Begin VB.CommandButton OKButton
Caption = "关闭"
Default = -1 'True
Height = 375
Left = 4080
TabIndex = 0
Top = 2400
Width = 1215
End
Begin VB.Label Label7
AutoSize = -1 'True
DataSource = "Adodc1"
Height = 180
Left = 3240
TabIndex = 14
Top = 120
Width = 90
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "课程ID:"
Height = 180
Left = 2520
TabIndex = 13
Top = 120
Width = 630
End
Begin VB.Label Label2
AutoSize = -1 'True
DataSource = "Adodc1"
Height = 180
Left = 840
TabIndex = 12
Top = 120
Width = 90
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "学生ID:"
Height = 180
Left = 120
TabIndex = 11
Top = 120
Width = 630
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
X1 = 5280
X2 = 120
Y1 = 360
Y2 = 360
End
Begin VB.Line Line2
BorderColor = &H00404040&
X1 = 240
X2 = 5400
Y1 = 345
Y2 = 345
End
End
Attribute VB_Name = "DlgAch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As ADODB.Recordset
Dim SD As Boolean
Private Sub Adodc1_WillMove(ByVal adReason As ADODB.EventReasonEnum, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
If SD Then Exit Sub
If pRecordset.EOF Or pRecordset.BOF Then Exit Sub
If checkclass(pRecordset.Fields("课程ID").Value, pRecordset.Fields("学生ID").Value) Then
MsgBox "这个课程的成绩已经有了，不能加入", vbOKOnly, "警告"
adReason = adRsnUndoUpdate
End If
End Sub
Private Sub Combo1_Click()
On Error GoTo errh
Dim temp As Integer
If Combo1.Text <> "" Then
Set rs = cn.Execute("SELECT 课程ID FROM 课程 WHERE 课程名称=" & "'" & Combo1.Text & "'")
If rs.EOF Then
rs.Close
Exit Sub
End If
temp = rs.Fields(0).Value
rs.Close
If Label2.Caption = "" Then
Label7.Caption = temp
Else
If checkclass(temp, Int(Label2.Caption)) Then
Label7.Caption = temp
Else
MsgBox "这个课程的成绩已经有了，不能加入", vbOKOnly, "警告"
End If
End If
End If
Exit Sub
errh:
MsgBox Err.Description
End Sub
Private Sub Command4_Click()
On Error GoTo errh
SD = True
If Text3.Text <> "" Then
Text3.Text = Left$(Text3.Text, Len(Text3.Text) - 1)
End If
Adodc1.Recordset.AddNew
Exit Sub
errh:
MsgBox Err.Description
End Sub
Private Sub Command5_Click()
On Error GoTo errh
SD = False
Adodc1.Recordset.Update
Exit Sub
errh:
MsgBox Err.Description
End Sub
Private Sub Command6_Click()
On Error GoTo errh
If MsgBox("你的操作将会删除当前的纪录，你确信吗？", vbOKCancel, "警告") = vbOK Then
SD = True
Adodc1.Recordset.Delete
Adodc1.Recordset.MoveFirst
End If
Exit Sub
errh:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
On Error GoTo errh
MakeCenter DlgAch
Set rs = cn.Execute("SELECT 课程名称,课程ID FROM 课程")
rs.MoveFirst
Do
Combo1.AddItem rs.Fields(0).Value
rs.MoveNext
Loop Until rs.EOF
Combo1.Text = "请选择课程"
rs.Close
Adodc1.ConnectionString = "DRIVER={Microsoft Access Driver (*.mdb)};" & _
"DBQ=db5.MDB;" & _
"DefaultDir=" & CheckPath(App.path) & ";" & _
"UID=;PWD=;"
'"PASSWORD=197967yh"
Adodc1.RecordSource = "SELECT * FROM 学生与课程"
Label1.DataField = "学生ID"
Label6.DataField = "课程ID"
Text4.DataField = "成绩"
Exit Sub
errh:
MsgBox Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Adodc1.Recordset.Close
Set rs = Nothing
End Sub
Private Sub OKButton_Click()
Unload Me
End Sub
Private Sub Text3_Change()
On Error GoTo errh
If Len(Text3.Text) = 8 Then
Dim i As Integer
Set rs = cn.Execute("SELECT 学生ID FROM 学生 WHERE 学号=" & "'" & Text3.Text & "'")
If rs.EOF Then
rs.Close
Exit Sub
End If
i = rs.Fields(0).Value
rs.Close
If Label7.Caption = "" Then
Label2.Caption = i
Exit Sub
End If
If checkclass(Int(Label7.Caption), i) Then
Label2.Caption = i
Else
MsgBox "这个课程的成绩已经有了，不能加入", vbOKOnly, "警告"
End If
End If
Exit Sub
errh:
MsgBox Err.Description
End Sub
Private Function checkclass() As Boolean '检测一个学生的课程是否重复
On Error GoTo errh
Set rs = cn.Execute("SELECT 课程号 FROM 学生与课程 WHERE 学号='" & Trim(Text3.Text) & "'AND 课程号='" & Trim(Combo1.Text) & "'")
If rs.EOF Then
rs.Close
checkclass = True
Exit Function
End If
checkclass = False
rs.Close
Exit Function
errh:
rs.Close
MsgBox Err.Description
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -