frmmdi.frm

该软件（教师住房管理系统）能实现如下功能： 基本信息录入 基本信息浏览 基本查询 分类查询 查基本信息的添加、删除修改。分房申请信息的录入及平分 分房处理 报表生成 打印功能 帮助

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''                    教师住房管理系统   Version 1.0                    '''
'''                         （VB6.0 源代码）                             '''
'''                                                                      '''
'''                        俊彦软件工作室出品                            '''
'''                                                                      '''
'''            （浦口校区科技节“电子杯”程序设计大赛参赛作品）          '''
'''                                                                      '''
'''                程序设计：东南大学土木工程学院   周曹俊               '''
'''                                                                      '''
'''                 CopyRight AllRights Reserved (c)2003                 '''
'''                                                                      '''
'''                         2007年5月15日                                '''
'''                                                                      '''
'''                                                                      '''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub about_Click()
Load frmAbout
frmAbout.Show
End Sub

Private Sub apply_Click()
'打开申请信息项目
If Not frmtree Is Nothing Then
    Unload frmtree
End If
If Not frminfo Is Nothing Then
    Unload frminfo
End If
Load frmtree2
Load frmapply
Load frmlist
frmtree2.Show
frmapply.Show
frmlist.Show
End Sub

Private Sub backup_Click()
'备份申请信息
Dim strfilename As String
Dialog1.DialogTitle = "选择备份路径："
Dialog1.Filter = "数据库文件（*.mdb）|*.mdb"
Dialog1.ShowSave
strfilename = Dialog1.FileName
db2.close
If strfilename <> "" Then
    FileSystem.FileCopy App.Path & "\data\applyinfo.db", strfilename
End If
Set db2 = OpenDatabase(App.Path & "\data\applyinfo.db")
End Sub

Private Sub basic_Click()
'打开基本信息项目
If Not frmtree2 Is Nothing Then
    Unload frmtree2
End If
If Not frmapply Is Nothing Then
    Unload frmapply
End If
If Not frmlist Is Nothing Then
    Unload frmlist
End If
Load frmtree
Load frminfo
frmtree.Show
frminfo.Show
End Sub
Private Sub change_Click()
'改变当前用户的密码
Load frmeditpwd
If Not frmtree Is Nothing Then
    Unload frmtree
    Unload frminfo
End If
If Not frmtree2 Is Nothing Then
    Unload frmtree2
    Unload frmapply
    Unload frmlist
End If
frmeditpwd.Show 1
End Sub

Private Sub close_Click()
Call MDIForm_QueryUnload(1, 1)
End Sub

Private Sub deal_Click()
Load frmdeal
frmdeal.Show 1
End Sub

Private Sub doc_Click()
SendKeys "{f1}"
End Sub

Private Sub edit_Click()
Call frmedit
edit.Enabled = False
fresh.Enabled = True
Toolbar1.Buttons(6).Enabled = False
Toolbar1.Buttons(7).Enabled = True
End Sub

Private Sub fastwin_Click()
Load frmadd
frmadd.Show
End Sub

Private Sub find_Click()
Load frmfind
frmfind.Show 1
End Sub

Private Sub fresh_Click()
Call frmedit
edit.Enabled = True
fresh.Enabled = False
Toolbar1.Buttons(7).Enabled = False
Toolbar1.Buttons(6).Enabled = True
End Sub
Private Sub kill_Click()
'删除信息
Call infodel
End Sub
Private Sub MDIForm_Load()
Me.WindowState = 2
'初始化菜单
data.Visible = False
view.Visible = False
window.Visible = False
report.Visible = False
'初始化工具栏
Toolbar1.Buttons(4).Enabled = False
Toolbar1.Buttons(5).Enabled = False
Toolbar1.Buttons(6).Enabled = False
Toolbar1.Buttons(7).Enabled = False
Toolbar1.Buttons(9).Enabled = False
Toolbar1.Buttons(11).Enabled = False
Toolbar1.Buttons(10).Enabled = False
Toolbar1.Buttons(12).Enabled = False
Toolbar1.Buttons(13).Enabled = False
Toolbar1.Buttons(14).Enabled = False
Toolbar1.Buttons(18).Enabled = False
kill.Enabled = False
edit.Enabled = False
fresh.Enabled = False
doc.Enabled = False

App.HelpFile = App.Path & "\lm.chm"
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim a As Integer
a = MsgBox("确定退出系统吗？", vbQuestion + vbOKCancel, SYSTITLE)
If a = 2 Then
    Cancel = True
Else
'清除数据库对象
    Set db = Nothing
    Set db2 = Nothing
    End
End If
End Sub

Private Sub next_Click()
'向后浏览
Dim nodex As node
Call clearfrminfo
Set nodex = frmtree.TreeView1.SelectedItem
If nodex.Index <> frmtree.TreeView1.Nodes.Item("r7").Child.LastSibling.Index Then
    Call browserpre(frmtree.TreeView1.Nodes.Item(nodex.Index + 1))
    frmtree.TreeView1.Nodes.Item(nodex.Index + 1).Selected = True
    If frmtree.TreeView1.Nodes.Item(nodex.Index + 1).Key Like "r*" Then
        Call next_Click
    End If
End If
End Sub

Private Sub pnt_Click()
Call printrpt
End Sub

Private Sub pre_Click()
'向前浏览
Dim nodex As node
Call clearfrminfo
Set nodex = frmtree.TreeView1.SelectedItem
If nodex.Index > 2 Then
    Call browserpre(frmtree.TreeView1.Nodes.Item(nodex.Index - 1))
    frmtree.TreeView1.Nodes.Item(nodex.Index - 1).Selected = True
End If
If frmtree.TreeView1.Nodes.Item(nodex.Index - 1).Key Like "r*" Then
    Call pre_Click
End If
End Sub

Private Sub preview_Click()
Call previewrpt
End Sub

Private Sub query_Click()
Load frmquery
frmquery.Show
End Sub

Private Sub remove_Click()
'删除已处理完毕的分房信息
Dim a As Integer, b As VbMsgBoxResult, strtmp As String, i As Integer
a = MsgBox("确定清除所有申请信息吗？", vbQuestion + vbYesNo, SYSTITLE)
If a = 7 Then
    Exit Sub
End If
strtmp = "在清除申请信息之前，建议您备份申请信息。" & vbCrLf & "点击【确定】将备份所有申请信息，点击【取消】将直接删除申请信息。" & vbCrLf & "确定备份吗？"
b = MsgBox(strtmp, vbExclamation + vbOKCancel, SYSTITLE)
If b = vbCancel Then
    Call delapply
    Exit Sub
End If
Call backup_Click
Call delapply
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
'工具栏操作
Select Case Button.Index
    Case 1
        Call basic_Click
    Case 2
        Call apply_Click
    Case 4
        Static boladd1 As Boolean
        With frminfo
        If boladd1 = False Then
            Call clearfrminfo
            .Command6.Caption = "取消添加(&C)"
            .Command1.Enabled = True
            .Frame1.Enabled = True
            Toolbar1.Buttons(4).Enabled = False
            .Mask2.SetFocus
        Else
            .Command6.Caption = "添加(&A)"
            .Command1.Enabled = False
            Call clearfrminfo
            .Frame1.Enabled = False
            Toolbar1.Buttons(4).Enabled = True
        End If
        End With
        boladd1 = Not boladd1
    Case 5
        Call infodel
    Case 6
        Call frmedit
        Toolbar1.Buttons(6).Enabled = False
        Toolbar1.Buttons(7).Enabled = True
    Case 7
        Call frmedit
        Toolbar1.Buttons(7).Enabled = False
        Toolbar1.Buttons(6).Enabled = True
    Case 9
        Load frmfind
        frmfind.Show 1
    Case 10
        Load frmquery
        frmquery.Show 1
    Case 11
        Load frmadd
        frmadd.Show
    Case 14
        Call previewrpt
    Case 13
        Call printrpt
    Case 16
        Load frmadmin
        frmadmin.Show
    Case 18
        SendKeys "{f1}"
End Select
End Sub
Private Sub user_Click()
Load frmadmin
frmadmin.Show 1
End Sub
Private Sub xiao_Click()
'注销的实现
Dim a As Integer
Dim mydb As Database, myrs As Recordset
Load frmeditpwd
If Not frmtree Is Nothing Then
    Unload frmtree
    Unload frminfo
End If
If Not frmtree2 Is Nothing Then
    Unload frmtree2
    Unload frmapply
    Unload frmlist
End If
Set mydb = OpenDatabase(App.Path & "\support\login.dll")
Set myrs = mydb.OpenRecordset("login")
myrs.MoveFirst
a = MsgBox("确定注销当前用户" & myrs!Name & "，下次以其他用户身份登录吗？", vbQuestion + vbYesNo, SYSTITLE)
If a = 7 Then
    Exit Sub
End If
myrs.Delete
Set myrs = Nothing
Set mydb = Nothing
xiao.Enabled = False
user.Enabled = False
change.Enabled = False
End Sub

Private Sub delapply()
BeginTrans
    For i = 1 To 6
        db2.Execute "delete from " & CStr(i) & " where id<>''"
    Next
CommitTrans
Unload frmtree2
frmtree2.Show
End Sub