frmreguoqzf.frm

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

         TabIndex        =   14
         Top             =   360
         Width           =   855
      End
      Begin VB.Label Label3 
         Alignment       =   2  'Center
         AutoSize        =   -1  'True
         Caption         =   "搬迁原因"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00800000&
         Height          =   210
         Left            =   150
         TabIndex        =   13
         Top             =   1650
         Width           =   855
      End
      Begin VB.Label Label4 
         Alignment       =   2  'Center
         AutoSize        =   -1  'True
         Caption         =   "搬迁地点"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00800000&
         Height          =   210
         Left            =   3450
         TabIndex        =   12
         Top             =   1680
         Width           =   855
      End
   End
   Begin ComctlLib.StatusBar StaBar 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   3315
      Width           =   7305
      _ExtentX        =   12885
      _ExtentY        =   661
      SimpleText      =   ""
      _Version        =   327682
      BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} 
         NumPanels       =   3
         BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            Style           =   6
            Alignment       =   1
            AutoSize        =   2
            Object.Width           =   2646
            MinWidth        =   2646
            TextSave        =   "2001-3-24"
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
         BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            Alignment       =   1
            AutoSize        =   2
            Object.Width           =   2646
            MinWidth        =   2646
            TextSave        =   ""
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
         BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7} 
            AutoSize        =   1
            Object.Width           =   7496
            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 = "frmReGuoQZF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'控件绑定
Dim Ctl(0 To 9) 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 goqzf", 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,huzm from jiaozgzfxx where gongh='" + Trim(GongH) + "'", dbOpenSnapshot)
        recMain.FindFirst "gongh='" + Trim(GongH) + "'"
        txtGongH = GongH
        If Not IsNull(recMain!huzm) Then txtHuZM = recMain!huzm
    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 4, 5:
  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) = txtHuZM
Set Ctl(3) = txtShiJQD
Set Ctl(4) = txtJuZMJ
Set Ctl(5) = txtJianZMJ
Set Ctl(6) = txtJuZDD
Set Ctl(7) = txtBanQYY
Set Ctl(8) = txtBanQDD
Set Ctl(9) = txtBeiZ
CtlCount = 9
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 goqzf"
  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 txtBanQDD_Change()
If bEdit Then bChanged = True
End Sub

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

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

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

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

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

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

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

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

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