frmrejif.frm

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

         BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            AutoSize        =   1
            Object.Width           =   10327
            MinWidth        =   4586
            TextSave        =   ""
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   11.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
End
Attribute VB_Name = "frmReJiF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'控件绑定
Dim Ctl(0 To 18) As Control
Dim CtlCount As Integer
'全局记录集
Dim rec As Recordset
'状态参数
Dim bEdit As Boolean
Dim bChanged As Boolean  '编辑状态下当前记录是否被改变
'检测参数
Dim bDateNull As Boolean '当日期型控件内容为空时继续不中止添加过程也不输入
Dim bNumberNull As Boolean '当数字型控件内容为空时继续不中止添加过程也不输入

Private Sub cboZhiCLB_Click()
If bEdit Then bChanged = True

End Sub

Private Sub cboZhiWLB_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 jif", 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 txtXinM = 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 0:
  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 5, 6, 7, 8, 9, 11, 17, 18:
  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) = txtGongH
Set Ctl(1) = txtBianH
Set Ctl(2) = txtXinM
Set Ctl(3) = cboZhiCLB
Set Ctl(4) = cboZhiWLB
Set Ctl(5) = txtZhiWF
Set Ctl(6) = txtGongLF
Set Ctl(7) = txtXiaoLF
Set Ctl(8) = txtZhiLF
Set Ctl(9) = txtRenJMJF
Set Ctl(10) = txtMeiQ
Set Ctl(11) = txtJiangLF
Set Ctl(12) = txtWeiS
Set Ctl(13) = txtJianS
Set Ctl(14) = txtSanD
Set Ctl(15) = txtDaZN
Set Ctl(16) = txtShuangZG
Set Ctl(17) = txtZongDF
Set Ctl(18) = txtPeiFF
CtlCount = 18
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
Set recCombo = dbEstate.OpenRecordset("select distinct lb from zhic", dbOpenSnapshot)
While Not recCombo.EOF
  If Not IsNull(recCombo!lb) Then cboZhiCLB.AddItem recCombo!lb
  recCombo.MoveNext
Wend
Set recCombo = dbEstate.OpenRecordset("select distinct lb from zhiw", dbOpenSnapshot)
While Not recCombo.EOF
  If Not IsNull(recCombo!lb) Then cboZhiWLB.AddItem recCombo!lb
  recCombo.MoveNext
Wend

End Sub

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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