frminfo.frm

一个能够有效管理教师（含家庭人口）的住房信息系统（含信息的添加、修改、删除等）

            Width           =   540
         End
      End
   End
End
Attribute VB_Name = "frminfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''                    教师住房管理系统   Version 1.0                    '''
'''                         （VB6.0 源代码）                             '''
'''                                                                      '''
'''                        俊彦软件工作室出品                            '''
'''                                                                      '''
'''            （浦口校区科技节“电子杯”程序设计大赛参赛作品）          '''
'''                                                                      '''
'''                程序设计：东南大学土木工程学院   周曹俊               '''
'''                                                                      '''
'''                 CopyRight AllRights Reserved (c)2003                 '''
'''                                                                      '''
'''                         2003年5月15日                                '''
'''                                                                      '''
'''                                                                      '''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim c As Integer, r As Integer, strtmp As String

Private Sub Combo4_Click()
If Trim(Mask2.Text) <> "" And Combo4.ListIndex <> Asc(Left(Mask2.Text, 1)) - 65 Then
    MsgBox "该住户的住房等级应该为：" & Combo4.List(Asc(Left(Mask2.Text, 1)) - 65), vbInformation + vbOKOnly, SYSTITLE
    Combo4.ListIndex = Asc(Left(Mask2.Text, 1)) - 65
End If
End Sub

Private Sub Command2_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 Command2_Click
End If
End Sub
Private Sub Command3_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 Command3_Click
    End If
End If
End Sub

Private Sub Command4_Click()
Call infodel
End Sub
Private Sub Command5_Click()
Call frmedit
End Sub

Private Sub Command6_Click()
Static boladd As Boolean
If boladd = False Then
    Call clearfrminfo
    Command6.Caption = "取消添加(&C)"
    Command1.Enabled = True
    Frame1.Enabled = True
    Mask2.SetFocus
    frmMDI.Toolbar1.Buttons(4).Enabled = False
Else
    Command6.Caption = "添加(&A)"
    Command1.Enabled = False
    Call clearfrminfo
    Frame1.Enabled = False
    frmMDI.Toolbar1.Buttons(4).Enabled = True
End If
boladd = Not boladd
End Sub
Private Sub Mask1_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then
    Mask1.Visible = False
    MSFlexGrid1.SetFocus
    Exit Sub
End If
If KeyAscii = vbKeyReturn Then
    MSFlexGrid1.Text = Mask1.Text
    Mask1.Visible = False
    MSFlexGrid1.SetFocus
End If
End Sub
Private Sub Mask1_LostFocus()
If Not IsDate(Mask1.Text) Then
    MsgBox "家庭成员出生年月有误！", vbCritical + vbOKOnly, SYSTITLE
    Mask1.SetFocus
    Exit Sub
End If
MSFlexGrid1.TextMatrix(r, c) = Mask1.Text
Mask1.Visible = False
MSFlexGrid1.SetFocus
End Sub
Private Sub Mask2_LostFocus()
Mask2.Text = UCase(Mask2.Text)
If Trim(Mask2.Text) <> "" And (Asc(Left(Mask2.Text, 1)) < 65 Or Asc(Left(Mask2.Text, 1)) > 71) Then
    MsgBox "住号有误，请重新输入！", vbCritical + vbOKOnly, SYSTITLE
    Mask2.Mask = ""
    Mask2.Text = ""
    Mask2.Mask = "?###"
    Mask2.SetFocus
    Exit Sub
End If
If Trim(Mask2.Text) <> "" Then
    Combo4.ListIndex = Asc(Left(Mask2.Text, 1)) - 65
End If
End Sub
Private Sub Text3_LostFocus()
Dim a As Integer
With MSFlexGrid1
.TextMatrix(r, c) = Text3.Text

Text3.Visible = False
If .TextMatrix(r, c) = "" And .TextMatrix(r, c + 1) <> "" Then
    a = MsgBox("确定删除该成员吗？", vbQuestion + vbYesNo, SYSTITLE)
    If a = 7 Then
        Text3.Width = .ColWidth(c)
        Text3.Height = .RowHeight(r)
        Text3.Left = .Left + .ColPos(c) + 50
        Text3.Top = .Top + .RowPos(r) + 50
        Text3.Visible = True
        Text3.Text = strtmp
        Text3.SetFocus
        Exit Sub
    End If
    .TextMatrix(r, c + 2) = ""
    .TextMatrix(r, c + 1) = ""
    .TextMatrix(r, c + 3) = ""
End If
.SetFocus
End With
End Sub
Private Sub Combo5_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then
    Combo5.Visible = False
    MSFlexGrid1.SetFocus
    Exit Sub
