form7.frm

小区物业管理系统完整文档及代码。帮助毕业同学做好毕业设计。

         Height          =   255
         Left            =   240
         TabIndex        =   4
         Top             =   3600
         Width           =   735
      End
      Begin VB.Label Label1 
         Caption         =   "住户编号"
         ForeColor       =   &H00FF0000&
         Height          =   255
         Left            =   240
         TabIndex        =   3
         Top             =   600
         Width           =   855
      End
   End
End
Attribute VB_Name = "frmB1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs_client As New ADODB.Recordset
Dim rs_count As New ADODB.Recordset
'设置一个add变量用于保存时判断是从添加还是修改后保存
Dim add
'定义rs_wuye、rs_water,rs_power,rs_gas为显示该住户物业资料和仪表资料的记录集
Dim rs_wuye As New ADODB.Recordset
Dim rs_water As New ADODB.Recordset
Dim rs_power As New ADODB.Recordset
Dim rs_gas As New ADODB.Recordset
Private Sub cmdAdd_Click()
   
   '设置除保存和取消按钮外的其他按钮不可用
   cmdadd.Enabled = False
   cmdedit.Enabled = False
   cmddel.Enabled = False
   cmdsave.Enabled = True
   cmdcancel.Enabled = True
   cmdf.Enabled = False
   cmdp.Enabled = False
   cmdn.Enabled = False
   cmdl.Enabled = False
   cmdq.Enabled = False
   '需要清空所有text框，并且设置它们可写
   For i = 0 To 12
      Text1(i).Text = ""
      Text1(i).Enabled = True
   Next i
   Combo1.Enabled = True
   'add变量用于保存时判断是从添加还是修改后保存
   add = 1
   Text1(0).SetFocus
   Text1(8).Text = Date '????????????????????
End Sub
Private Sub cmdCancel_Click()
   '取消按钮用于用户添加或修改过程中放弃添加或修改操作
   cmdsave.Enabled = False
   cmdcancel.Enabled = False
   cmdadd.Enabled = True
   cmdedit.Enabled = True
   cmddel.Enabled = True
   cmdf.Enabled = True
   cmdp.Enabled = True
   cmdn.Enabled = True
   cmdl.Enabled = True
   cmdq.Enabled = True
 If add = 1 Then
   Dim sql_client As String
   '如果当前client表中有数据则显示第一条数据
   If Not rs_client.EOF And Not rs_client.BOF Then
      For i = 0 To 12
         Text1(i).Text = rs_client.Fields(i)
      Next i
      If rs_client.Fields(13) = "男" Then
         Combo1.ListIndex = 0
      Else
         Combo1.ListIndex = 1
      End If
   '如果没有数据，则显示空
   Else
      For i = 0 To 12
         Text1(i).Text = ""
      Next i
   End If
 ElseIf add = 0 Then
      For i = 0 To 12
         Text1(i).Text = rs_client.Fields(i)
      Next i
      If rs_client.Fields(13) = "男" Then
         Combo1.ListIndex = 0
      Else
         Combo1.ListIndex = 1
      End If
 End If
   '开始时设置各个text框不可写
   For i = 0 To 12
      Text1(i).Enabled = False
   Next i
   '先设置ComboBox的默认值及不可改
   Combo1.Enabled = False
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdDel_Click()
   '当单击删除记录时，需要弹出一个提示框，警告用户
   Dim answer As String
   answer = MsgBox("确定要删除吗？", vbYesNo, "")
   '确实删除
   If answer = vbYes Then
      rs_client.Delete  '删除当前记录
      rs_client.Update  '更新删除
      MsgBox "成功删除！", vbOKOnly + vbExclamation, "注意"
   Else
       Exit Sub
   End If
    '删除之后，显示总信息条数需要减 1
   Text16.Text = Val(Text16.Text) - 1
   '删除当前记录后，需要显示下一条记录，如果删除的是最后一条记录，则显示上一条记录
   '先移动rs_client记录到后一条
   rs_client.MoveNext
   If rs_client.EOF Then
      rs_client.MovePrevious
    '如果没有到记录首则显示改记录
    If Not rs_client.BOF Then
      For i = 0 To 12
         Text1(i).Text = rs_client.Fields(i)
      Next i
      If rs_client.Fields(13) = "男" Then
         Combo1.ListIndex = 0
      Else
         Combo1.ListIndex = 1
      End If
     '如果到记录首，则表格已经为空，置所有text框显示为空
    ElseIf rs_client.BOF Then
      For i = 0 To 12
         Text1(i).Text = ""
      Next i
    End If
   '如果删除的不是首尾记录，则显示当前记录即可
   Else
      For i = 0 To 12
         Text1(i).Text = rs_client.Fields(i)
      Next i
      If rs_client.Fields(13) = "男" Then
         Combo1.ListIndex = 0
      Else
         Combo1.ListIndex = 1
      End If
   End If
   
