图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 = "PROVIDER=Microsoft.jet.oledb.4.0;Persist Security Info=False;Data Source="
DBName = "\db.MDB;Jet OLEDB:Database 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公寓资产添加设置效果图

上一页  [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [11] [12] [13] [14] [15]  下一页