frmrezhuf.frm

一个实用的房产信息管理系统

Private Sub cboGuanX_Click()
If bEdit Then bChanged = True
End Sub

Private Sub cboJuZZK_Click()
If bEdit Then bChanged = True
End Sub

Private Sub cboMeiQ_Click()
If bEdit Then bChanged = True
End Sub

Private Sub cboShiFCT_Click()
If bEdit Then bChanged = True
End Sub

Private Sub cboZhiGQ_Click()
If bEdit Then bChanged = True
End Sub

Private Sub cmdAddnew_Click()
If bEdit Then
    rec.AddNew
    bEdit = False
    InitItem
End If
StaBarStatus
End Sub

Private Sub cmdDelete_Click()
If bEdit Then
    If MsgBox("您确信删除此数据吗？", vbQuestion + vbOKCancel, "询问") = vbOK Then
        rec.Delete
        If rec.RecordCount <> 0 Then
            rec.MoveLast
            ShowRecord
        Else
            InitItem
        End If
    End If
End If
End Sub

Private Sub cmdExit_Click()
If bEdit Then
    If bChanged Then
        EditRecord
    End If
Else
    If SaveRecord Then
        rec.Update
    End If
End If
Unload Me
End Sub

Private Sub cmdFirst_Click()
If rec.RecordCount = 0 Then
    MsgBox "当前数据库为空", vbExclamation + vbOKOnly, "信息"
    Exit Sub
End If
If bEdit Then
    If bChanged Then
        bChanged = False
        EditRecord
    End If
    If rec.AbsolutePosition = 0 Then
        MsgBox "信息提示！这是第一条记录", vbExclamation + vbOKOnly, "信息"
    Else
        rec.MoveFirst
        ShowRecord
    End If
Else
    If SaveRecord Then
        rec.Update
        rec.MoveFirst
        ShowRecord
    Else
        rec.CancelUpdate
        rec.MoveFirst
        ShowRecord
    End If
End If
End Sub

Private Sub cmdLast_Click()
If rec.RecordCount = 0 Then
    MsgBox "当前数据库为空", vbExclamation + vbOKOnly, "信息"
    Exit Sub
End If
If bEdit Then
    If bChanged Then
        bChanged = False
        EditRecord
    End If
    If rec.AbsolutePosition = rec.RecordCount - 1 Then
        MsgBox "信息提示！这是最后一条记录", vbExclamation + vbOKOnly, "信息"
    Else
        rec.MoveLast
        ShowRecord
    End If
Else
    If SaveRecord Then
        rec.Update
        rec.MoveLast
        ShowRecord
    Else
        rec.CancelUpdate
        rec.MoveLast
        ShowRecord
    End If
End If
End Sub

Private Sub cmdNext_Click()
If rec.RecordCount = 0 Then
    MsgBox "当前数据库为空", vbExclamation + vbOKOnly, "信息"
    Exit Sub
End If
If bEdit Then
    If bChanged Then
        bChanged = False
        EditRecord
    End If
    If rec.AbsolutePosition = rec.RecordCount - 1 Then
        MsgBox "信息提示！这是最后一条记录", vbExclamation + vbOKOnly, "信息"
    Else
        rec.MoveNext
        ShowRecord
    End If
Else
    If SaveRecord Then
        rec.Update
        rec.MoveLast
        ShowRecord
    Else
        rec.CancelUpdate
        rec.MoveLast
        ShowRecord
    End If
End If
End Sub

Private Sub cmdPrevious_Click()
If rec.RecordCount = 0 Then
    MsgBox "当前数据库为空", vbExclamation + vbOKOnly, "信息"
    Exit Sub
End If
If bEdit Then
    If bChanged Then
        bChanged = False
        EditRecord
    End If
    If rec.AbsolutePosition = 0 Then
        MsgBox "信息提示！这是第一条记录", vbExclamation + vbOKOnly, "信息"
    Else
        rec.MovePrevious
        ShowRecord
    End If
Else
    If SaveRecord Then
        rec.Update
        rec.MoveLast
        ShowRecord
    Else
        rec.CancelUpdate
        rec.MoveLast
        ShowRecord
    End If
End If
End Sub

Private Sub cmdSave_Click()
If Not bEdit Then
    If SaveRecord Then
        rec.Update
        If MsgBox("您是否添加下一条数据？", vbQuestion + vbOKCancel, "信息") = vbOK Then
            InitItem
            Ctl(0).SetFocus
            rec.AddNew
        Else
            rec.MoveLast
            bEdit = True
            ShowRecord
        End If
    End If
End If
End Sub


Private Sub Form_Load()
'to do
  Set rec = dbEstate.OpenRecordset("select * from zhufqk", dbOpenDynaset)
'end do
'建立控件绑定
ControlToField
'初始化Combo框
ComboInit
If rec.AbsolutePosition = -1 Then
    Exit Sub
Else
    rec.MoveLast
    rec.MoveFirst
    rec.FindFirst "工号='" + Trim(GongH) + "'"
    bChanged = False
    bEdit = True
    If rec.NoMatch Then
        Call cmdAddnew_Click
        Dim recMain As Recordset
        Set recMain = dbEstate.OpenRecordset("select gongh,xinm from jiaozgzfxx where gongh='" + Trim(GongH) + "'", dbOpenSnapshot)
        recMain.FindFirst "gongh='" + Trim(GongH) + "'"
        txtGongH = GongH
        If Not IsNull(recMain!xinm) Then txtZhiGH = recMain!xinm
    Else
        ShowRecord
        StaBarStatus
    End If
End If
End Sub