End Sub
Private Sub cmdEdit_Click()
   
   '设置除保存和取消按钮外的其他按钮不可用
   cmdadd.Enabled = False
   cmdedit.Enabled = False
   cmddel.Enabled = False
   cmdsave.Enabled = True
   cmdcancel.Enabled = True
   cmdf.Enabled = False
   cmdp.Enabled = False
   cmdn.Enabled = False
   cmdl.Enabled = False
   cmdq.Enabled = False
   '需要设置除主键之外的text框可写
   For i = 1 To 12
      Text1(i).Enabled = True
   Next i
   Combo1.Enabled = True
   add = 0
End Sub
Private Sub cmdf_Click()
   '先移动rs_client记录到第一条
   rs_client.MoveFirst
   '同时需要设置相应按钮为不可用和不可用
   cmdp.Enabled = False
   cmdf.Enabled = False
   cmdn.Enabled = True
   cmdl.Enabled = True
   '如果已经是第一条记录，则提示用户
   If rs_client.BOF = True Then
      MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
      Exit Sub
   '如果不是，则个数据表的记录位置移到第一条记录，并且显示之
   Else
      For i = 0 To 12
         Text1(i).Text = rs_client.Fields(i)
      Next i
      If rs_client.Fields(13) = "男" Then
         Combo1.ListIndex = 0
      Else
         Combo1.ListIndex = 1
      End If
   End If
End Sub
Private Sub cmdl_Click()
   '移动rs_client记录到最后一条
   rs_client.MoveLast
   cmdf.Enabled = True
   cmdp.Enabled = True
   cmdn.Enabled = False
   cmdl.Enabled = False
    '如果已经是最后一条记录，则提示用户
   If rs_client.EOF = True Then
      MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
      Exit Sub
   '如果不是最后一条，则个数据表的记录位置移到后一条记录，并且显示之
   Else
      For i = 0 To 12
         Text1(i).Text = rs_client.Fields(i)
      Next i
      If rs_client.Fields(13) = "男" Then
         Combo1.ListIndex = 0
      Else
         Combo1.ListIndex = 1
      End If
   End If
End Sub
Private Sub cmdn_Click()
   '先移动rs_client记录到后一条
   rs_client.MoveNext
   '设置前一条和第一条按钮可用
   cmdp.Enabled = True
   cmdf.Enabled = True
   '如果已经是最后一条记录，则提示用户
   If rs_client.EOF = True Then
      MsgBox "对不起，已经是最后一条记录了！", vbOKOnly + vbInformation, "注意"
      '并且设置“后一条”和最后一条按钮不可用
      cmdn.Enabled = False
      cmdl.Enabled = False
      Exit Sub
   '如果不是，则个数据表的记录位置移到后一条记录，并且显示之
   Else
      For i = 0 To 12
         Text1(i).Text = rs_client.Fields(i)
      Next i
      If rs_client.Fields(13) = "男" Then
         Combo1.ListIndex = 0
      Else
         Combo1.ListIndex = 1
      End If
   End If
End Sub
Private Sub cmdp_Click()
   '先移动rs_client记录到前一条
   rs_client.MovePrevious
   '设置后一条和最后一条按钮可用
   cmdn.Enabled = True
   cmdl.Enabled = True
   '如果已经是第一条记录，则提示用户
   If rs_client.BOF = True Then
      MsgBox "对不起，已经是第一条记录了！", vbOKOnly + vbInformation, "注意"
      '并且设置“前一条”和第一条按钮不可用
      cmdp.Enabled = False
      cmdf.Enabled = False
      Exit Sub
   '如果不是，则个数据表的记录位置移到前一条记录，并且显示之
   Else
      For i = 0 To 12
         Text1(i).Text = rs_client.Fields(i)
      Next i
      If rs_client.Fields(13) = "男" Then
         Combo1.ListIndex = 0
      Else
         Combo1.ListIndex = 1
      End If
   End If
End Sub

Private Sub cmdq_Click()
frmqzh.Show
End Sub

