?? 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 = "學(xué)生成績"
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 = "學(xué)號："
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 = "關(guān)閉"
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 = "學(xué)生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("學(xué)生ID").Value) Then
MsgBox "這個課程的成績已經(jīng)有了，不能加入", 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 "這個課程的成績已經(jīng)有了，不能加入", 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("你的操作將會刪除當(dāng)前的紀(jì)錄，你確信嗎？", 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 學(xué)生與課程"
Label1.DataField = "學(xué)生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 學(xué)生ID FROM 學(xué)生 WHERE 學(xué)號=" & "'" & 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 "這個課程的成績已經(jīng)有了，不能加入", vbOKOnly, "警告"
End If
End If
Exit Sub
errh:
MsgBox Err.Description
End Sub
Private Function checkclass() As Boolean '檢測一個學(xué)生的課程是否重復(fù)
On Error GoTo errh
Set rs = cn.Execute("SELECT 課程號 FROM 學(xué)生與課程 WHERE 學(xué)號='" & 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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -