毕业论文论文范文课程设计实践报告法律论文英语论文教学论文医学论文农学论文艺术论文行政论文管理论文计算机安全
您现在的位置: 毕业论文 >> 论文 >> 正文

VB+Access学生公寓管理系统 第7页

更新时间:2007-11-6:  来源:毕业论文

 

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 = "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制作而成。

Formload事件处理内容如下:

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

上一页  [1] [2] [3] [4] [5] [6] [7] [8] [9] [10]  ... 下一页  >> 

VB+Access学生公寓管理系统 第7页下载如图片无法显示或论文不完整,请联系qq752018766
设为首页 | 联系站长 | 友情链接 | 网站地图 |

copyright©751com.cn 辣文论文网 严禁转载
如果本毕业论文网损害了您的利益或者侵犯了您的权利,请及时联系,我们一定会及时改正。