End If
If KeyAscii = vbKeyReturn Then
    MSFlexGrid1.Text = Combo5.Text
    Combo5.Visible = False
    MSFlexGrid1.SetFocus
End If
End Sub

Private Sub Combo5_LostFocus()
MSFlexGrid1.TextMatrix(r, c) = Combo5.Text
Combo5.Visible = False
MSFlexGrid1.SetFocus
End Sub

Private Sub Combo6_KeyPress(KeyAscii As Integer)
MSFlexGrid1.TextMatrix(r, c) = Combo6.Text
Combo6.Visible = False
MSFlexGrid1.SetFocus
End Sub

Private Sub Combo6_LostFocus()
MSFlexGrid1.TextMatrix(r, c) = Combo6.Text
Combo6.Visible = False
MSFlexGrid1.SetFocus
End Sub

Private Sub Command1_Click()
Call infoadd
End Sub
Private Sub DTPicker4_KeyPress(KeyAscii As Integer)
MSFlexGrid1.TextMatrix(r, c) = DTPicker4.Value
DTPicker4.Visible = False
MSFlexGrid1.SetFocus
End Sub

Private Sub DTPicker4_LostFocus()
DTPicker4.Visible = False
MSFlexGrid1.SetFocus
End Sub

Private Sub Form_Load()
Dim i As Integer
'初始化数据库对象
Set db = OpenDatabase(App.Path & "\data\basicinfo.db")
'设置界面布局
Call changefrminfo
Me.Top = 0
Me.Left = frmtree.Width
Me.Height = frmMDI.ScaleHeight
Me.Width = frmMDI.ScaleWidth - frmtree.Width
Me.Frame1.Width = Me.ScaleWidth - 2 * Me.Frame1.Left
Me.Frame2.Width = Me.ScaleWidth - 2 * (Me.Frame1.Left + Me.Frame2.Left)
Me.Frame3.Width = Me.ScaleWidth - 2 * (Me.Frame1.Left + Me.Frame3.Left)
Me.Frame4.Width = Me.ScaleWidth - 2 * (Me.Frame1.Left + Me.Frame4.Left)
Me.MSFlexGrid1.Width = Me.ScaleWidth - 2 * (Me.Frame1.Left + Me.Frame3.Left + Me.MSFlexGrid1.Left)
For i = 0 To 3
    MSFlexGrid1.ColWidth(i) = MSFlexGrid1.Width / 4.2
    MSFlexGrid1.RowHeight(i + 1) = MSFlexGrid1.Height / 6
Next
MSFlexGrid1.TextMatrix(0, 0) = "姓名"
MSFlexGrid1.TextMatrix(0, 1) = "性别"
MSFlexGrid1.TextMatrix(0, 2) = "与户主关系"
MSFlexGrid1.TextMatrix(0, 3) = "出生年月"
Frame1.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
Command1.Enabled = False
Mask2.ToolTipText = "在这里填入住号：" & vbCrLf & "Ａ——分居在集体宿舍" & vbCrLf & "Ｂ——一室 Ｃ——一室一厅" & vbCrLf & "Ｄ——二室Ｅ——二室一厅" & vbCrLf & "Ｆ三室Ｇ——三室一厅" & vbCrLf & "各等级住号均在001~999之间"
MSFlexGrid1.ToolTipText = "双击单元格输入数据！" & vbCrLf & "要删除成员，只需删除姓名！"
End Sub

Private Sub MSFlexGrid1_DblClick()
'双击表格事件
With MSFlexGrid1
    c = .Col: r = .Row
    Select Case c
        Case 0
            Text4.Visible = False
            Text3.Width = .ColWidth(c)
            Text3.Height = .RowHeight(r)
            Text3.Left = .Left + .ColPos(c) + 50
            Text3.Top = .Top + .RowPos(r) + 50
            Text3.Visible = True
            Text3.Text = .Text
            strtmp = .Text
            Text3.SetFocus
        Case 1
            If .Text <> "" Then
                Text4.Visible = False
                Combo5.Width = .ColWidth(c)
                Combo5.Left = .Left + .ColPos(c) + 50
                Combo5.Top = .Top + .RowPos(r) + 50
                Combo5.Visible = True
                Combo5.Text = .Text
                Combo5.SetFocus
            Else
                Text4.Width = .ColWidth(c)
                Text4.Height = .RowHeight(r)
                Text4.Left = .Left + .ColPos(c) + 50
                Text4.Top = .Top + .RowPos(r) + 50
                Text4.Visible = True
                Text4.Text = ""
            End If
            
        Case 2
            If .Text <> "" Then
                Text4.Visible = False
                Combo6.Left = .Left + .ColPos(c) + 50
                Combo6.Top = .Top + .RowPos(r) + 50
                Combo6.Width = .ColWidth(c)
                Combo6.Visible = True
                Combo6.Text = .Text
                Combo6.SetFocus
            Else
                Text4.Width = .ColWidth(c)
                Text4.Height = .RowHeight(r)
                Text4.Left = .Left + .ColPos(c) + 50
                Text4.Top = .Top + .RowPos(r) + 50
                Text4.Visible = True
                Text4.Text = ""
            End If
            
        Case 3
            If Trim(.Text) <> "" Then
                Text4.Visible = False
                Mask1.Mask = ""
                Mask1.Text = ""
                Mask1.Width = .ColWidth(c)
                Mask1.Height = .RowHeight(r)
                Mask1.Left = .Left + .ColPos(c) + 50
                Mask1.Top = .Top + .RowPos(r) + 50
                Mask1.Visible = True
                Mask1.Mask = "####年##月"
                Mask1.Text = .Text
                Mask1.SetFocus
            Else
                Text4.Width = .ColWidth(c)
                Text4.Height = .RowHeight(r)
                Text4.Left = .Left + .ColPos(c) + 50
                Text4.Top = .Top + .RowPos(r) + 50
                Text4.Visible = True
                Text4.Text = ""
            End If
           
    End Select
