📄 ado_object.frm
字号:
End
Begin VB.CommandButton cmdmodify
Caption = "修改"
BeginProperty Font
Name = "幼圆"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 2328
TabIndex = 30
Top = 348
Width = 948
End
Begin VB.CommandButton cmdcancel
Caption = "取消"
BeginProperty Font
Name = "幼圆"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1320
TabIndex = 29
Top = 348
Width = 948
End
Begin VB.CommandButton cmdadd
Caption = "添加"
BeginProperty Font
Name = "幼圆"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 444
TabIndex = 28
Top = 348
Width = 948
End
End
Begin VB.Frame Frame2
Caption = "查询"
Height = 780
Left = 756
TabIndex = 10
Top = 2616
Width = 5412
Begin VB.CommandButton cmdlast
Caption = ">>"
BeginProperty Font
Name = "幼圆"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 4116
TabIndex = 27
Top = 300
Width = 912
End
Begin VB.CommandButton cmdnext
Caption = ">"
BeginProperty Font
Name = "幼圆"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 2928
TabIndex = 26
Top = 300
Width = 912
End
Begin VB.CommandButton cmdprevious
Caption = "<"
BeginProperty Font
Name = "幼圆"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1680
TabIndex = 25
Top = 300
Width = 912
End
Begin VB.CommandButton cmdfirst
Caption = "<<"
BeginProperty Font
Name = "幼圆"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 372
TabIndex = 24
Top = 300
Width = 912
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim saveupdate_flag As Boolean
Private Sub disable_proc()
Dim ctl As Control '控件对象变量
For Each ctl In Controls
If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Then
ctl.Enabled = False
End If
Next ctl
End Sub
Private Sub enable_proc()
Dim ctl As Control '控件对象变量
For Each ctl In Controls
If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Then
ctl.Enabled = True
End If
Next ctl
End Sub
Private Sub display()
Text1.Text = rs.Fields(0)
Text2.Text = rs.Fields(1)
Combo1.Text = rs.Fields(2)
Text4.Text = rs.Fields(3)
Text5.Text = LTrim(str(rs.Fields(4)))
Text6.Text = LTrim(str(rs.Fields(5)))
Text7.Text = LTrim(str(rs.Fields(6)))
Text8.Text = LTrim(str(rs.Fields(7)))
Text9.Text = LTrim(str(rs.Fields(8)))
Text10.Text = LTrim(str(rs.Fields(9)))
End Sub
Private Sub ena_querybutton()
cmdfirst.Enabled = True
cmdprevious.Enabled = True
cmdnext.Enabled = True
cmdlast.Enabled = True
End Sub
Private Sub dis_querybutton()
cmdfirst.Enabled = False
cmdprevious.Enabled = False
cmdnext.Enabled = False
cmdlast.Enabled = False
End Sub
Private Sub showclear()
Text1.Text = Empty
Text2.Text = Empty
Text4.Text = Empty
Text5.Text = Empty
Text6.Text = Empty
Text7.Text = Empty
Text8.Text = Empty
Text9.Text = Empty
Text10.Text = Empty
Combo1.Text = Empty
End Sub
Private Sub Cmdexit_Click()
Unload Me
End Sub
Private Sub cmdfirst_Click()
rs.MoveFirst
display
cmdmodify.Enabled = True
cmddelete.Enabled = True
'-----------------------------------
cmdprevious.Enabled = False
cmdfirst.Enabled = False
If cmdnext.Enabled = False Then
cmdnext.Enabled = True
cmdlast.Enabled = True
End If
End Sub
Private Sub cmdlast_Click()
rs.MoveLast
display
cmdmodify.Enabled = True
cmddelete.Enabled = True
'-----------------------------------
cmdnext.Enabled = False
cmdlast.Enabled = False
If cmdprevious.Enabled = False Then
cmdprevious.Enabled = True
cmdfirst.Enabled = True
End If
End Sub
Private Sub cmdnext_Click()
MsgBox rs.AbsolutePosition
rs.MoveNext
' MsgBox rs.AbsolutePosition
'这样移动是不允许有空记录
If rs.EOF Then
rs.MoveLast
End If
display
cmdmodify.Enabled = True
cmddelete.Enabled = True
'-----------------------------
If rs.AbsolutePosition >= rs.RecordCount Then
cmdnext.Enabled = False
cmdlast.Enabled = False
End If
If cmdprevious.Enabled = False Then
cmdprevious.Enabled = True
cmdfirst.Enabled = True
End If
End Sub
Private Sub cmdprevious_Click()
rs.MovePrevious
If rs.BOF Then
rs.MoveFirst
End If
display
cmdmodify.Enabled = True
cmddelete.Enabled = True
'-------------------------------------
If rs.AbsolutePosition = 1 Then
cmdprevious.Enabled = False
cmdfirst.Enabled = False
End If
If cmdnext.Enabled = False Then
cmdnext.Enabled = True
cmdlast.Enabled = True
End If
End Sub
Private Sub Form_Load()
disable_proc
Combo1.AddItem "男" '因为和数据库更新的数据无关，只添加一次即可
Combo1.AddItem "女"
'点击查选按钮，才显示记录
cmdsave.Enabled = False '其余的多激活
Dim str As String
con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\学生成绩管理系统2000.mdb"
con.CursorLocation = adUseClient
con.Open
str = "select * from 成绩表"
rs.Open str, con, adOpenStatic, adLockPessimistic, adCmdText
showclear
saveupdate_flag = False
cmdmodify.Enabled = False
cmddelete.Enabled = False
End Sub
Private Sub cmdadd_Click()
enable_proc
dis_querybutton
cmdmodify.Enabled = False
cmddelete.Enabled = False
cmdsave.Enabled = True
showclear
Text1.SetFocus
Text4.Text = Date
saveupdate_flag = True
End Sub
Private Sub cmdmodify_Click()
enable_proc
dis_querybutton
cmdsave.Enabled = True
cmdadd.Enabled = False
cmddelete.Enabled = False
saveupdate_flag = False
End Sub
Private Sub cmdcancel_Click()
If saveupdate_flag = True Then
showclear
saveupdate_flag = False
cmddelete.Enabled = False
cmdmodify.Enabled = False
Else
display '就是当前没有更新的记录
cmddelete.Enabled = True
cmdmodify.Enabled = True
End If
disable_proc
ena_querybutton
cmdsave.Enabled = False '保证完全恢复原状,即和开始加载时一样
cmdadd.Enabled = True
End Sub
Private Sub cmddelete_Click()
Dim ans As Integer
Dim str1 As String
ans = MsgBox("真的想删除吗？", vbYesNo, "警告框")
If ans = vbYes Then
rs.Delete '删除当前行
If rs.RecordCount <= 0 Then
MsgBox ("数据库中没有数据")
showclear
cmddelete.Enabled = False
Else
rs.MoveNext '删掉后，东西还留在面板上，请重新显示一遍。
'这样移动是不允许有空记录
If rs.EOF Then
rs.MoveLast
End If
display
End If
End If
End Sub
Private Sub cmdsave_Click()
Dim str1 As String
Dim str2 As String
Dim rstemp As New ADODB.Recordset
Set cmd.ActiveConnection = con
cmd.CommandType = adCmdText
If Text1.Text = Empty Then
MsgBox "该字段不能为空，请输入！"
Text1.SetFocus
Exit Sub
End If
If Text2.Text = Empty Then
MsgBox "该字段不能为空，请输入！"
Text2.SetFocus
Exit Sub
End If
If Combo1.Text = Empty Then
MsgBox "该字段不能为空，请输入！"
Combo1.SetFocus
Exit Sub
End If
If Text5.Text = Empty Then
MsgBox "该字段不能为空，请输入！"
Text5.SetFocus
Exit Sub
End If
If Text6.Text = Empty Then
MsgBox "该字段不能为空，请输入！"
Text6.SetFocus
Exit Sub
End If
If Text7.Text = Empty Then
MsgBox "该字段不能为空，请输入！"
Text7.SetFocus
Exit Sub
End If
If Text8.Text = Empty Then
MsgBox "该字段不能为空，请输入！"
Text8.SetFocus
Exit Sub
End If
If Text9.Text = Empty Then
MsgBox "该字段不能为空，请输入！"
Text9.SetFocus
Exit Sub
End If
If Text10.Text = Empty Then
MsgBox "该字段不能为空，请输入！"
Text10.SetFocus
Exit Sub
End If
If IsDate(Trim(Text4.Text)) = False Then
MsgBox "该字段为日期格式数据，请核对！"
Text4.SetFocus
Exit Sub
End If
'----------进行唯一性检验------------------------
If saveupdate_flag = True Then '修改时不进行有效性检验，但insert即要！
str2 = "select * from 成绩表 where 学号='" & Trim(Text1.Text) & "';"
rstemp.Open str2, con, adOpenStatic, adLockPessimistic, adCmdText
If Not rstemp.EOF Then
MsgBox "学号唯一，请重新输入！"
Text1.Text = Empty
Text1.SetFocus
rstemp.Close
Exit Sub
End If
rstemp.Close
End If
'---------唯一性检验结束--------------------------
If saveupdate_flag Then
str1 = "insert into 成绩表(学号,姓名,性别,考试日期,语文,数学,物理,化学,英语,政治) values('" & Text1.Text & "','" & Text2.Text & "','" & Combo1.Text & "','" & Text4.Text & "','" & Val(Text5.Text) & "','" & Val(Text6.Text) & "','" & Val(Text7.Text) & "','" & Val(Text8.Text) & "','" & Val(Text9.Text) & "','" & Val(Text10.Text) & "');"
Else
str1 = "update 成绩表 set 姓名='" & Text2.Text & "',性别='" & Combo1.Text & "',考试日期='" & Text4.Text & "',语文='" & Val(Text5.Text) & "',数学='" & Val(Text6.Text) & "',物理='" & Val(Text7.Text) & "',化学='" & Val(Text8.Text) & "',英语='" & Val(Text9.Text) & "',政治='" & Val(Text10.Text) & "' where 学号='" & Text1.Text & "';" '注意这里有一个空格
'检查SQL语句，如果没有条件，则是替换所有的记录
End If
cmd.CommandText = str1
cmd.Execute
rs.Requery
'特别指出，当command对象使用了execute方法执行后，对于插入记录操作
'完成后，在后端并没有把保存记录（面上看到不算数），还必须使用recordset对象的requery方法
'requery方法通过重新执行recordset对象对应的查询来更新record对象中
'的数据（这样才是最后的更新）。对于update命令也要。p.284
saveupdate_flag = False
'-------------------------
'注意，不要display显示记录，让界面上的东西留着
disable_proc
ena_querybutton
cmdsave.Enabled = False '保存完后，记录更新（修改、添加、删除）重新来过
cmdadd.Enabled = True
cmdmodify.Enabled = True
cmddelete.Enabled = True
End Sub
Private Sub Text4_LostFocus()
If IsDate(Trim(Text4.Text)) = False Then
MsgBox "输入数据要求日期格式"
Text4.SetFocus
Exit Sub
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -