module1.bas

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

        .Text1.SetFocus
        Exit Sub
    End If
    If .DTPicker1.Value >= .DTPicker2.Value Then
        MsgBox "参加工作时间不应早于出生年月，请重新输入！", vbCritical + vbOKOnly, SYSTITLE
        .DTPicker2.SetFocus
        Exit Sub
    End If
    If .DTPicker2.Value > .DTPicker3.Value Then
        MsgBox "入住时间不应早于参加工作时间，请重新输入！", vbCritical + vbOKOnly, SYSTITLE
        .DTPicker3.SetFocus
        Exit Sub
    End If
    If IsNumeric(.Text2.Text) = False Then
        MsgBox "住房面积输入错误，请重新输入！", vbCritical + vbOKOnly, SYSTITLE
        .Text2.SetFocus
        Exit Sub
    End If
    With .MSFlexGrid1
        Do Until .TextMatrix(i, 0) = ""
            For j = 1 To 3
                If .TextMatrix(i, j) = "" Then
                    MsgBox "家庭成员信息未填写齐全！", vbCritical + vbOKOnly, SYSTITLE
                    .Row = i: .Col = j: .SetFocus
                    Exit Sub
                End If
            Next
            i = i + 1
        Loop
    End With
BeginTrans
On Error GoTo errhdl
    '开始修改
    rs2.edit
    rs2!id = .Mask2.Text
    rs2!Name = .Text1.Text
    rs2!sex = .Combo1.Text
    If .Option1(0).Value Then
        rs2!married = True
    Else
        rs2!married = False
    End If
    rs2!birth = Year(.DTPicker1.Value) & "年" & Month(.DTPicker1.Value) & "月"
    rs2!workdate = Year(.DTPicker2.Value) & "年" & Month(.DTPicker2.Value) & "月"
    rs2!zc = .Combo2.Text
    rs2!xl = .Combo3.Text
    rs2!livedgr = .Combo4.ListIndex + 1
    rs2!livearea = .Text2.Text
    rs2!indate = .DTPicker3.Value
    rs2.Update
    i = 1
    db.Execute "delete from member where id='" & strid & "'"
    Do Until .MSFlexGrid1.TextMatrix(i, 0) = ""
            rs3.AddNew
            rs3!id = .Mask2.Text
            rs3!Name = .MSFlexGrid1.TextMatrix(i, 0)
            rs3!sex = .MSFlexGrid1.TextMatrix(i, 1)
            rs3!Relation = .MSFlexGrid1.TextMatrix(i, 2)
            rs3!birth = .MSFlexGrid1.TextMatrix(i, 3)
            rs3.Update
     i = i + 1
    Loop
    MsgBox "修改成功！", vbInformation + vbOKOnly, SYSTITLE
CommitTrans
End If
boledit = Not boledit
Exit Sub
errhdl:
    If Err.Number = 3022 Then
        MsgBox "您试图添加的住户信息已经存在，请查实！", vbCritical + vbOKOnly, SYSTITLE
        Call clearfrminfo
        boledit = Not boledit
        Rollback
    Else
        MsgBox Err.Description, vbCritical + vbOKOnly, SYSTITLE
        boledit = Not boledit
    End If
End With
Exit Sub
End Sub
Public Sub infodel()
'删除记录
Dim strtext As String, strindex As Integer, strlastindex As Integer
Dim strnode As String
Dim a As Integer
a = MsgBox("确定删除该记录吗？", vbQuestion + vbYesNo, SYSTITLE)
If a = 7 Then
    Exit Sub
End If
With frmtree.TreeView1
    If .SelectedItem.Key Like "c*" Then
        strtext = .SelectedItem.Text
        strnode = .SelectedItem.Parent.Key
        db.Execute ("delete from host where id=" & "'" & strtext & "'")
        db.Execute ("delete from member where id=" & "'" & strtext & "'")
        Unload frmtree
        Load frmtree
        If .Nodes.Item(strnode).Children > 0 Then
            .Nodes.Item(strnode).Expanded = True
            .Nodes.Item(strnode).Child.Selected = True
        Else
            .Nodes.Item(strnode).Selected = True
        End If
     End If
End With
End Sub

