基于数据库的VB课程设计

４．设计体会 通过本次课程设计，使我从更深的层次了解了VB的设计技巧和应用方法。在程序的编制和调试过程中，我从中学到了很多有用的方法，比如通过本次设计，我更深刻的体会到了VB系统的方便与实用。在课程设计的过程中，我对课本上的知识进行了复习，从中找出了不少盲点，由衷地感觉到学习过程中应该把学的知识作扎实，多动手多思考，这样才能最大限度的减少知识的漏洞。 把课本上的东西变成实际的东西，让其有使用的价值，是一件很让人高兴的事。我切实的体会到VB这门课程是有用处的，它解释了我平时学习中的很多疑惑，让我增长了很多见识。 ５.参考文献 [1] 刘天惠.Visual Basic程序设计教程[M]. 北京: 清华大学大学出版社，2003.12-24 [2] 龚沛曾.Visual Basic程序设计教程[M]. 高等教育出版社, 2004.28-45 [3] 蒋加伏.Visual Basic程序设计教程[M].北京: 北京邮电大学出版社，2003.10-56 [4] Microsoft .Visual Basic 6.0 中文版控件大全[M]北京：电子工业出版社,2004.15－23 ６.附录 源程序代码如下： （１）用户登录窗体 Private Sub cmdOK_Click() Dim SQL As String Dim rs As ADODB.Recordset 沈 阳 大 学 课程设计说明书 NO.16 If Trim(UserName.Text = "") Then MsgBox "没有输入用户名称，请重新输入！", vbOKOnly + vbExclamation, "警告" UserName.SetFocus Else '查询用户 SQL = "select * from UserInfo where UserID='" & UserName.Text & "'" Set rs = TransactSQL(SQL) If iflag = 1 Then If rs.EOF = True Then MsgBox "没有这个用户，请重新输入！", vbOKOnly + vbExclamation, "警告" UserName.SetFocus Else If Trim(rs.Fields(1)) = Trim(PassWord.Text) Then rs.Close Me.Hide gUserName = Trim(UserName.Text) '保存用户名称 FrmMain.Show Unload Me Else MsgBox "密码不正确，请重新输入！", vbOKOnly + vbExclamation, "警告" PassWord.SetFocus PassWord.Text = "" 沈 阳 大 学 课程设计说明书 NO.17 End If End If Else Unload Me End If End If pwdCount = pwdCount + 1 '判断输入次数 If pwdCount = 3 Then Unload Me Exit Sub End If End Sub Private Sub Form_Load() pwdCount = 0 gUserName = "" End Sub Private Sub PassWord_KeyDown(KeyCode As Integer, Shift As Integer) TabToEnter KeyCode End Sub Private Sub UserName_KeyDown(KeyCode As Integer, Shift As Integer) TabToEnter KeyCode End Sub 沈 阳 大 学 课程设计说明书 NO.18 （２）添加用户窗体 Option Explicit Public str1 As String '保存修改时的SQL语句 Public ID As Integer '保存记录编号 Private baddflag As Boolean rivate Sub AID_KeyDown(KeyCode As Integer, Shift As Integer) TabToEnter KeyCode End Sub Private Sub AID_LostFocus() Dim SQL As String Dim rs As New ADODB.Recordset SQL = "select SName,SDept,SPosition from StuffInfo where SID='" & Me.AID.Text & "'" Set rs = TransactSQL(SQL) If rs.EOF = False Then Me.AName = rs(0) '初始化员工姓名 Me.AOldDept = rs(1) Me.AOldPosition = rs(2) Else MsgBox "员工编号输入错误，或者没有这个员工！", vbOKOnly + vbExclamation, "警告！" Me.AID = "" Me.AID.SetFocus Me.AID.ListIndex = 0 End If rs.Close End Sub 沈 阳 大 学 课程设计说明书 NO.19 Private Sub cmdCancel_Click() Unload Me Exit Sub End Sub rivate Sub checkinput() If Me.ANewPosition = "" Then MsgBox "请输入新的职务！", vbOKOnly + vbExclamation, "警告！" Me.ANewPosition.SetFocus ElseIf Me.AOutTime = "" Or IsDate(Me.AOutTime) = False Then MsgBox "请输入正确的调出时间！", vbOKOnly + vbExclamation, "警告！" Me.AOutTime = "" Me.AOutTime.SetFocus ElseIf Me.AInTime = "" Or IsDate(Me.AInTime) = False Then MsgBox "请输入正确的调入时间！", vbOKOnly + vbExclamation, "警告！" Me.AInTime = "" Me.AInTime.SetFocus Else baddflag = True End If End Sub Private Sub cmdOK_Click() Dim SQL As String Dim rs As New ADODB.Recordset 沈 阳 大 学 课程设计说明书 NO.20 baddflag = False Call checkinput If baddflag = True Then If flag = 1 Then 'Call checkinput SQL = "select * from AlterationInfo" Set rs = TransactSQL(SQL) rs.AddNew rs.Fields(1) = Me.AID rs.Fields(2) = Me.AName rs.Fields(3) = Me.AOldDept rs.Fields(4) = Me.ANewDept rs.Fields(5) = Me.AOldPosition rs.Fields(6) = Me.ANewPosition rs.Fields(7) = Me.AOutTime rs.Fields(8) = Me.AInTime rs.Fields(9) = Me.ARemark rs.Update rs.Close SQL = "update StuffInfo set SDept='" & Me.ANewDept & "', SPosition='" SQL = SQL & Me.ANewPosition & "' where SID='" & Me.AID & "'" TransactSQL (SQL) MsgBox "已经添加调动信息！", vbOKOnly + vbExclamation, "添加结果！" SQL = "select * from AlterationInfo order by ID" 沈 阳 大 学 课程设计说明书 NO.21 frmAlterationResult.Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\Person.mdb" frmAlterationResult.Adodc1.RecordSource = SQL If SQL <> "" Then frmAlterationResult.Adodc1.Refresh End If Else '修改记录 'Call checkinput SQL = "update StuffInfo set SDept='" & Me.ANewDept & "', SPosition='" SQL = SQL & Me.ANewPosition & "' where SID='" & Me.AID & "'" TransactSQL (SQL) SQL = "update AlterationInfo set AOldDept='" & Me.AOldDept & "',ANewDept='" SQL = SQL & Me.ANewDept & "',AOldPosition='" & Me.AOldPosition SQL = SQL & "',ANewPosition='" & Me.ANewPosition & "',AOutTime=#" & Me.AOutTime SQL = SQL & "#,AInTime=#" & Me.AInTime & "# where ID=" & ID TransactSQL (SQL) MsgBox "已经修改信息！", vbOKOnly + vbExclamation, "修改结果！" Unload Me SQL = "select * from AlterationInfo order by ID" frmAlterationResult.Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\Person.mdb" frmAlterationResult.Adodc1.RecordSource = SQL If SQL <> "" Then frmAlterationResult.Adodc1.Refresh End If 沈 阳 大 学 课程设计说明书 NO.22 Set frmAlterationResult.DataGrid1.DataSource = frmAlterationResult.Adodc1.Recordset frmAlterationResult.DataGrid1.Refresh frmAlterationResult.Show frmAlterationResult.ZOrder 0 Call init Me.ZOrder 0 End If End If End Sub （3）查询员工信息窗体 Option Explicit Private query As String Private fromdate As String Private todate As String Private Sub cmdCancel_Click() Unload Me Exit Sub End Sub Private Sub CombineDate() fromdate = Me.FromYear.Text & "-" & Me.FromMonth.Text & "-1" fromdate = Format(Me.FromYear.Text & "-" & Me.FromMonth.Text & "-1", "yyyy-mm-dd") todate = Me.ToYear.Text & "-" & Me.ToMonth.Text & "-1" todate = Format(todate, "yyyy-mm-dd") End Sub 沈 阳 大 学 课程设计说明书 NO.23 Private Sub setSQL() If IDCheck.Value = vbChecked Then query = "select * from StuffInfo where SID='" & Trim(Me.SID) & "'" End If If NameCheck.Value = vbChecked Then query = "select * from StuffInfo where SName='" & Trim(Me.SName) & "'" End If End Sub Private Sub cmdOK_Click() Call CombineDate Call setSQL frmResult.createList (query) frmResult.Show Unload Me End Sub Private Sub Form_Load() Dim i As Integer Dim SQL As String Dim rs As New ADODB.Recordset SQL = "select distinct datepart(yy,SInTime) from StuffInfo" Set rs = TransactSQL(SQL) If Not rs.EOF Then rs.MoveFirst While Not rs.EOF If Not IsNull(rs.Fields(0)) Then 沈 阳 大 学 课程设计说明书 NO.24 Me.FromYear.AddItem rs(0) Me.ToYear.AddItem rs(0) End If rs.MoveNext Wend rs.Close Me.FromYear.ListIndex = 0 Me.ToYear.ListIndex = 0 End If For i = 1 To 12 Me.FromMonth.AddItem i Me.ToMonth.AddItem i Next i Me.FromMonth.ListIndex = 0 Me.ToMonth.ListIndex = 0 End Sub