'to do
'检查当前字段所属的控件单元是否合法
Private Function CheckedItem(Index As Integer) As Boolean
bNumberNull = False
bDateNull = False
CheckedItem = True
Select Case Index
Case 3:
  If Len(Ctl(Index)) = 0 Then
      MsgBox "信息提示！工号不能为空。", vbExclamation + vbOKOnly, "信息"
      Ctl(Index).SetFocus
      CheckedItem = False
  End If
Case 18, 27, 28, 29:
  If Len(Ctl(Index)) <> 0 Then
      If Not IsDate(Ctl(Index)) Then
          MsgBox "信息提示！时间输入有误。", vbExclamation + vbOKOnly, "信息"
          CheckedItem = False
          Ctl(Index) = ""
          Ctl(Index).SetFocus
      End If
  Else
      bDateNull = True
  End If
Case 9, 10, 19, 20, 30, 31, 32:
  If Len(Ctl(Index)) <> 0 Then
      If Not IsNumeric(Ctl(Index)) Then
          MsgBox "信息提示！数字输入有误。", vbExclamation + vbOKOnly, "信息"
          CheckedItem = False
          Ctl(Index) = ""
          Ctl(Index).SetFocus
      End If
  Else
      bNumberNull = True
  End If
End Select
End Function
'end do

'显示当前记录
Private Sub ShowRecord()
Dim I As Integer
For I = 0 To CtlCount
  If Not IsNull(rec.Fields(I).Value) Then
      Ctl(I) = rec.Fields(I).Value
  Else
      Ctl(I) = ""
  End If
Next I
bChanged = False
bEdit = True
StaBarStatus
End Sub

'保存当前记录修改
Private Sub EditRecord()
Dim I As Integer
For I = 0 To CtlCount
  If CheckedItem(I) Then
      If Not bDateNull And Not bNumberNull Then
        rec.Edit
        rec.Fields(I) = Ctl(I).Text
        rec.Update
      End If
  End If
Next I
End Sub

'信息初始化
Private Sub InitItem()
Dim I As Integer
For I = 0 To CtlCount
  Ctl(I) = ""
Next I
End Sub

'状态显示
Private Sub StaBarStatus()
StaBar.Panels(2) = "共" & CStr(rec.RecordCount) & "条记录"
StaBar.Panels(3) = "第" & CStr(rec.AbsolutePosition + 1) & "条记录"
End Sub

'to do控件绑定
Private Sub ControlToField()
Set Ctl(0) = txtBianH
Set Ctl(1) = txtXinM
Set Ctl(2) = txtZhiGH
Set Ctl(3) = txtGongH
Set Ctl(4) = cboGuanX
Set Ctl(5) = cboZhiGQ
Set Ctl(6) = txtDiZ
Set Ctl(7) = txtCenC
Set Ctl(8) = cboChaoX
Set Ctl(9) = txtJianZMJ
Set Ctl(10) = txtJuZMJ
Set Ctl(11) = cboJuZZK
Set Ctl(12) = cboFangCXZ
Set Ctl(13) = cboShiFCT
Set Ctl(14) = cboMeiQ
Set Ctl(15) = txtWeiSJ
Set Ctl(16) = txtChuF
Set Ctl(17) = txtJianS
Set Ctl(18) = txtGouFSJ
Set Ctl(19) = txtFangJ
Set Ctl(20) = txtFangZ
Set Ctl(21) = txtChanQZH
Set Ctl(22) = cboFenP
Set Ctl(23) = txtJunL
Set Ctl(24) = txtFenPDW
Set Ctl(25) = cboFenPXS
Set Ctl(26) = txtWeiXCS
Set Ctl(27) = txtJiFZ
Set Ctl(28) = Text2
Set Ctl(29) = Text4
Set Ctl(30) = txtJinSNY
Set Ctl(31) = Text1
Set Ctl(32) = Text3
Set Ctl(33) = txtBeiZ
CtlCount = 33
End Sub
'end do 控件绑定



Private Function SaveRecord() As Boolean
Dim I As Integer
SaveRecord = True
For I = 0 To CtlCount
  If CheckedItem(I) Then
      If Not bDateNull And Not bNumberNull Then rec.Fields(I) = Ctl(I).Text
  Else
      SaveRecord = False
      Exit Function
  End If
Next I
End Function

'初始化Combo框
Private Sub ComboInit()
Dim recCombo As Recordset
Dim I As Integer
For I = 0 To CtlCount
Select Case I
Case 4, 5, 8, 11, 12, 13, 14, 22, 25
  Dim sql As String
  sql = "select distinct " + Trim(rec.Fields(I).Name) + " from zhufqk"
  Set recCombo = dbEstate.OpenRecordset(sql, dbOpenSnapshot)
  If recCombo.RecordCount > 0 Then
      recCombo.MoveLast
      recCombo.MoveFirst
      While Not recCombo.EOF
        If Not IsNull(recCombo.Fields(0)) Then Ctl(I).AddItem CStr(recCombo.Fields(0))
        recCombo.MoveNext
      Wend
  End If
End Select
Next I
End Sub

Private Sub Text1_Change()
If bEdit Then bChanged = True
End Sub

Private Sub Text2_Change()
If bEdit Then bChanged = True
End Sub

Private Sub Text3_Change()
If bEdit Then bChanged = True
End Sub

Private Sub Text4_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtBeiZ_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtBianH_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtCenC_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtChanQZH_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtChuF_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtDiZ_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtFangJ_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtFangZ_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtFenPDW_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtGongH_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtGouFSJ_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtJianS_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtJianZMJ_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtJiFZ_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtJinSNY_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtJunL_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtJuZMJ_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtWeiSJ_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtWeiXCS_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtXinM_Change()
If bEdit Then bChanged = True
End Sub

Private Sub txtZhiGH_Change()
If bEdit Then bChanged = True
End Sub