主窗体代码
在本项目中，子菜单事件都是Click事件，这里先给出主窗体部分的代码。
下面是响应“增加用户”子菜单Click事件，调出增加用户窗体代码。
Private Sub adduser_Click()
frmadduser.Show
End Sub
下面是响应“查询输出”子菜单Click事件，调出查询输出窗体代码。
Private Sub chaxunshuchu_Click()
frmfind.Show
End Sub
下面是响应“退出”子菜单Click事件，调出退出窗体代码。
Private Sub exit_Click()
Unload Me
End Sub
下面是响应“图书登记”子菜单Click事件，调出图书登记窗体代码。
Private Sub checkin_Click()
frmdengji.Show
End Sub
下面是响应“修改密码”子菜单Click事件，调出修改密码窗体代码。
Private Sub changepwd_Click()
frmchangepwd.Show
End Sub
下面是响应“图书借阅”子菜单Click事件，调出图书借阅窗体代码。
Private Sub borrow_Click()
frmjieyue.Show
End Sub
下面是响应“图书赔偿”子菜单Click事件，调出图书赔偿窗体代码。
Private Sub tushupeichang_Click()
frmpeichang.Show 1
End Sub
下面是响应“值班管理”菜单Click事件，调出值班管理窗体代码。
Private Sub zhibanguanli_Click()
frmzhiban.Show 1
End Sub
下面是响应“投诉管理”子菜单Click事件，调出投诉管理窗体代码。
Private Sub tousuguanli_Click()
frmtousu.Show 1
End Sub
2、各子窗体的代码
在各个子窗体建立好后，就可以根据各个子窗体的功能给它们添加相应代码了。
(1) 图书登记子窗体代码
本窗体用来填写图书登记的信息，用ADO来连接数据库，是本窗体的重点。采用MDI的子程序，所以运行后，它出现在主程序的界面下，如图33所示。
图33 图书登记子窗体
按钮控件要求先填写基本信息，然后与数据库信息比较。
Private Sub Command1_Click()
On Error GoTo adderr
Text1.SetFocus
Adodc1.Recordset.AddNew
Exit Sub
adderr:
MsgBox Err.Description
End Sub
Private Sub Command2_Click()
On Error GoTo deleteerr
With Adodc1.Recordset
If Not .EOF And Not .BOF Then
If MsgBox("删除当前记录吗?", vbYesNo + vbQuestion) = vbYes Then
.Delete
.MoveNext
If .EOF Then .MoveLast
End If
End If
End With
Exit Sub
deleteerr:
MsgBox Err.Description
End Sub
Private Sub Command3_Click()
Adodc1.Recordset.MoveNext
If Adodc1.Recordset.EOF Then
MsgBox "这是最后一条记录", vbOKCancel + vbQuestion
Adodc1.Recordset.MoveLast
End If
End Sub
Private Sub Command4_Click()
Adodc1.Recordset.MovePrevious
If Adodc1.Recordset.BOF Then
MsgBox "这是第一条记录", vbOKCancel + vbQuestion
Adodc1.Recordset.MoveFirst
End If
End Sub
Private Sub Command5_Click()
If Adodc1.Recordset.EOF Then
MsgBox "记录空", vbOKCancel + vbQuestion
End
Else
Adodc1.Recordset.MoveFirst
Exit Sub
End Sub
Private Sub Command6_Click()
If Adodc1.Recordset.RecordCount = 0 Then
MsgBox "空记录", vbOKCancel + vbQuestion
End
Else
Adodc1.Recordset.MoveLast
End If
End Sub
Private Sub Command7_Click()
MDIForm1.Show
frmdengji.Hide
End Sub
图书借阅和图书赔偿子窗体运行后如图34和图35所示，因为它们的代码和图书登记子窗体的代码雷同，在此不做重复。
图34 图书借阅子窗体运行效果
图35 图书赔偿子窗体运行效果
(2) 增加用户子窗体代码
增加用户子窗体是用来增加用户的用户名、密码和权限的。其运行效果如图36所示。
单击“确定”按钮后，还要返回一个信息框，提示成功信息，如图37所示。
图36 增加用户子窗体运行效果 图37 成功信息框
窗体部分代码的思路是，收集输入的表中的字符串，然后与数据库中的系统的用户数据比较，如果不存在，则允许添加。
Private Sub Command1_Click()
Dim sql As String
Dim rs_add As New ADODB.Recordset
If Trim(Text1.Text) = "" Then
MsgBox "用户名不能为空", vbOKOnly + vbExclamation, ""
Exit Sub
Text1.SetFocus
Else
sql = "select * from 系统管理"
rs_add.Open sql, conn, adOpenKeyset, adLockPessimistic
While (rs_add.EOF = False)
If Trim(rs_add.Fields(0)) = Trim(Text1.Text) Then
MsgBox "已有这个用户", vbOKOnly + vbExclamation, ""
Text1.SetFocus
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Combo1.Text = ""
Exit Sub
Else
rs_add.MoveNext
End If
Wend
If Trim(Text2.Text) <> Trim(Text3.Text) Then
MsgBox "两次密码不一致", vbOKOnly + vbExclamation, ""
Text2.SetFocus
Text2.Text = ""
Text3.Text = ""
Exit Sub
ElseIf Trim(Combo1.Text) <> "system" And Trim(Combo1.Text) <> "guest" Then
MsgBox "请选择正确的用户权限", vbOKOnly + vbExclamation, ""
Combo1.SetFocus
Combo1.Text = ""
Exit Sub
Else
rs_add.AddNew
rs_add.Fields(0) = Text1.Text
rs_add.Fields(1) = Text2.Text
rs_add.Fields(2) = Combo1.Text
rs_add.Update
rs_add.Close
下面是返回成功信息对话框的代码:
MsgBox "添加用户成功", vbOKOnly + vbExclamation, ""
Unload Me
End If
End If
End Sub
(3) 修改密码子窗体代码
修改密码子窗体是用来修改用户密码的。其运行效果如图38所示。
图38 修改密码子窗体运行效果
在“确定”按钮的Click事件中添加如下代码:
Private Sub Command1_Click()
Dim rs_chang As New ADODB.Recordset
Dim sql As String
If Trim(Text1.Text) <> Trim(Text2.Text) Then
MsgBox "密码不一致!", vbOKOnly + vbExclamation, ""
Text1.SetFocus
Text1.Text = ""
Text2.Text = ""
Else
sql = "select * from 系统管理 where 用户名='" & userID & "'"
rs_chang.Open sql, conn, adOpenKeyset, adLockPessimistic
rs_chang.Fields(1) = Text1.Text
rs_chang.Update
rs_chang.Close
MsgBox "密码修改成功", vbOKOnly + vbExclamation, ""
Unload Me
End If
End Sub
在上述代码中，首先比较两个表中的数据是否一致，然后用rs_chang.Fields(1) = Text1.Text语句把代码输入到数据库中。最后，用MsgBox "密码修改成功", vbOKOnly + vbExclamation，""语句弹出一个信息框，告诉修改成功，如图39所示。
显示目录
(4) 库房管理子窗体代码
库房管理子窗体是用来管理图书资料的。其运行效果如图40所示。
图40 库房管理子窗体
实际上，设计库房管理子窗体的程序代码与增加用户子窗体的代码在思路上是完全相同的。就是在DataGrid的文本框中显示图书进出的清单，最后把填写的明细存储到数据库中。
检查代码如下:
Option Explicit
Dim rs_data2 As New ADODB.Recordset
Dim select_row As String
Dim showgrid2 As Boolean
Dim rs_custom As New ADODB.Recordset
Dim jinchu As String ' 进出库标志
Dim modify As Boolean ' 修改状态标志
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub Form_Load()
On Error GoTo loaderror
Dim sql As String
sql = "select * from 图书资料"
rs_custom.CursorLocation = adUseClient
rs_custom.Open sql, conn, adOpenKeyset, adLockPessimistic
While Not rs_custom.EOF
Combo1.AddItem rs_custom.Fields(0)
rs_custom.MoveNext
Wend
findok = True
modify = False ' 非修改状态
showgrid2 = False
displaygrid1 ' 调用显示Datagrid1子程序
loaderror:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub
'显示msflexgrid1子程序
Public Sub displaygrid1()
Dim i As Integer
On Error GoTo displayerror
setgrid
setgridhead
MSFlexGrid1.Row = 0
If Not rs_data1.EOF Then
rs_data1.MoveFirst
Do While Not rs_data1.EOF
MSFlexGrid1.Row = MSFlexGrid1.Row + 1
MSFlexGrid1.Col = 0
If Not IsNull(rs_data1.Fields(0)) Then MSFlexGrid1.Text = rs_data1.Fields(0) Else
MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 1
If Not IsNull(rs_data1.Fields(1)) Then MSFlexGrid1.Text = rs_data1.Fields(1) Else
MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 2
If Not IsNull(rs_data1.Fields(2)) Then MSFlexGrid1.Text = rs_data1.Fields(2) Else
MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 3
If Not IsNull(rs_data1.Fields(3)) Then MSFlexGrid1.Text = rs_data1.Fields(3) Else
MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 4
If Not IsNull(rs_data1.Fields(4)) Then MSFlexGrid1.Text = rs_data1.Fields(4) Else
MSFlexGrid1.Text = ""
MSFlexGrid1.Col = 5
If Not IsNull(rs_data1.Fields(5)) Then MSFlexGrid1.Text = rs_data1.Fields(5) Else
MSFlexGrid1.Text = ""
rs_data1.MoveNext
Loop
End If
displayerror:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub
Public Sub setgrid()
Dim i As Integer
On Error GoTo seterror
With MSFlexGrid1
.ScrollBars = flexScrollBarBoth
.FixedCols = 0
.Rows = rs_data1.RecordCount + 1
.Cols = 6
.SelectionMode = flexSelectionByRow
For i = 0 To .Rows - 1
.RowHeight(i) = 315
Next
For i = 0 To .Cols - 1
.ColWidth(i) = 1300
Next i
End With
Exit Sub
seterror:
MsgBox Err.Description
End Sub
Public Sub setgridhead()
On Error GoTo setheaderror
MSFlexGrid1.Row = 0
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "编号"
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = "购买日期"
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = "书名"
MSFlexGrid1.Col = 3
MSFlexGrid1.Text = "类型"
MSFlexGrid1.Col = 4
MSFlexGrid1.Text = "定价"
MSFlexGrid1.Col = 5
MSFlexGrid1.Text = "备注"
Exit Sub
setheaderror:
MsgBox Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
findok = False
rs_data1.Close
rs_custom.Close
End Sub
Private Sub MSFlexGrid1_Click()
On Error GoTo griderror
Dim getrow As Long
getrow = MSFlexGrid1.Row
If MSFlexGrid1.Rows = 1 Then
MsgBox "无相关记录", vbOKOnly + vbExclamation, ""
Else
select_row = MSFlexGrid1.TextMatrix(getrow, 0)
End If
griderror:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub
Public Sub showdata()
With MSFlexGrid2
.Rows = rs_data2.RecordCount + 1
.Row = 0
If Not rs_data2.EOF Then
rs_data2.MoveFirst
Do While Not rs_data2.EOF
.Row = .Row + 1
.Col = 0
If Not IsNull(rs_data2.Fields(0)) Then .Text = rs_data2.Fields(0) Else .Text = ""
.Col = 1
If Not IsNull(rs_data2.Fields(1)) Then .Text = rs_data2.Fields(1) Else .Text = ""
.Col = 2
If Not IsNull(rs_data2.Fields(2)) Then .Text = rs_data2.Fields(2) Else .Text = ""
.Col = 3
If Not IsNull(rs_data2.Fields(3)) Then .Text = rs_data2.Fields(3) Else .Text = ""
.Col = 4
If Not IsNull(rs_data2.Fields(4)) And CDbl(rs_data2.Fields(4)) < 0 Then
.Text = -CDbl(rs_data2.Fields(4))
Else
.Text = rs_data2.Fields(4)
End If
.Col = 5
If Not IsNull(rs_data2.Fields(5)) Then .Text = rs_data2.Fields(5) Else .Text = ""
.Col = 6
If Not IsNull(rs_data2.Fields(6)) Then .Text = rs_data2.Fields(6) Else .Text = ""
.Col = 7
If Not IsNull(rs_data2.Fields(7)) And CDbl(rs_data2.Fields(4)) < 0 Then
.Text = -CDbl(rs_data2.Fields(7))
Else
.Text = rs_data2.Fields(7)
End If
.Col = 8
If Not IsNull(rs_data2.Fields(8)) Then .Text = rs_data2.Fields(8) Else .Text = ""
rs_data2.MoveNext
Loop
rs_data2.MoveLast
End If
End With
End Sub
(5) 查询子窗体代码
查询子窗体是用来查询库房中图书资料明细的。其运行效果如图41所示。
图41 查询子窗体运行效果
在列表框中给出编号或年月日后，“查询”按钮的Click事件将给出与数据库查找比较的结果。
Private Sub Command1_Click()
On Error GoTo cmderror
Dim find_date1 As String
Dim find_date2 As String
If Option1.Value = True Then
sqlfind = "select * from 图书资料 where 编号 between '" & _
Combo1(0).Text & "'" & " and " & "'" & Combo1(1).Text & "'"
End If
If Option2.Value = True Then
find_date1 = Format(CDate(Comboy(0).Text & "-" & _
Combom(0).Text & "-" & Combod(0).Text), "yyyy-mm-dd")
find_date2 = Format(CDate(Comboy(1).Text & "-" & _
Combom(1).Text & "-" & Combod(1).Text), "yyyy-mm-dd")
sqlfind = "select * from 图书资料 where 购买日期 between #" & _
find_date1 & "#" & " and" & " #" & find_date2 & "#"
End If
rs_data1.Open sqlfind, conn, adOpenKeyset, adLockPessimistic
frmdatamanage.displaygrid1
Unload Me
cmderror:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub
运行查询子窗体时，组合框中就已经从数据库中提取了货单号和年月日两个待查条件。
Dim i As Integer
Dim sql As String
If findok = True Then
rs_data1.Close
End If
sql = "select * from 图书资料 order by 编号 desc"
rs_find.CursorLocation = adUseClient
rs_find.Open sql, conn, adOpenKeyset, adLockPessimistic
If rs_find.EOF = False Then ' 添加编号
With rs_find
Do While Not .EOF
Combo1(0).AddItem .Fields(0)
Combo1(1).AddItem .Fields(0)
.MoveNext
Loop
End With
End If
For i = 2001 To 2005 ' 添加年
Comboy(0).AddItem i
Comboy(1).AddItem i
Next i
For i = 1 To 12 ' 添加月
Combom(0).AddItem i
Combom(1).AddItem i
Next i
For i = 1 To 31 ' 添加日
Combod(0).AddItem i
Combod(1).AddItem i
Next i
End Sub
查询完毕后，输出查询结果，如图42所示。
图42 查询结果
http://book.csdn.net 2006-31 16:26:00
显示目录
(6) 用户登录子窗体代码
运行的用户登录子窗体如图43所示。
图43 运行的用户登录子窗体
在本项目中，用户登录子窗体是运行的第一个界面，它的作用是检查用户名和密码是否正确。由于用户的资料是存放在数据库中，所以在启动该子窗体时，就已经连接了数据库。其代码如下:
Private Sub Form_Load()
Dim connectionstring As String
connectionstring = "provider=Microsoft.Jet.oledb.4.0;" & _
"data source=book.mdb"
conn.Open connectionstring
cnt = 0
End Sub
“确定”按钮的作用是检查输入的数据是否与数据库中的数据一致。
Private Sub Command1_Click()
Dim sql As String
Dim rs_login As New ADODB.Recordset
If Trim(txtuser.Text) = "" Then ' 判断输入的用户名是否为空
MsgBox "没有这个用户", vbOKOnly + vbExclamation, ""
txtuser.SetFocus
Else
sql = "select * from 系统管理 where 用户名='" & txtuser.Text & "'"
rs_login.Open sql, conn, adOpenKeyset, adLockPessimistic
If rs_login.EOF = True Then
MsgBox "没有这个用户", vbOKOnly + vbExclamation, ""
txtuser.SetFocus
Else ' 检验密码是否正确
用户名和密码通过后，要关闭本窗体并打开主窗体。
If Trim(rs_login.Fields(1)) = Trim(txtpwd.Text) Then
userID = txtuser.Text
userpow = rs_login.Fields(2)
rs_login.Close
Unload Me
MDIForm1.Show
Else
MsgBox "密码不正确", vbOKOnly + vbExclamation, ""
txtpwd.SetFocus
End If
End If
End If
' 只能输入3次
cnt = cnt + 1
If cnt = 3 Then
Unload Me
End If
Exit Sub
End Sub
京公网安备 11010802021500号