With the popularization and use of the computer, present management has been promoted much, more and more jobs have been done by computer. It namely changes the original artificial record management mode into computer's integrating and managing. The university is the position of scientific research, the apartment management should change traditional managing artificially too, for the efficiency. So , develop the management software of student's apartment .
Student Apartment Management System is a utility management system based on the managing mode of many universities and colleges.Universal and easy-operating are the greatest features of the system ,which is also applicable for enterprises of the same type.Apartment keepers bear a increasingly heavy burden because of the gradually added number of roomers.In order to free apartment keepers from the heave work,and make the work more convienent and efficient.
The apartment management system is developed. The system computerized all the processes concerning the apartment management which include apartment,dormitory distribution,roomer registration,santitation examination,and the query for apartment property,students' violation of discipline,teachers' records and rooming situation.It makes the apartment management more efficient and much better.
Key word: dispose 、 register 、 check
图4.1登录界面
4.1.2 界面制作与实现
在这个界面中，主要处理的是判断当前用户输入的信息是否正确。如果正确，那么它属于哪种类型用户。因为此管理软件在登录后不同类型的用户显示的窗体与实现的功能都不是一样的，它们会有所差别！
(1) 浮动按钮的实现
确定和取消两个按钮在鼠标没有放上去之前看上去只是一个普通的平面字效果，但是当你把鼠标放在这几个字上面后，它会显示凸出的效果，按下后呈现凹陷的效果。总体实现立体的感觉。原理主要是在鼠标mousemove事件与线的颜色变化组合来实现。主要代码如下：
在窗体中的鼠标移动过程中，以及在窗体初始化的时候，要把添加的线的.Visible 属性设置为 False，只有在鼠标按下的时候在改变其颜色即可。
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
Line1.Visible = False
Line2.Visible = False
Line3.Visible = False
Line4.Visible = False
Line5.Visible = False
Line6.Visible = False
Line7.Visible = False
Line8.Visible = False
End Sub
鼠标按下的时候设置线条的颜色如下：
Private Sub Label3_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Line1.BorderColor = &H808080
Line2.BorderColor = &H808080
Line3.BorderColor = &HE0E0E0
Line4.BorderColor = &HE0E0E0
End Sub
鼠标移动到标签的时候设置线条的颜色如下：
Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
Line1.BorderColor = &HE0E0E0
Line2.BorderColor = &HE0E0E0
Line3.BorderColor = &H808080
Line4.BorderColor = &H808080
Line1.Visible = True
Line2.Visible = True
Line3.Visible = True
Line4.Visible = True
End Sub
(2) 用户类型判断
在数据库中建了一人yonghu表。在添加管理人员时有两种默认级别。管理员、普通用户。管理员拥有对数据库操作的一切权限。普通用户只有普通的查看，数据转换等。没有删除等操作功能。前用户成功登录后，会在主窗体的状态栏中显示出当前用户及其用户类型。
主要代码如下：
设置当前控件连接的数据库
Dim provider As String
Dim datasource As String
provider = "provider=Microsoft.jet.oledb.4.0"
datasource = "data source=" & App.Path & "\DB.mdb"
With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "yonghu"
.Refresh
.Recordset.MoveFirst
End With
对用户进行判断
If Text1.Text = "" Then
MsgBox "请输入用户名!", 48, "提示"
Exit Sub
End If
Adodc1.Recordset.Find "用户='" & Text1.Text & "'"
If Adodc1.Recordset.EOF = False And Text2.Text = Trim(Adodc1.Recordset.Fields("pass")) Then
main.Text1.Text = Adodc1.Recordset.Fields("级别")
main.Text2.Text = Adodc1.Recordset.Fields("用户")
main.Show
Unload Me
Else
Text1.Text = ""
Text2.Text = ""
MsgBox "登录不成功,请重新登录!", 48, "提示"
End If
4.2 程序主界面
程序主界面为本软件的显示的核心部分。一切主要操作及显示都通过这里完成。整个界面主要由五部分组成。菜单部分、工具栏、左侧操作栏、右侧显示栏以及状态栏。
①界面效果图如下：
图4.2程序主界面
菜单栏的详见附录内容，这里就不提了。左侧操作栏和右侧显示栏会在下面的内容中做介绍，现在只简单介绍一下工具栏和状态栏，以及主窗体的各个事件。
工具栏主要是由coolbar制作而成。由它制做的工具栏的显示效果会更有立体感一些。这里只列出了几个常用的按钮。其中的添加按钮是用来对公寓住宿人员进行添加，修改也是对所住宿人员进行修改，想要进行修改时必须显示所有记录时才可以进行。在这里值得一提的是删除DataGrid的操作，由于不知道它的当前数据源是哪个，所以在删除前要确定它的数据源，也就是它所链接的adodc1的数据源，或者是其它ado控件对它的数据源进行重新绑定后的数据库表，也有可能是经过一个查询后得到的记录。
②它的实现方法如下所示：
Dim o As Adodc
Set o = DataGrid1.datasource
o.Recordset.Delete
o.Recordset.Update
这里主要是用到了ado对像的方法。用这个方法得到数据源。
下面是整个工具栏运行时代码：
Select Case Button.Index
Case 1
sel.Show 1
Case 3
add.Show 1
Case 5
On Error GoTo next2
Dim s As Adodc
Set s = DataGrid1.datasource
If s.RecordSource = "users" Then
edit.Show 1
End If
next2:
Case 7
On Error Resume Next
Dim o As Adodc
Set o = DataGrid1.datasource
o.Recordset.Delete
o.Recordset.Update
Case 9
back.Show 1
Case 11
With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "users" '
.Refresh
End With
Set DataGrid1.datasource = Adodc1
DataGrid1.Refresh
Call dx
Case 13
Unload Me
End Select
状态栏分四个部分。第一个为固定显示当前所用软件名称及作者。其中第二个和第三部分为动态显示的，它会显示出每次用户登录名称及其管理模式。由上图可以看出，lf为本软件管理员。第四部分为日期与时间的显示。其中第三部分的代码实现如下：
main.Text1.Text = Adodc1.Recordset.Fields("级别")
main.Text2.Text = Adodc1.Recordset.Fields("用户")
StatusBar1.Panels(2).Text = "当前用户：" & Text2.Text
StatusBar1.Panels(3).Text = "用户模式：" & Text1.Text
StatusBar1.Panels(4).Text = Date & " " & Time
'设置普通用户模式
If Text1.Text = "普通用户" Then
yhgl.Visible = False
g1.Visible = False
jlsc.Visible = False
gysz.Visible = False
Toolbar1.Buttons(5).Visible = False
Toolbar1.Buttons(6).Visible = False
Toolbar1.Buttons(7).Visible = False
Toolbar1.Buttons(8).Visible = False
End If
主窗体在程序运行中会遇到不断改变其大小，最小化，最大化，以及用鼠标来改变，这里需要在窗体的Resize事件中添加代码，让程序中用到的各个控件随时可以适应窗体改变后的大小，在这里改变的控件主要有DataGrid、TreeView系列及Frame控件、StatusBar。下面就是设置它们大小的程序代码：
DataGrid1.Width = main.Width - SSTab1.Width
DataGrid1.Height=main.Height - StatusBar1.Height - CoolBar1.Height - 750
SSTab1.Height = main.Height - StatusBar1.Height - CoolBar1.Height - 750
Frame1.Height = main.Height - StatusBar1.Height - CoolBar1.Height - 1200
Frame2.Height = main.Height - StatusBar1.Height - CoolBar1.Height - 1200
Frame3.Height = main.Height - StatusBar1.Height - CoolBar1.Height - 1200
TreeView1.Height=main.Height - StatusBar1.Height - CoolBar1.Height - 1500
TreeView2.Height=main.Height - StatusBar1.Height - CoolBar1.Height - 1500
TreeView3.Height=main.Height - StatusBar1.Height - CoolBar1.Height - 1500
Y = main.Width
x = (Y - z) / 4
StatusBar1.Panels(1).Width = u + x
StatusBar1.Panels(2).Width = v + x
StatusBar1.Panels(3).Width = w + x
StatusBar1.Panels(4).Width = m + x
这个软件的主要部分都在这里运行、查看，所以在主窗体的load事件里要把所用的到的东西都要加载进来，例如所在程序运行时所用到的表，左侧treeview部分树形显示的初始化。在这里几乎用到了所有的表，如下所示：
provider = "provider=Microsoft.jet.oledb.4.0"
datasource = "data source=" & App.Path & "\DB.mdb"
With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "users" '
.Refresh
End With
With Adodc2
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "gongyu"
.Refresh
End With
With Adodc3
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "class"
.Refresh
End With
With Adodc4
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "weisheng"
.Refresh
End With
With Adodc5
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
End With
With Adodc6
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "dengji"
.Refresh
End With
With Adodc7
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "qinshi"
.Refresh
End With
With Adodc9
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "zichan"
.Refresh
End With
treeview部分树形显示的初始化在这里已经做了几个过程，调用即可。
4.3系统设置
4.3.1用户管理
①界面效果图
图4.3用户管理
② 界面制作与实现方法
这个界面总体来说各个控件比较简单，但是作为一个添加删除管理员的操作，它已经连接到了数据库，与数据库的yonghu表相联。各个控件也与数据库中表的字段绑定。
在窗体初始化的时候要判断当前数据库表中是否有记录，如果没有记录那么有些按钮将会被设置成为失效状态，否则会出现错误。设置代码如下：
Dim provider As String
Dim datasource As String
provider = "provider=Microsoft.jet.oledb.4.0"
datasource = "data source=" & App.Path & "\DB.mdb"
With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "yonghu"
.Refresh
End With
Option1.Enabled = False
Option2.Enabled = False
If Adodc1.Recordset.RecordCount = 0 Then
Command2.Enabled = False
Command3.Enabled = False
Command5.Enabled = False
Command6.Enabled = False
End If
Text2.Text = Text3.Text
上一条与下一条的功能一目了然，它们可以对当前表进行上一条记录或下一条记录依次查看。当找到记录后，可以对其进行相对的删除、修改等操作。上一条记录与下一条的记录在查看时有一个判断。当表中记录移到最前面（BOF）或最后面（EOF）时，会把上一条或下一条其中的一个按钮的enable属性设置为true。即不可以前查看或向后查看。
上一条与下一条主要代码如下：
Adodc1.Recordset.MovePrevious '移动记录
Command6.Enabled = True
If Adodc1.Recordset.BOF Then
Adodc1.Recordset.MoveFirst
Command5.Enabled = False
End If
Adodc1.Recordset.MoveNext '移动记录
Command5.Enabled = True
If Adodc1.Recordset.EOF Then
Adodc1.Recordset.MoveLast
Command6.Enabled = False
End If
添加用户可以添加使用该管理软件的用户。添加的时候可以选择所添加人物的级别。软件默认为两个级别：管理员、普通用户。管理员拥有对此软件管理操作等一切的权力。普通用户，只有普通的查看、查询、备份、添加等权力。没有对记录删除等权力。在添加用户时你可以选择一个且必须选择一个。然后输入此用户的用户名和密码即可！
添加用户主要代码：
If Command1.Caption = "添加" Then
Command2.Enabled = False
Command5.Enabled = False
Command6.Enabled = False
Command1.Caption = "确定"
Command3.Caption = "取消"
Adodc1.Recordset.AddNew
Option1.Enabled = True
Option2.Enabled = True
Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True
Text2.Text = ""
ElseIf Text1.Text = "" Then
MsgBox "用户名不能为空！", 48, "提示"
ElseIf Text2.Text = "" Then
MsgBox "密码不能为空！", 48, "提示"
ElseIf Text2.Text <> Text3.Text Then
MsgBox "密码两次需一致！", 48, "提示"
ElseIf Text4.Text = "" Then
MsgBox "请选择所建用户类型！", 48, "提示"
Else
Command2.Enabled = True
Command3.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
Command3.Caption = "编辑"
Command1.Caption = "添加"
Adodc1.Recordset.Update
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
Option1.Value = False
Option2.Value = False
Option1.Enabled = False
Option2.Enabled = False
End If
删除操作可以把当前记录删除掉。一经删除即不可以在恢复。所以在操作前要想好。
删除操作部分代码：
If Adodc1.Recordset.RecordCount = 1 Then
Command2.Enabled = False
End If
If (MsgBox("你真的想删除当前记录吗？", vbOKCancel, "系统提示")) = vbOK Then
Adodc1.Recordset.Delete
Adodc1.Recordset.MoveFirst
Adodc1.Refresh
End If
编辑操作可以对当前所选择的用户进行编辑，可以修改其用户名与密码。当当前用户感觉自己用户名称或密码有泄露时，可以进行修改。修改记录即更新表中的某一条记录。
编辑操作主要代码如下：
Command2.Enabled = False
Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
Option1.Enabled = True
Option2.Enabled = True
Command1.Caption = "确定"
ElseIf Command3.Caption = "取消" Then
Command3.Caption = "编辑"
Command1.Caption = "添加"
Command2.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
Text2.Text = Text3.Text
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
Option1.Value = False
Option2.Value = False
Option1.Enabled = False
Option2.Enabled = False
End If
4.3.2 公寓设置
公寓设置可以说是本程序中一关键部分。因为所有的设置都在此进行。包括公寓添加、修改、删除。寝室的添加、修改、删除以及班级的添加、修改和删除操作。只有正确的对这些设置进行添加修改，才能输入正确的记录。这里主要涉及到的问题是datagrid的显示，以及treeview及时形成新的结构。还有一些就是对表记录的复杂操作。
在点击sstab各版的时候，要在这时重新生成寝室设置中的树型结构，
Select Case PreviousTab
Case 0
Call startree1
Case 1
Combo1.Clear
Dim I As Integer
I = 1
If Adodc1.Recordset.RecordCount <> 0 Then
Adodc1.Recordset.MoveFirst
Do While I < Adodc1.Recordset.RecordCount
Combo1.AddItem (Adodc1.Recordset.Fields("公寓名称"))
Adodc1.Recordset.MoveNext
I = I + 1
Loop
End If
Call startree1
Case 2
Call startree1
End Select
End Sub
(1) 公寓设置
① 公寓设置效果图
图4.4公寓设置
② 界面制作与实现方法
在这个界面中主要用到了一个Sstab控件与一个显示表中内容的Datagrid控件。以及起到美观作用的Frame控件。
在右下角的文本框中可以输入想要添加的公寓名称。然后点击添加即可完成添加操作。Datagrid中会立即刷新显示更新内容。要修改某条记录时，要先对所要修改的记录进行选择，确认选择后，点击下面的修改按钮，会在下面的文本中显示出所要修改公寓的名称，此时即可输入要修改的名字。然后点击更新就会完成此操作。Datagrid也会即时更新其内容。删除操作更为简单，选择想要删除的公寓名称，点击删除，确认后完成此操作。但是删除后不会影响其它表中的数据。其它表的有关此公寓的信息还会存在。
在进行所有操作前，先要确定数据库已连接。
在添加前要判断所写公寓名称是否正确，即是否输入名称，该记录不能为空，不为空则对数据库表进行查找，判断当前输入记录是否已在表中存在，如果已存在，则会给出提示，不存在，添加成功。
Adodc1.Recordset.Find "公寓名称='" & Text2.Text & "'"
If Adodc1.Recordset.EOF = False Then
MsgBox "此公寓已存在", , "提示"
Adodc1.Recordset.MoveFirst
Exit Sub
End If
Text3.Text = ""
If Text2.Text = "" Then
MsgBox "输入所要添加公寓的名称", , "提示"
Exit Sub
End If
添加：
Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields("公寓名称") = Text2.Text
Adodc1.Recordset.Update
Adodc1.RecordSource = "gongyu"
Text2.Text = ""
Set DataGrid2.datasource = Adodc1
DataGrid2.Refresh
修改公寓名称：
If Text3.Text = "" Then
MsgBox "选择要修改的公寓", , "提示"
Exit Sub
End If
If Command12.Caption = "修改" Then
Text2.Text = Text3.Text
Label6.Caption = "输入想要修改的公寓名称"
Command12.Caption = "更新"
Command3.Enabled = False
Command7.Enabled = False
ElseIf Command12.Caption = "更新" Then
Command3.Enabled = True
Command7.Enabled = True
Label6.Caption = "输入想要添加的公寓名称"
Adodc1.Recordset.Fields("公寓名称") = Text2.Text
Adodc1.Recordset.Update
Adodc2.Recordset.ActiveConnection.Execute "update qinshi set 公寓名称='" & Text2.Text & "' where 公寓名称='" & Trim(Text3.Text) & "'"
Adodc2.Recordset.Update
Command12.Caption = "修改"
End If
Set DataGrid2.datasource = Adodc1
DataGrid2.Refresh
Adodc5.Recordset.Update
Set main.DataGrid1.datasource = Adodc5
main.DataGrid1.Refresh
删除公寓名称
If Text3.Text = "" Then
MsgBox "选择所要删除公寓的名称", , "提示"
Exit Sub
End If
If (MsgBox("你真的想删除公寓名称为 " & Text3.Text & " 的记录吗？", vbOKCancel, "系统提示")) = vbOK Then
Adodc1.Recordset.Delete
Adodc1.Recordset.Update
End If
Text3.Text = ""
Set DataGrid2.datasource = Adodc1
DataGrid2.Refresh
(2) 寝室设置
①寝室设置效果图
图4.5寝室设置
②界面制作与实现方法
此界面实现相对比公寓设置来说相对复杂一些。用到的控件主要是Sstab与Treeview。但是在程序方面比较复杂。
在添加一个寝室前先要选择所要添加寝室所在的公寓。这个公寓可以点击下面的树中的节点，也可以在列表框中选择。树中的节点在点击后会把父节点显示在选择公寓后面的列表框中，而选中的节点会出现在寝室名称里。你也可以自己进行添写，确认公寓后即可添加完成了。添加后会把Treeview重新刷新一下。以显示更新后的记录。
添加源码：
Adodc1.Refresh
Adodc1.Recordset.Find "公寓名称='" & Combo1.Text & "'"
If Adodc1.Recordset.EOF = True Then
MsgBox "此公寓不存在", , "提示"
Adodc1.Recordset.MoveFirst
Exit Sub
End If
If Combo1.Text = "" Or Text1.Text = "" Then
MsgBox "请输入所要添加的寝室及其所属公寓", , "提示"
Exit Sub
End If
With Adodc2
.Recordset.AddNew
.Recordset.Fields(0).Value = Combo1.Text
.Recordset.Fields(1).Value = Text1.Text
.Recordset.Update
End With
Combo1.Text = ""
Text1.Text = ""
Call startree1
修改操作可以把当前选中的寝室进行名称修改与其所属公寓进行修改。当要对名称进行修改时，先要选择所要修改的寝室名，选择后会在寝室名称里显示出来，把当前寝室名称改成要修改的寝室名称，然后点击修改即完成名称修改操作。当要对当前寝室的所属公寓进行修改时，需要先选择所要修改的寝室，然后在上面的公寓名称后填写所要修改的寝室名称。点击修改后完成此操作。但是这种操作不是常见。
修改源码：
Adodc1.Refresh
Adodc1.Recordset.Find "公寓名称='" & Combo1.Text & "'"
If Adodc1.Recordset.EOF = True Then
MsgBox "此公寓不存在", , "提示"
Adodc1.Recordset.MoveFirst
Exit Sub
End If
Dim sql As String
On Error Resume Next
If Combo1.Text = "" Or Text1.Text = "" Then
MsgBox "请在下面选择所要修改的寝室", , "提示"
Exit Sub
End If
'sql = "select * form qinshi where 公寓名称='" & Trim(Combo1.Text) & "' and 寝室='" & Trim(Text1.Text) & "'"
Adodc2.Recordset.ActiveConnection.Execute "update qinshi set 寝室='" & Text1.Text & "',公寓名称='" & Trim(Combo1.Text) & "'where 寝室='" & Trim(Text6.Text) & "'and 公寓名称='" & Trim(Text7.Text) & "'"
Adodc2.Recordset.Update
Combo1.Text = ""
Text1.Text = ""
Call startree1
删除操作可以删除掉当前树型显示中的任何一个子节点，也就是这个树型节点中的寝室名称，注意的是，删除后这个记录只在qinshi表中删除，其相关记录不会被删除掉的，如果想删除，还需要人工操作。实现的方法主要是对qinshi表操作，先对其进行查询，查询当前想要被删除的表是否存在，如果不存在，则给出提示，如果存在这条记录，则在表中把它删除掉，删除后调用生成树过程，把当前寝室设置中的树型结构重新生成，更新记录。实现的部分代码如下所示：
If Combo1.Text = "" Or Text1.Text = "" Or Combo1.Text = "公寓管理系统" Then
MsgBox "选择所要删除的寝室", , "提示"
Exit Sub
End If
If (MsgBox("你真的想删除 " & Combo1.Text & " " & "寝室为" & Text1.Text & " 的记录吗？", vbOKCancel, "系统提示")) = vbOK Then
Adodc2.Refresh
Adodc2.Recordset.ActiveConnection.Execute "delete from qinshi where 公寓名称='" & Trim(Combo1.Text) & "' and 寝室='" & Trim(Text1.Text) & "'"
Adodc2.Recordset.Update
End If
Combo1.Text = ""
Text1.Text = ""
Call startree1
在treeview点击的时候，上面的文本框中会显示相应的记录，这主要是对treeview进行了设置，代码如下：
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
On Error Resume Next
Text1.Text = TreeView1.SelectedItem.Text
Combo1.Text = TreeView1.SelectedItem.Parent
Text6.Text = TreeView1.SelectedItem.Text
Text7.Text = TreeView1.SelectedItem.Parent
End Sub
(3)班级设置
①班级设置效果图
图4.6班级设置
②界面制作与实现方法
此界面制作与公寓设置基本一致。在这个界面中主要用到了一个Sstab控件与一个显示表中内容的Datagrid控件。以及起到美观作用的Frame控件。
在右下角的文本框中可以输入想要添加的班级名称。然后点击添加即可完成添加操作。Datagrid中会立即刷新显示更新内容。要修改某条记录时，要先对所要修改的记录进行选择，确认选择后，点击下面的修改按钮，会在下面的文本中显示出所要修改班级的名称，此时即可输入要修改的名字。然后点击更新就会完成此操作。Datagrid也会即时更新其内容。删除操作更为简单，选择想要删除的班级名称，点击删除，确认后完成此操作。
添加班级源码：
Adodc3.Recordset.Find "class='" & Text4.Text & "'"
If Adodc3.Recordset.EOF = False Then
MsgBox "此班级已存在", , "提示"
Adodc3.Recordset.MoveFirst
Exit Sub
End If
Text5.Text = ""
If Text4.Text = "" Then
MsgBox "输入所要添加班级的名称", , "提示"
Exit Sub
End If
Adodc3.Recordset.AddNew
Adodc3.Recordset.Fields("class") = Text4.Text
Adodc3.Recordset.Update
Adodc3.RecordSource = "class"
Text4.Text = ""
Set DataGrid3.datasource = Adodc3
DataGrid3.Refresh
修改班级源码：
If Command10.Caption = "修改" Then
Text4.Text = Text5.Text
Label6.Caption = "输入想要修改的班级名称"
Command10.Caption = "更新"
Command6.Enabled = False
Command9.Enabled = False
ElseIf Command10.Caption = "更新" Then
Command9.Enabled = True
Command6.Enabled = True
Label6.Caption = "输入想要添加的班级名称"
Adodc3.Recordset.Fields("class") = Text4.Text
Adodc3.Recordset.Update
Command10.Caption = "修改"
End If
删除班级源码：
If Text5.Text = "" Then
MsgBox "选择所要删除班级的名称", , "提示"
Exit Sub
End If
If (MsgBox("你真的想删除班级名称 为 " & Text5.Text & " 的记录吗？", vbOKCancel, "系统提示")) = vbOK Then
Adodc3.Recordset.Delete
Adodc3.Recordset.Update
End If
Text5.Text = ""
Set DataGrid3.datasource = Adodc3
DataGrid3.Refresh
End Sub
4.3.3数据备份：
数据备份是一个数据库软件必不可少的一部分，利用它可以把当前数据库表进行全面的备份，以备以后使用。因为在操作中可能会导致数据遭到破坏，或者是系统的原因使数据库损坏，或者是一些其它的人为原因，这样你可以用此功能把数据恢复到最后一次备份的状态，使损失做到最少，经常备份，操作起来更有安全感。
①数据备份效果图
图4.7数据备份效果图
② 功能实现
界面制作相对程序来说比较简单，用到的是coolbar控件，点击按钮可以选择备份路径。然后点击数据备份即可。
窗体初始化部分代码如下：
Dim cnn1 As ADODB.Connection
Dim rstschema As ADODB.Recordset
Dim strcnn As String
Set cnn1 = New ADODB.Connection
strcnn = "provider=Microsoft.jet.oledb.4.0;" & "data source=" & App.Path & "\db.mdb"
cnn1.Open strcnn
Set rstschema = cnn1.OpenSchema(adSchemaTables)
Do Until rstschema.EOF
temp = rstschema!Table_Name
If Left(temp, 1) <> "M" Then
End If
rstschema.MoveNext
Loop
cnn1.Close
On Error GoTo err
PathName = App.Path & "\db.MDB"
dbasize = FileLen(PathName)
err:
Exit Sub
数据备份部分在本程序中用到了一个模块，在模块中有一个方法，dobackup。点击备份按钮后开始备份，代码如下：
If txtDestination <> "" Then
DoBackup PathName, txtDestination
MsgBox "备份成功！", , "提示"
ElseIf txtDestination = "" Then
MsgBox "You must specify a distination for the backup", vbCritical
其中DoBackup为模块中已定义的方法，在这里进行调用。
Dobackup实现方法代码如下所示：
Dim lFileOp As Long
Dim lresult As Long
Dim lFlags As Long
Dim SHFileOp As SHFILEOPSTRUCT
Dim strSourceDir As String
Dim strDestinationDir As String
Screen.MousePointer = vbHourglass
BackupFolderName = strDestinationPath
MkDir BackupFolderName & "\Backup - " & Format(Date, "yyyy.mm.dd")
lFileOp = FO_COPY
lFlags = lFlags And Not FOF_SILENT
lFlags = lFlags Or FOF_NOCONFIRMATION
lFlags = lFlags Or FOF_NOCONFIRMMKDIR
lFlags = lFlags Or FOF_FILESONLY
With SHFileOp
.wFunc = lFileOp
.pFrom = strSourcePath & vbNullChar
.pTo = strDestinationPath & "\Backup - " & Format(Date, "yyyy.mm.dd") & vbNullChar
.fFlags = lFlags
End With
lresult = SHFileOperation(SHFileOp)
Screen.MousePointer = vbDefault
frmBackupDba.lblStatus = "Backup Complete"
在备份分前先要选择一个备份路径，点击…那个按钮开始进行选择，实现方法如下：
Dim strTemp As String
strTemp = fBrowseForFolder(Me.hwnd, "Select backup path")
If strTemp <> "" Then
txtDestination = strTemp
End If
数据恢复界面同上，它的功能主要是在当前数据库遭到破坏后，可以利用它来进行数据恢复，在数据恢复前要选择所要恢复的数据库路径，如下：
Dim strTemp As String
strTemp = fBrowseForFolder(Me.hwnd, "Restore From")
If strTemp <> "" Then
txtSource = strTemp
dbasize2 = FileLen(txtSource & "\db.MDB")
lblSelectedDba = "Selected Backup Database is : " & Format((dbasize2 / 1024) / 1024, "standard") & "MB."
cmdRestore.Enabled = True
End If
Erro:
Select Case err.Number
Case 53 'File Not Found
lblSelectedDba = "No Backup at this location"
Toolbar2.Enabled = False
End Select
它主要是查看数据库是否存在，如果所恢复的数据不存在，则会提示错误。
数据恢复也用到了一个方法，在模块中也已经定义了该方法DoRestore。数据恢复代码如下：
If MsgBox("Restoring database from location " & txtSource & " will replace existing database files.Do you want to Contunue", vbYesNo) = vbYes Then
DoRestore txtSource.Text, App.Path
If NoDba = True Then
MsgBox "Database Restored Click Ok to Exit Program"
frmRestoreDba.Hide
Unload frmRestoreDba
End If
Else
lblStatus.Caption = "Database Restore Canceled"
End If
其中DoRestore实现的功能源码如下所示：
DEFSOURCE = "ROVIDER=Microsoft.jet.oledb.4.0ersist Security Info=False;Data Source="
DBName = "\db.MDB;Jet OLEDBatabase Password=matrix-se;"
Set Db = New ADODB.Connection
Db.Open DEFSOURCE & App.Path & DBName
Dim lFileOp As Long
Dim lresult As Long
Dim lFlags As Long
Dim SHFileOp As SHFILEOPSTRUCT
Dim strSourceDir As String
Dim strDestinationDir As String
Db.Close
Screen.MousePointer = vbHourglass
BackupFolderName = strDestinationPath
lFileOp = FO_COPY
lFlags = lFlags And Not FOF_SILENT
lFlags = lFlags Or FOF_NOCONFIRMATION
lFlags = lFlags Or FOF_NOCONFIRMMKDIR
lFlags = lFlags Or FOF_FILESONLY
With SHFileOp
.wFunc = lFileOp
.pFrom = strSourcePath & "\db.MDB" & vbNullChar
.pTo = strDestinationPath & vbNullChar
.fFlags = lFlags
End With
lresult = SHFileOperation(SHFileOp)
Set Db = New ADODB.Connection
Db.Open DEFSOURCE & App.Path & DBName
Screen.MousePointer = vbDefault
frmRestoreDba.lblStatus = "Restore Complete"
说明：本程序中此部分内容参考了网上的同类型代码，对其进行修改后得到此成型作品，从功能上来讲，它已经实现了它所要完成的工作，经过测试已经没有问题，但是实现的源代码，也只有部分掌握。这实属本人精力与能力有限所置。
4.3.4 数据转换
这个功能可以把当前列表框中的任何一个表转换成excel形式，转换后你可以看到表中的内容，也可以对表进行操作，保存，修改，打印等。
①界面效果图
图4.8数据转换效果图
②实现方法
在这里用到了一个显示gif图片的控件。选择左面list中的一个表后，点击导出后即可完成，进度条中显示当前转换进度程度。
首先要在list中加载各表名。以便进行选择转换。添加表名部分在load进行加载，其中的导出与取消按钮是由coolbar制作而成。
Form的load事件处理内容如下：
TMaxAni1.FileName = App.Path & "\icon\find.gif"
TMaxAni1.ShowGif
Dim cnn1 As ADODB.Connection
Dim rstschema As ADODB.Recordset
Dim strcnn As String
Set cnn1 = New ADODB.Connection
strcnn = "provider=Microsoft.jet.oledb.4.0;" & "data source=" & App.Path & "\db.mdb"
cnn1.Open strcnn
Set rstschema = cnn1.OpenSchema(adSchemaTables)
Do Until rstschema.EOF
temp = rstschema!Table_Name
If Left(temp, 1) <> "M" Then
List2.AddItem temp
End If
rstschema.MoveNext
Loop
cnn1.Close
List2.ListIndex = 0
On Error GoTo err
PathName = App.Path & "\db.MDB"
dbasize = FileLen(PathName)
数据转换成excel用到了一个部件，在引用中用到了Microsoft Excel9.0 Object library。转换代码如下：
Select Case Button.Index
Case 1
Dim provider As String
Dim datasource As String
provider = "provider=Microsoft.jet.oledb.4.0"
datasource = "data source=" & App.Path & "\DB.mdb"
With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = List2.Text
.Refresh
End With
ProgressBar1.Max = Adodc1.Recordset.RecordCount
ProgressBar1.Min = 0
'开始转换
Dim Irow, Icol As Integer
Dim Irowcount, Icolcount As Integer
Dim Fieldlen()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.add
Set xlSheet = xlBook.Worksheets(1)
With Adodc1.Recordset
.MoveLast
If .RecordCount < 1 Then
MsgBox ("Error!")
Exit Sub
End If
Irowcount = .RecordCount
Icolcount = .Fields.Count
ReDim Fieldlen(Icolcount)
.MoveFirst
For Irow = 1 To Irowcount + 1
For Icol = 1 To Icolcount
Select Case Irow
Case 1
xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1).Name
Case 2
If IsNull(.Fields(Icol - 1)) = True Then
Fieldlen(Icol) = LenB(.Fields(Icol - 1).Name)
Else
Fieldlen(Icol) = LenB(.Fields(Icol - 1))
End If
xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
Case Else
Fieldlen1 = LenB(.Fields(Icol - 1))
If Fieldlen(Icol) < Fieldlen1 Then
xlSheet.Columns(Icol).ColumnWidth = Fieldlen1
Fieldlen(Icol) = Fieldlen1
Else
xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
End If
xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
End Select
Next
If Irow <> 1 Then
If Not .EOF Then .MoveNext
ProgressBar1.Value = ProgressBar1.Value + 1
End If
Next
With xlSheet
.Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Name = "黑体"
.Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Bold = True
.Range(.Cells(1, 1), .Cells(Irow, Icol - 1)).Borders.LineStyle = xlContinuous
End With
xlApp.Visible = True
' xlBook.Save
'xlBook.Close
Set xlApp = Nothing
Adodc1.Recordset.ActiveConnection = Nothing
End With
Toolbar4.Buttons(1).Enabled = False
Case 2
Unload Me
End Select
4.4公寓管理
4.4.1学生请假
学生请假与违规在一个公寓管理中是最常见的问题了，所以在此软件中加上了这两项功能。用它们可以随时记录请假记录。
①学生请假记录图片显示
图4.9学生请假效果图
② 界面制作与实现
此界面主要是对学生请假记录做一个添加。利用它可以把学生的基本的请假资料保存起来。其中的日期是系统当前的日期，它是不可以进行更改的，然后在其它文本框中输入其它详细资料即可以。这里的添加操作用的是Adodc控件，所有的文本框在初始的时候没有同Adodc绑定，而是在代码中与数据库中表的字段进行的绑定，然后进行添加操作。这样做在使用的时候有很大的方便之处。第一是窗体在初始化时不会显示任何记录，不用设置文本框为空等一系列的操作。第二是当进行记录输入时，发现问题不用输入时，不按添加按钮记录就不会进行添加。注意的是，在添加前要确定所有的文本框都要进行详细填写，否则会提示输入详细信息。添加主要代码如下：
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Or Text7.Text = "" Or Text8.Text = "" Or Text9.Text = "" Then
MsgBox "请输入详细信息！", , "系统提示"
Else
With Adodc1
.Recordset.AddNew
.Recordset.Fields(0).Value = Text1.Text
.Recordset.Fields(1).Value = Text2.Text
.Recordset.Fields(2).Value = Text3.Text
.Recordset.Fields(3).Value = Text4.Text
.Recordset.Fields(4).Value = Text5.Text
.Recordset.Fields(5).Value = Text6.Text
.Recordset.Fields(6).Value = Text7.Text
.Recordset.Fields(7).Value = Text8.Text
.Recordset.Fields(8).Value = Text9.Text
.Recordset.Update
End With
Set main.DataGrid1.datasource = Adodc1
main.DataGrid1.Refresh
End If
4.4.2学生违规
①学生违规记录图片显示
图4.10学生违规效果图
此界面与上面的请假记录差不多。它主要是对学生的违规记录做一个添加。其中的日期也是系统当前的日期，它是不可以进行更改的，然后在其它文本框中输入其它详细资料即可以这里的违规操作用的也是Adodc控件，所有的文本框在初始的时候也没有同Adodc绑定，它也是在代码中与数据库中表的字段进行的绑定，然后进行添加操作。其它操作同上面基本是一致的，对于违规在主界面的左侧并没有快速显示操作，只可以用记录查看里面的违规查看进行选择查看。在这里所添写的记录也要全面一些，主要是为了以后查找更为方便，如果不全，系统会提示的！
②违规部分代码如下：
在load事件里对数据库链接的处理，以及日期文本框的设置，代码如下：
provider = "provider=Microsoft.jet.oledb.4.0"
datasource = "data source=" & App.Path & "\DB.mdb"
With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "qingjia"
.Refresh
End With
Text1.Text = Date
Text1.Enabled = False
确定无误后，进行添加，代码如下：
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Or Text7.Text = "" Or Text8.Text = "" Or Text9.Text = "" Then
MsgBox "请输入详细信息！", , "系统提示"
Else
With Adodc1
.Recordset.AddNew
.Recordset.Fields(0).Value = Text1.Text
.Recordset.Fields(1).Value = Text2.Text
.Recordset.Fields(2).Value = Text3.Text
.Recordset.Fields(3).Value = Text4.Text
.Recordset.Fields(4).Value = Text5.Text
.Recordset.Fields(5).Value = Text6.Text
.Recordset.Fields(6).Value = Text7.Text
.Recordset.Fields(7).Value = Text8.Text
.Recordset.Fields(8).Value = Text9.Text
.Recordset.Update
End With
Set main.DataGrid1.datasource = Adodc1
main.DataGrid1.Refresh
4.5卫生检查
公寓卫生可以说是一个公寓管理中最常见到的问题了。公寓卫生每天要清扫，寝室卫生每天要检查，但是如果这些都用纸来进行填写，一定会十分麻烦，且保存也不是十分方便，在一些评比中也会忙的很遭。所以在这个软件中编写了此功能。
4.5.1 公寓卫生添加效果图
图4.11公寓卫生添加效果图
①在这个界面中主要用到了文本框以及起到美观作用的frame控件。
日期已经设置成只读属性，检查记录的日期是不能随便改写的。公寓名称可以在下拉列表框中进行选择，如果在下拉列表框中没有发现，可以人工输入，但是要确定公寓名称的正确性。寝室名称需要自己输入。这里的卫生标准一共有五项可以填写，在每一项里已经基本设置了所不全标准的记录，你可以在下拉列表框中进行选择即可，但是如果没有你想输入的记录的话，你也可以自己输入。输入完成后，在减分后面的文本框中输入一共要对此寝室减掉的分数，单击得分后面的文本框会自动算出应该得到的分数。然后跟据得分的分数，你要选择该寝室的卫生等级，卫生等级为必选值且为固定值，正确的选择此项可以在主界面的左侧中快速对卫生等级进行查看。
②公寓选择栏中代码的实现：
Combo3.Clear
Dim I As Integer
I = 1
If Adodc1.Recordset.RecordCount <> 0 Then
Do While I < Adodc1.Recordset.RecordCount
Combo3.AddItem (Adodc1.Recordset.Fields("公寓名称"))
Adodc1.Recordset.MoveNext
I = I + 1
Loop
End If
卫生选择栏中的代码实现基本同上，它也是一个表中的字段值！
Dim J As Integer
J = 1
If Adodc4.Recordset.RecordCount <> 0 Then
Do While J < Adodc4.Recordset.RecordCount
Combo2.AddItem (Adodc4.Recordset.Fields("等级"))
Adodc4.Recordset.MoveNext
J = J + 1
Loop
End If
Combo2.Text = "优秀"
不合标准的卫生记录填写情况如下：
Combo4.AddItem ("门窗不干净")
Combo4.AddItem ("地面不干净")
Combo4.AddItem ("阳台不干净")
Combo4.AddItem ("床铺不整齐")
Combo4.AddItem ("不叠被")
Combo4.AddItem ("桌面不整齐")
Combo4.AddItem ("书柜摆放不整齐")
由于此窗体中涉及到公寓与寝室，在填写时要确定其名称的正确，所以在添加记录前要对它们进行检查，如发现不存在的记录，则显示提示。检查记录时用的是adodc中的find命令。类似于用户登录时的判断，同样记录的输入也要详细。代码如下：
Adodc1.Refresh
Adodc1.Recordset.Find "公寓名称='" & Combo3.Text & "'"
If Adodc1.Recordset.EOF = True Then
MsgBox "查无此公寓", , "提示"
Adodc1.Recordset.MoveFirst
Exit Sub
End If
Adodc3.Refresh
Adodc3.Recordset.Find "寝室='" & Text5.Text & "'"
If Adodc3.Recordset.EOF = True Then
MsgBox "查无此寝室", , "提示"
Adodc3.Recordset.MoveFirst
Exit Sub
End If
If Combo3.Text = "" Or Combo2.Text = "" Or Text5.Text = "" Or Text2.Text = "" Or Text3.Text = "" Then
MsgBox "请输入详细信息！", , "系统提示"
Else
确认一切无误后，开始对所填写记录进行添加并显示：
With Adodc2
.Recordset.AddNew
.Recordset.Fields(0).Value = Combo3.Text
.Recordset.Fields(1).Value = Text5.Text
.Recordset.Fields(2).Value = Combo4.Text
.Recordset.Fields(3).Value = Combo5.Text
.Recordset.Fields(4).Value = Combo6.Text
.Recordset.Fields(5).Value = Combo7.Text
.Recordset.Fields(6).Value = Combo8.Text
.Recordset.Fields(7).Value = Text2.Text
.Recordset.Fields(8).Value = Text3.Text
.Recordset.Fields(9).Value = Combo2.Text
.Recordset.Fields(10).Value = Text4.Text
.Recordset.Fields(11).Value = Text1.Text
.Recordset.Update
End With
Set main.DataGrid1.datasource = Adodc2
main.DataGrid1.Refresh
4.6 公寓资产
公寓资产可以及时对公寓里进出财务进行统计，以免遗忘，造成不必要的损失或不必要的麻烦，它的实现方法基本同上面的卫生记录的添加，相对比来说比上面的简单一些。不足的是目前只做出了入库管理，对于出库记录还没有实现。
4.6.1公寓资产添加设置效果图
图4.12公寓资产添加效果图
4. 6. 2 界面制作与实现方法
日期的设置同上面一样，只读属性。公寓名称与寝室名称要人工输入，没有选择，这是因为考虑到它不会像卫生记录那样每天要添加一次，每次要添加很多，所以为了减少系统进程，它没有使用combo，没有在窗体中进行加载。窗体中的数量与单价在填写之后会自动把总价格计算出来，类似于上图中的得分一样。部分代码如下：
If Text5.Text = “” Or Text2.Text = “” Or Text3.Text = “” Then
MsgBox “请输入详细信息！”, , “提示”
Else
With Adodc1
.Recordset.AddNew
.Recordset.Fields(0).Value = Text1.Text
.Recordset.Fields(1).Value = Text8.Text
.Recordset.Fields(2).Value = Text2.Text
.Recordset.Fields(3).Value = Text3.Text
.Recordset.Fields(4).Value = Text4.Text
.Recordset.Fields(5).Value = Text5.Text
.Recordset.Fields(6).Value = Text6.Text
.Recordset.Fields(7).Value = Text7.Text
.Recordset.Update
End With
Set main.DataGrid1.datasource = Adodc1
main.DataGrid1.Refresh
Text2.Text = “”
Text3.Text = “”
Text4.Text = “”
Text5.Text = “”
Text6.Text = “”
Text7.Text = “”
End If
4.7记录查看
记录查看可以让你对已录入的记录进行各种符合条件的查找，显示符合条件的记录。这里主要包括四个方面的查看：卫生查看、请假查看、违规查看、资产查看。下面分别介绍。
4.7.1 卫生查看
①界面效果图
图4.13卫生查看效果图
②界面制作与实现方法
这是一个比较简单的窗体操作。看起来精简、小巧。它主要的功能是对已经录入的卫生记录进行符合条件的查询。在查询类别中选择可以选择全部查看以及按日期查看。查看全部即显示所有记录，选择按日期查看后在下面的列表框中选择所要查看的日期，点击确定后即可以看到该日期的记录。
在进行查询前，要对所操作的表进行绑定，代码如下：
Dim s As String
provider = "provider=Microsoft.jet.oledb.4.0"
datasource = "data source=" & App.Path & "\DB.mdb"
With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "weigui"
.Refresh
End With
日期后面的下拉列表框中可以显示出所有已经录入记录的日期，它是通过对当前表进行分类查询后得到的结果，然后将其添加在combo中，实现代码如下：
s = "select distinct 日期 from weisheng"
With Adodc2
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdText
.RecordSource = s
.Refresh
End With
For I = 1 To Adodc2.Recordset.RecordCount
Combo1.AddItem (Adodc2.Recordset.Fields("日期"))
Adodc2.Recordset.MoveNext
Next
查看全部，即把当前表中的记录全部赋给当前用来显示的表格，按日期查看，则是在表中先进行查询，然后对结果进行重绑定，在赋值。它们的判断主要是通过单选框的选取来完成的，实现方法如下：
s = Combo1.Text
If Option1.Value = True Then
Set main.DataGrid1.datasource = Adodc1
main.DataGrid1.Refresh
ElseIf Option2.Value = True Then
sql = "select * from weisheng where 日期='" & Trim(s) & "'"
With Adodc3
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdText
.RecordSource = sql
.Refresh
End With
Set main.DataGrid1.datasource = Adodc3
main.DataGrid1.Refresh
End If
Unload Me
4.7.2其它记录查看
在记录查看中还有其它三项查看方式，分别是请假、违规、资产三项记录查看。它们的实现方法与窗体与上面的卫生查看基本相同。
①请假查看
图4.14请假查看效果图
用它可以对当前所有记录以及有效日期内的记录进行查看。
代码如下：
Dim sql As String
Dim s As String
s = Combo1.Text
If Option1.Value = True Then
Set main.DataGrid1.datasource = Adodc1
main.DataGrid1.Refresh
ElseIf Option2.Value = True Then
sql = "select * from qingjia where 日期='" & Trim(s) & "'"
With Adodc3
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdText
.RecordSource = sql
.Refresh
End With
Set main.DataGrid1.datasource = Adodc3
main.DataGrid1.Refresh
End If
Unload Me
在窗体的load中要设置已经添加的日期，需要对表进行条件查询，代码如下：
s = "select distinct 日期 from qingjia"
With Adodc2
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdText
.RecordSource = s
.Refresh
End With
For I = 1 To Adodc2.Recordset.RecordCount
Combo1.AddItem (Adodc2.Recordset.Fields("日期"))
Adodc2.Recordset.MoveNext
Next
②违规查看
图4.15违规查看效果图
目前此类功能还不是十分理想，有些查看方式会在以后的程序中进行升级。
在Load事件设置了窗体运行时所有需要的东西。
代码如下：
Option1.Value = True
Dim s As String
provider = "provider=Microsoft.jet.oledb.4.0"
datasource = "data source=" & App.Path & "\DB.mdb"
With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "weigui"
.Refresh
End With
s = "select distinct 日期 from weigui"
With Adodc2
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdText
.RecordSource = s
.Refresh
End With
For I = 1 To Adodc2.Recordset.RecordCount
Combo1.AddItem (Adodc2.Recordset.Fields("日期"))
Adodc2.Recordset.MoveNext
Next
查看部分的源代码如下：
Dim sql As String
Dim s As String
s = Combo1.Text
If Option1.Value = True Then
Set main.DataGrid1.datasource = Adodc1
main.DataGrid1.Refresh
ElseIf Option2.Value = True Then
sql = "select * from weigui where 日期='" & Trim(s) & "'"
With Adodc3
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdText
.RecordSource = sql
.Refresh
End With
Set main.DataGrid1.datasource = Adodc3
main.DataGrid1.Refresh
End If
Unload Me
③资产查看
图4.16资产查看效果图
在Load事件设置了窗体运行时所有需要的东西。
代码如下：
On Error Resume Next
Option1.Value = True
Dim s As String
provider = "provider=Microsoft.jet.oledb.4.0"
datasource = "data source=" & App.Path & "\DB.mdb"
With Adodc1
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdTable
.RecordSource = "zichan"
.Refresh
End With
s = "select distinct 日期 from zichan"
With Adodc3
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdText
.RecordSource = s
.Refresh
End With
For I = 1 To Adodc3.Recordset.RecordCount
Combo1.AddItem (Adodc3.Recordset.Fields("日期"))
Adodc3.Recordset.MoveNext
Next
查看部分代码如下所示：
On Error Resume Next
Dim sql As String
Dim s As String
s = Combo1.Text
If Option1.Value = True Then
Set main.DataGrid1.datasource = Adodc1
main.DataGrid1.Refresh
ElseIf Option2.Value = True Then
sql = "select * from zichan where 日期='" & Trim(s) & "'"
With Adodc2
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdText
.RecordSource = sql
.Refresh
End With
Set main.DataGrid1.datasource = Adodc2
main.DataGrid1.Refresh
End If
Call dx1
Unload Me
4.8记录删除
删除是一个数据库软件中最基本的操作之一。在本软件的工具栏中也有一个删除按钮，其功能也是将所找到的记录删除，但是它每次只能删除一条记录，且此删除记录的前提是在右侧的显示中容易找出，即记录不多的情况下使用。如果一旦数据记录很多，一条条查找比较不方便时，即可以使用此窗体进行删除。这里的删除也有四个窗体，分别为卫生删除、请假删除、违规删除、资产删除。下面分别介绍。
4.8.1 卫生删除
①效果图
图4.17卫生删除效果图
②界面制作与实现方法
这个界面总体来说各个控件比较简单，但是作为一个删除操作，它已经连接到了数据库，与数据库的表相联。且有三种删除记录方式可以选择。
默认为单条删除，选择此项后需要在日期中选择所删除记录的添加日期，以及所在的公寓与寝室，当这三条全部符合要求后，在表中进行查找，找到后确认删除。选择批量删除后，在下面只有一个日期可以选择，这样将会把所选日期内的所有记录都将删除掉，所以称其为批量删除。全部即是把当前表清空，全部删除掉，建议使用此操作前对当前数据库进行备份处理，否则数据将不会恢复。首先要进行数据库连接，如上面例子所示，这里就不在介绍，接下来要对本窗体中的日期进行加载，如下所示：
s = "select distinct 日期 from weisheng"
With Adodc2
.Mode = adModeReadWrite
.ConnectionString = provider & ";" & datasource
.CommandType = adCmdText
.RecordSource = s
.Refresh
End With
For I = 1 To Adodc2.Recordset.RecordCount
Combo1.AddItem (Adodc2.Recordset.Fields("日期"))
Combo2.AddItem (Adodc2.Recordset.Fields("日期"))
Adodc2.Recordset.MoveNext
Next
Option1.Value = True
Frame3.Visible = True
Frame5.Visible = False
Frame6.Visible = False
在单条删除前要确定所有条件符合要求，单条删除操作的代码主要部分如下：
If (MsgBox("你真的想删除日期为 " & Combo1.Text & " 公寓为 " & Text1.Text & " 寝室为 " & Text2.Text & " 的记录吗？", vbOKCancel, "系统提示")) = vbOK Then
Adodc1.Refresh
Adodc1.Recordset.ActiveConnection.Execute "delete from weisheng where 日期='" &
Trim(s) & "'and 公寓='" & Trim(Text1.Text) & "'and 寝室='" & Trim(Text2.Text) & "'" ', , adExecuteNoRecords
Adodc1.Recordset.Update
Combo1.Text = ""
Text1.Text = ""
Text2.Text = ""
MsgBox "删除成功", , "系统提示"
End If
Unload Me
当选择某一日期后进行批量删除代码如下：
If (MsgBox("你真的想删除日期为 " & Combo2.Text & " 的记录吗？", vbOKCancel, "系统提示")) = vbOK Then
Adodc1.Refresh
Adodc1.Recordset.ActiveConnection.Execute "delete from weisheng where 日期='" & Trim(Combo2.Text) & "'"
Combo2.Text = ""
MsgBox "删除成功", , "系统提示"
End If
Unload Me
清空数据表代码为：
If (MsgBox("你真的想删除所有的记录吗？一旦删除即不可恢复", vbOKCancel, "系统提示")) = vbOK Then
For I = 1 To Adodc1.Recordset.RecordCount
Adodc1.Recordset.Delete
Adodc1.Recordset.MoveNext
Next I
End If
MsgBox "删除成功", , "系统提示"
Unload Me
4.8.2请假记录
①效果图
图4.19违规记录删除效果图
②界面制作与实现方法
违规删除操作与请假删除操作基本一致，不同之处只是在于后台对不同的表进行处理，前台界面大体相同。其实现方法与上现的也差不太多，这里就不在叙述。
单条删除记录：
Dim sql As String
Dim s As String
Dim panduan As Boolean
If Combo1.Text = "" And Text1.Text = "" And Text2.Text = "" Then
MsgBox "请输入删除条件!", , "提示"
Exit Sub
End If
s = Combo1.Text
If (MsgBox("你真的想删除日期为 " & Combo1.Text & " 公寓为 " & Text1.Text & " 寝室为 " & Text2.Text & " 姓名为 " & Text3.Text & " 的违规记录吗？", vbOKCancel, "系统提示")) = vbOK Then
Adodc1.Refresh
Adodc1.Recordset.ActiveConnection.Execute "delete from weigui where 日期='" & Trim(s) & "'and 公寓='" & Trim(Text1.Text) & "'and 寝室='" & Trim(Text2.Text) & "' and 姓名='" & Trim(Text3.Text) & "'" ', , adExecuteNoRecords
Adodc1.Recordset.Update
Combo1.Text = ""
Text1.Text = ""
Text2.Text = ""
MsgBox "删除成功", , "系统提示"
End If
Unload Me
成批删除记录：
If (MsgBox("你真的想删除日期为 " & Combo2.Text & " 的记录吗？", vbOKCancel, "系统提示")) = vbOK Then
Adodc1.Refresh
Adodc1.Recordset.ActiveConnection.Execute "delete from weigui where 日期='" & Trim(Combo2.Text) & "'"
Combo2.Text = ""
MsgBox "删除成功", , "系统提示"
End If
Unload Me
删除所有记录：
If (MsgBox("你真的想删除所有的记录吗？一旦删除即不可恢复", vbOKCancel, "系统提示")) = vbOK Then
For I = 1 To Adodc1.Recordset.RecordCount
Adodc1.Recordset.Delete
Adodc1.Recordset.MoveNext
Next I
End If
MsgBox "删除成功", , "系统提示"
Unload Me
4.8.4 资产删除
①效果图
图4.21值班记录效果图
② 实现思想与功能
此窗体的功能以及其源代码是经过修改之后而形成的，源文件是一个电子记事本，发现后经过修改后做出一个日记本。
在上面的日期后面的文本框中，你可以输入如窗口标题后面所示的日期格式后，点击查看，即可以查看到所选日期的详细记录。这是一种查询方法，当然你也可以用右面简单的上一条与下一条进行快速查看，但是它只能查看当日日期起开始的记录，如果与你所想要查看的日期相差很远，那么你就需要使用第一种方法了。
这个日记本还支持修改与删除功能。当你想编辑或删除某一日期的时候时，你需要用查看方法找到该记录，然后对当前记录使用编辑或删除即可完成操作。删除后，记录即不可恢复，且此日记目前还没有备份功能，慎重操作。
如果你今天值班，还没有写值班记录，那么你可以点击增加按钮，开始写当日的值班记录，说明的是，每天只可以写一次记录。当你写完今天记录后，在点击增加时会提示你今日已写完。但是你可以对今日记录进行编辑修改。
本程序源码较为复杂，主要都是对文件进行操作，并没有把记录添加到数据库中，所以不支持备份操作，且本窗体中的操作程序还用到了一个模块。部分代码如下：
查看上一条记录：
If giCurrentRecord > 1 Then
giCurrentRecord = giCurrentRecord - 1
ReadData (giCurrentRecord)
End If
查看下一条记录：
If giCurrentRecord < giRecordCount Then
giCurrentRecord = giCurrentRecord + 1
ReadData (giCurrentRecord)
End If
查询数据：
Dim I%
For I = 1 To giRecordCount
If goDiarys(I).fldDate = sql Then
giCurrentRecord = I
FindData = True
Exit For
End If
Next
ReadData giCurrentRecord
修改数据：
Dim iFreefile%, I%
iFreefile = FreeFile()
Open gsPath & "DATA.DAT" For Random As #iFreefile Len = Len(goDiary)
goDiarys(giCurrentRecord).fldDate = frminput.txtDate
goDiarys(giCurrentRecord).fldMemo = frminput.txtMemo
goDiary = goDiarys(giCurrentRecord)
Put #iFreefile, giCurrentRecord, goDiary
ReadData (giCurrentRecord)
Close #iFreefile
ModifyData = True
删除日记中的记录：
If txtDate = "" Then
MsgBox "请选择记录!", , "每日一记"
Exit Sub
End If
Dim Result
If giRecordCount = 0 Then Exit Sub
Result = MsgBox("确定删除记录吗？不可恢复", vbQuestion + vbYesNo, "电子日记本")
If Result = vbYes Then
DeleteData
gbFirst = False
If giCurrentRecord > 1 Then giCurrentRecord = giCurrentRecord - 1
Form_Load
End If
4.9.2 增加记录
①增加记录效果图
图4.22增加记录效果图
② 实现思想与程序源码
日期后显示当前日期，但是可以修改。每篇记录的字数要求在1000字以内。支持对当前字符输入的统计，确定完成本日记录后，点击保存即可。
部分代码如下：
Dim bSaved As Boolean, bCF
If txtDate = "" Or txtMemo = "" Then Exit Sub ' 如果记录未填,则退出
If riji.Tag = "addnew" Then
If giRecordCount >= 1 Then '新增时,检查记录是否重复
gsSql = frminput.txtDate
bCF = FindData(gsSql)
If bCF Then
MsgBox "今天你已经写过日记了!", vbExclamation + vbOKOnly, "每日一记"
txtMemo.SetFocus
Exit Sub
End If
End If
giRecordCount = giRecordCount + 1
bSaved = WriteData()
ElseIf riji.Tag = "modify" Then '
bSaved = ModifyData()
End If
If bSaved = True Then
AddNext = MsgBox("保存完毕!", vbExclamation + vbOKOnly, "每日一记")
End If
Unload Me
由于此段代码中用到了一个模块，在模块中定义了很多过程，各过程实现功能及代码如下所示：
读取数据：
Public Sub ReadData(curRecord As Integer) '读取数据
On Error Resume Next
Dim strcaption$
riji.txtDate = goDiarys(curRecord).fldDate
riji.txtMemo = goDiarys(curRecord).fldMemo
strcaption = "每日一记 [" & Date & "] " & Time & " " & WeekdayName(Weekday(Date)) & " 记录:" & giCurrentRecord & "/" & giRecordCount
riji.Caption = strcaption
End Sub
查询数据：
Public Function FindData(sql As String) As Boolean '查询数据
On Error Resume Next
Dim I%
For I = 1 To giRecordCount
If goDiarys(I).fldDate = sql Then
giCurrentRecord = I
FindData = True
Exit For
End If
Next
ReadData giCurrentRecord
End Function
新增数据：
Public Function WriteData() As Boolean '新增数据
On Error Resume Next
Dim iFreefile%, I%
iFreefile = FreeFile()
Open gsPath & "DATA.DAT" For Random As #iFreefile Len = en(goDiary)
ReDim Preserve goDiarys(giRecordCount)
goDiarys(giRecordCount).fldDate = frminput.txtDate
goDiarys(giRecordCount).fldMemo = frminput.txtMemo
goDiary = goDiarys(giRecordCount)
Put #iFreefile, giRecordCount, goDiary
giCurrentRecord = giRecordCount
ReadData (giCurrentRecord)
Close #iFreefile
WriteData = True
End Function
修改数据：
Public Function ModifyData() As Boolean '修改数据
On Error Resume Next
Dim iFreefile%, I%
iFreefile = FreeFile()
Open gsPath & "DATA.DAT" For Random As #iFreefile Len =len(goDiary)
goDiarys(giCurrentRecord).fldDate = frminput.txtDate
goDiarys(giCurrentRecord).fldMemo = frminput.txtMemo
goDiary = goDiarys(giCurrentRecord)
Put #iFreefile, giCurrentRecord, goDiary
ReadData (giCurrentRecord)
Close #iFreefile
ModifyData = True
End Function
删除数据：
Public Sub DeleteData() '删除数据
On Error Resume Next
Dim iFreefile%, I%, J%
I = 1: J = 1
iFreefile = FreeFile()
Open gsPath & "temp.dat" For Random As #iFreefile Len = Len(goDiary)
goDiarys(giCurrentRecord).fldMemo = "IWantToKillIt*" & goDiarys(giCurrentRecord).fldMemo '加删除标记
For I = 1 To giRecordCount '无删除标记的记录保存到临时文件,TEMP.DAT
If Left(goDiarys(I).fldMemo, 14) <> "IWantToKillIt*" Then
goDiary = goDiarys(I)
Put #iFreefile, J, goDiary '在此必须有I,J两个变量,因为使用二进制保存文件,
J = J + 1 '从1开始到后面,中间如有间隔就会出现乱码
End If
Next
Close #iFreefile
Kill gsPath & "data.dat"
Name gsPath & "temp.dat" As gsPath & "data.dat"
riji.txtDate = ""
riji.txtMemo = ""
End Sub
说明：由于本人能力有限，对文件部分还不算是很了解，这个功能的实现主要是借用了网上的一个电子记事本。本人只是对其做了一些修改，做成了这个每日一记，但个人认为此功能还算是可以。
4.10 Help制作
Help文档的制作也标志着本软件基本完成。制作help文档需要一个专业制作软件，本人使用的是破解版的QuickCHM，此软件无论在功能上还在是操作上用起来都是很方便。
QuickCHM软件的界面及其使用如下：
|Archiver|手机版|小黑屋|可乐分享,站长交流
( 苏ICP备2024109924号 )|网站地图
发表于 2024-9-12 10:45:16
ROVIDER=Microsoft.jet.oledb.4.0
atabase Password=matrix-se;"
发表于 2024-9-24 14:14:44