frmrejiangl.frm

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

            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   90
         TabIndex        =   22
         Top             =   120
         Width           =   855
      End
   End
End
Attribute VB_Name = "frmReJiangL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'控件绑定
Dim Ctl(0 To 15) 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 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 jiangl", dbOpenDynaset)
'end do
'建立控件绑定
ControlToField
'初始化Combo框
'ComboInit
If rec.AbsolutePosition = -1 Then
    Exit Sub
Else
    rec.MoveLast
    rec.MoveFirst
    rec.FindFirst "工号='" + Trim(GongH) + "'"
    bEdit = True
    bChanged = False
    If rec.NoMatch Then
        Call cmdAddnew_Click
        Dim recMain As Recordset
        Set recMain = dbEstate.OpenRecordset("select gongh,xinm,danw from jiaozgzfxx where gongh='" + Trim(GongH) + "'", dbOpenSnapshot)
        recMain.FindFirst "gongh='" + Trim(GongH) + "'"
        txtGongH = GongH
        If Not IsNull(recMain!xinm) Then txtHuZXM = recMain!xinm
        If Not IsNull(recMain!danw) Then txtDanW = recMain!danw
    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 1:
  If Len(Ctl(Index)) = 0 Then
      MsgBox "信息提示！工号不能为空。", vbExclamation + vbOKOnly, "信息"
      Ctl(Index).SetFocus
      CheckedItem = False
  End If
Case 6, 8, 10:
  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 4, 5, 7, 9, 12, 13:
  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) = txtGongH
Set Ctl(2) = txtHuZXM
Set Ctl(3) = txtDanW
Set Ctl(4) = txtZongJLJE
Set Ctl(5) = txtShouCZFK
Set Ctl(6) = txtShouCZFNY
Set Ctl(7) = txtHouCZFK
Set Ctl(8) = txtHouCZFNY
Set Ctl(9) = txtDaiKZE
Set Ctl(10) = txtDaiKQSNY
Set Ctl(11) = txtDaiKYF
Set Ctl(12) = txtDaiKMYZF
Set Ctl(13) = txtDaiKZZF
Set Ctl(14) = txtJiangLYY
Set Ctl(15) = txtBeiZ
CtlCount = 15
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


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

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

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

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

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

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

Private Sub txtDaiKZZF_GotFocus()
    If IsNumeric(txtDaiKYF) And IsNumeric(txtDaiKMYZF) Then
        txtDaiKZZF = CStr(CInt(txtDaiKYF) * CDbl(txtDaiKMYZF))
        If bEdit Then bChanged = True
    End If
End Sub

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

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

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

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

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

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