End With
End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    Call MSFlexGrid1_DblClick
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then
    Text3.Visible = False
    MSFlexGrid1.SetFocus
    Exit Sub
End If
If KeyAscii = vbKeyReturn Then
    MSFlexGrid1.Text = Text3.Text
    Text3.Visible = False
    MSFlexGrid1.SetFocus
End If
End Sub

Private Sub infoadd()
Dim strhead As String, i As Integer, j As Integer
Dim rs1 As Recordset, rs2 As Recordset, rs3 As Recordset
If Trim(Mask2.Text) = "" Then
        MsgBox "住号不能为空！", vbCritical + vbOKOnly, SYSTITLE
        Mask2.SetFocus
        Exit Sub
End If
'数据有效性检查
If Trim(Text1.Text) = "" Then
    MsgBox "户主姓名不能为空！", vbCritical + vbOKOnly, SYSTITLE
    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
If Combo2.ListIndex = -1 Or Combo3.ListIndex = -1 Then
    MsgBox "职称或学历未填写！", vbCritical + vbOKOnly, SYSTITLE
    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
'初始化记录集对象
Set rs1 = db.OpenRecordset("select count(id) as cnt from host where id like " & "'" & Chr(Combo4.ListIndex + 65) & "*'")
Set rs2 = db.OpenRecordset("host")
Set rs3 = db.OpenRecordset("member")
strhead = Chr(Combo4.ListIndex + 65)
i = 1
'开始事务处理
BeginTrans
On Error GoTo errhdl
'开始添加数据
With rs2
    .AddNew
    !id = Mask2.Text
    !Name = Text1.Text
    !sex = Combo1.Text
    If Option1(0).Value Then
        !married = True
    Else
        !married = False
    End If
    !birth = Year(DTPicker1.Value) & "年" & Month(DTPicker1.Value) & "月"
    !workdate = Year(DTPicker2.Value) & "年" & Month(DTPicker2.Value) & "月"
    !zc = Combo2.Text
    !xl = Combo3.Text
    !livedgr = Combo4.ListIndex + 1
    !livearea = Text2.Text
    !indate = DTPicker3.Value
    .Update
End With
'添加家庭成员信息
Do Until MSFlexGrid1.TextMatrix(i, 0) = ""
    With rs3
        .AddNew
        !id = Mask2.Text
        !Name = MSFlexGrid1.TextMatrix(i, 0)
        !sex = MSFlexGrid1.TextMatrix(i, 1)
        !Relation = MSFlexGrid1.TextMatrix(i, 2)
        !birth = MSFlexGrid1.TextMatrix(i, 3)
        .Update
    End With
    i = i + 1
Loop
CommitTrans
Unload frmtree
frmtree.Show
With frmtree.TreeView1
    If .Nodes.Item("r" & (Asc(strhead) - 64)).Children > 0 Then
        .Nodes.Item("r" & (Asc(strhead) - 64)).Expanded = True
        .Nodes.Item("r" & (Asc(strhead) - 64)).Child.Selected = True
    Else
        .Nodes.Item("r" & (Asc(strhead) - 64)).Selected = True
    End If
End With
Exit Sub
'错误处理
errhdl:
    If Err.Number = 3022 Then
        MsgBox "您试图添加的住户信息已经存在，请查实！", vbCritical + vbOKOnly, SYSTITLE
        Call clearfrminfo
        Rollback
    Else
        MsgBox Err.Description, vbCritical + vbOKOnly, SYSTITLE
    End If
End Sub

Private Sub Text4_LostFocus()
Text4.Visible = False
End Sub