Private Sub cmdtable_Click()
frmTableZh.Show
End Sub
Private Sub cmdSave_Click()

   '检测数据是否完整
      If Text1(0).Text = "" Then
         MsgBox "住户编号不可为空！", vbOKOnly + vbInformation, "注意"
         Text1(0).SetFocus
         Exit Sub
      ElseIf Text1(1).Text = "" Then
         MsgBox "物业地址不可为空！", vbOKOnly + vbInformation, "注意"
         Text1(1).SetFocus
         Exit Sub
      ElseIf Text1(11).Text = "" Or IsNumeric(Text1(11).Text) = False Then
         MsgBox "建筑面积应为数字！", vbOKOnly + vbInformation, "注意"
         Text1(11).SetFocus
         Exit Sub
      ElseIf Text1(12).Text = "" Or IsNumeric(Text1(12).Text) = False Then
         MsgBox "使用面积应为数字！", vbOKOnly + vbInformation, "注意"
         Text1(12).SetFocus
         Exit Sub
      ElseIf Text1(1).Text = "" Then
         MsgBox "住户姓名不可为空！", vbOKOnly + vbInformation, "注意"
         Text1(1).SetFocus
         Exit Sub
      ElseIf IsDate(Text1(8).Text) = False Then
         MsgBox "入住时间书写不对，应为2000-1-1这样的格式！", vbOKOnly + vbInformation, "注意"
         Text1(8).SetFocus
         Exit Sub
      ElseIf Not Text1(9).Text = "" And IsDate(Text1(9).Text) = False Then
         MsgBox "迁出时间应为空或2000-1-1这样的格式！", vbOKOnly + vbInformation, "注意"
         Text1(9).SetFocus
         Exit Sub
      End If
   
   '添加数据后保存
   If add = 1 Then
      '检测住户编号这个主键是否已经在表中存在
      Dim rs_check As New ADODB.Recordset
      Dim sqlCheck As String
      Dim MsgText As String
      sqlCheck = "select * from zh where 住户编号= '" & (Text1(0).Text) & "'"
      Set rs_check = ExecuteSQL(sqlCheck, MsgText)
      If Not rs_check.EOF And Not rs_check.BOF Then
         MsgBox "该住户编号已经存在，请重填一个！", vbOKOnly + vbInformation, "注意"
         rs_check.Close
         Text1(0).SetFocus
         Text1(0).Text = ""
         Exit Sub
      End If
      rs_check.Close
      '主键不重复，可以加入表中
      rs_client.AddNew
      For i = 0 To 12
         rs_client.Fields(i) = Text1(i).Text
      Next i
      rs_client.Fields(13) = Combo1.Text
      rs_client.Update
      '添加保存之后，显示总信息条数需要加1
      Text16.Text = Val(Text16.Text) + 1
   '修改数据后的保存
   Else
      rs_client.Delete
      rs_client.AddNew
      rs_client.Fields("住户编号") = Text1(0).Text
      For i = 1 To 12
          rs_client.Fields(i) = Text1(i).Text
      Next i
      rs_client.Fields(13) = Combo1.Text
      rs_client.Update
   End If
   MsgBox "保存数据成功！", vbOKOnly + vbInformation, "祝贺"
   '保存后需要设置其他按钮可用，以及各个text框不可写
   cmdadd.Enabled = True
   cmdedit.Enabled = True
   cmddel.Enabled = True
   cmdsave.Enabled = False
   cmdcancel.Enabled = False
   cmdf.Enabled = True
   cmdp.Enabled = True
   cmdn.Enabled = True
   cmdl.Enabled = True
   cmdq.Enabled = True
   For i = 0 To 12
      Text1(i).Enabled = False
   Next i
   Combo1.Enabled = False
End Sub

Private Sub Form_Load()
   frmB1.Width = 12960
   frmB1.Height = 7110
   Dim x0 As Long
   Dim y0 As Long
   '让窗体居中
   x0 = Screen.Width
   y0 = Screen.Height
   x0 = (x0 - Me.Width) / 2
   y0 = (y0 - Me.Height) / 2
   Me.Move x0, y0
   cmdsave.Enabled = False
   cmdcancel.Enabled = False
   '设置显示记录条数的Text2不可写
   Text16.Enabled = False
   Combo1.ListIndex = 0
   '设置网格不可写
   DataGrid1.AllowAddNew = False
   DataGrid1.AllowDelete = False
   DataGrid1.AllowUpdate = False

   
    
    Select Case SSTab1.Tab
       Case 0
           '如果不是查询显示,则显示第一条记录
           If query = False Then
               '在from_laod()方法中打开住户信息表
               '如果rs_count rs_client 当前状态是打开的，则先关闭之
               If rs_count.State = adStateOpen Then
                  rs_count.Close