Public Sub changefrminfo()
Dim inta As Integer, intb As Integer, conrate As Single
Dim ctrl As Control
'取得屏幕分辨率，由于是在800*600的分辨率下设计程序的，故在1024*768的分辨率下需做适当调整
inta = Screen.Width \ Screen.TwipsPerPixelX
intb = Screen.Height \ Screen.TwipsPerPixelY
conrate = inta / 800
If inta = 1024 And intb = 768 Then
    For Each ctrl In frminfo
        ctrl.Left = ctrl.Left * conrate
        ctrl.Top = ctrl.Top * conrate
        ctrl.Width = ctrl.Width * conrate
    Next
    With frminfo
        .Frame1.Height = .Frame1.Height * conrate
        .Frame2.Height = .Frame2.Height * conrate
        .Frame3.Height = .Frame3.Height * conrate
        .Frame4.Height = .Frame4.Height * conrate
    End With
End If
End Sub

Public Sub changefrmapp()
'对表单frmapply也做适当调整
Dim inta As Integer, intb As Integer, conrate As Single
Dim ctrl As Control
inta = Screen.Width \ Screen.TwipsPerPixelX
intb = Screen.Height \ Screen.TwipsPerPixelY
conrate = inta / 800
If inta = 1024 And intb = 768 Then
    For Each ctrl In frmapply
        ctrl.Left = ctrl.Left * conrate
        ctrl.Top = ctrl.Top * conrate
        ctrl.Width = ctrl.Width * conrate
    Next
    With frmapply
        .Frame1.Top = .Frame1.Top * conrate
        .Frame1.Height = .Frame1.Height * conrate
    End With
End If
End Sub

Public Sub changefrmlist()
'对表单frmlist也做适当调整
Dim inta As Integer, intb As Integer, conrate As Single, i As Integer
Dim ctrl As Control
inta = Screen.Width \ Screen.TwipsPerPixelX
intb = Screen.Height \ Screen.TwipsPerPixelY
conrate = inta / 800
If inta = 1024 And intb = 768 Then
    With frmlist
        .Frame2.Top = .Frame2.Top * conrate
        .Frame2.Height = .Frame2.Height * conrate
        .ListView1.Height = .ListView1.Height * conrate
        .Command1.Top = .Command1.Top * conrate
        .Command2.Top = .Command2.Top * conrate
        .Command3.Top = .Command3.Top * conrate
        .Command4.Top = .Command4.Top * conrate
        .Command5.Top = .Command5.Top * conrate
        .Command1.Left = .Command1.Left * conrate
        .Command2.Left = .Command2.Left * conrate
        .Command3.Left = .Command3.Left * conrate
        .Command4.Left = .Command4.Left * conrate
        .Command5.Left = .Command5.Left * conrate
        For i = 1 To 12
            .ListView1.ColumnHeaders(i).Width = .ListView1.ColumnHeaders(i).Width * conrate
        Next
    End With
    
End If
End Sub

Public Sub previewrpt()
'报表预览
Dim cmd As Command, strtmp As String
With DataEnvironment1.Connection2
    If .State = adStateClosed Then
        .Open
    Else
        .close
        .Open
    End If
End With
Set cmd = DataEnvironment1.Commands("command4")
cmd.ActiveConnection = DataEnvironment1.Connection2
cmd.CommandText = "select * from " & Right(frmtree2.TreeView1.SelectedItem.Key, 1) & " order by zf desc"
cmd.CommandType = adCmdText
strtmp = frmtree2.TreeView1.SelectedItem.Text
drapply.Sections("section4").Controls.Item("label13").Caption = Mid$(strtmp, 1, InStr(strtmp, "（") - 1) & "的教师信息一览表"
drapply.Caption = Mid$(strtmp, 1, InStr(strtmp, "（") - 1) & "的教师信息一览表——教师住房管理系统 V1.0"
drapply.Show
Set cmd = Nothing
End Sub

Public Sub printrpt()
Dim cmd As Command, strtmp As String
With DataEnvironment1.Connection2
    If .State = adStateClosed Then
        .Open
    Else
        .close
        .Open
    End If
End With
Set cmd = DataEnvironment1.Commands("command4")
cmd.ActiveConnection = DataEnvironment1.Connection2
cmd.CommandText = "select * from " & Right(frmtree2.TreeView1.SelectedItem.Key, 1) & " order by zf desc"
cmd.CommandType = adCmdText
drapply.PrintReport (True)
End Sub

Public Sub clearapp()
With frmapply
    .Maskid.Mask = ""
    .Maskid.Text = ""
    .Maskid.Mask = "?###"
    .Text1.Text = ""
    .DTPicker1.Value = Now
    .DTPicker2.Value = Now
    .Combo2.ListIndex = -1
    .Combo3.ListIndex = -1
    .Combo4.ListIndex = -1
    .Combo5.ListIndex = -1
End With
End Sub