frmpeoplemanage.frm

物业管理

      HeadLines       =   1
      RowHeight       =   15
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ColumnCount     =   2
      BeginProperty Column00 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column01 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
         EndProperty
         BeginProperty Column01 
         EndProperty
      EndProperty
   End
   Begin VB.Label Label1 
      Caption         =   "小区人口管理"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   21.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   5760
      TabIndex        =   1
      Top             =   0
      Width           =   3015
   End
End
Attribute VB_Name = "frmpeoplemanage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents adoPrimaryRS As Recordset
Attribute adoPrimaryRS.VB_VarHelpID = -1
Dim WithEvents rs As Recordset
Attribute rs.VB_VarHelpID = -1
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean

Private Sub Command3_Click()
Frame2.Visible = True
Combo3.Visible = True

Combo2.Visible = True
Frame1.Visible = False
End Sub

Private Sub Command8_Click()
Frame1.Visible = False
Frame2.Visible = False
End Sub
Private Sub Check1_Click()
If Check1.Value = 1 Then
  Check2.Value = 0
  
   Combo2.Clear
    SQL = "select distinct 楼宇 from 房产资源"
    Set rs = db.Execute(SQL)
     Do While Not rs.EOF
            If IsNull(rs("楼宇")) = False Then
                Combo2.AddItem rs("楼宇")
            End If
            rs.MoveNext
    Loop
    End If
End Sub
Private Sub Check2_Click()
If Check2.Value = 1 Then
Check1.Value = 0

   Combo3.Clear
    SQL = "select distinct 代码 from 房产资源"
    Set rs = db.Execute(SQL)
     Do While Not rs.EOF
            If IsNull(rs("代码")) = False Then
                Combo3.AddItem rs("代码")
            End If
            rs.MoveNext
    Loop
    End If
End Sub


Private Sub Command9_Click()
If Check1.Value = 1 And Combo2.Text <> "" Then
        DataGrid_sql = "select * from 房产资源 where  楼宇=   '" & Combo2.Text & "'"
   End If
   If Check2.Value = 1 And Combo3.Text <> "" Then
        DataGrid_sql = "select * from 房产资源 where 代码=   '" & Combo3.Text & "'"
   End If
  
     Set adoPrimaryRS = New Recordset
     adoPrimaryRS.Open DataGrid_sql, db, adOpenStatic, adLockOptimistic
     adoPrimaryRS.Requery
    Set DataGrid6.DataSource = adoPrimaryRS
End Sub

Private Sub DataGrid6_DblClick()
Frame1.Visible = True
Frame2.Visible = False
End Sub

Private Sub Form_Load()
  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select * from 小区人口管理 ", db, adOpenStatic, adLockOptimistic
  Set DataGrid1.DataSource = adoPrimaryRS
  Set Combo1.DataSource = adoPrimaryRS
  Set Text1.DataSource = adoPrimaryRS
  Set Text2.DataSource = adoPrimaryRS
  Set Text3.DataSource = adoPrimaryRS
  Set Text4.DataSource = adoPrimaryRS
  
  Set Text7.DataSource = adoPrimaryRS
  Set Text5.DataSource = adoPrimaryRS
  Set Text8.DataSource = adoPrimaryRS
  Set Text9.DataSource = adoPrimaryRS
  Combo1.AddItem "男"
  Combo1.AddItem "女"
  Frame1.Visible = False

End Sub
Private Sub Form_Unload(Cancel As Integer)
  frmmain.Enabled = True
  Unload Me
End Sub
Private Sub Command2_Click() '修改
  Frame1.Visible = True
 
 mbAddNewFlag = False
 End Sub
Private Sub Command1_Click() '增加
   
  With adoPrimaryRS
    If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
    End If
    .AddNew
    mbAddNewFlag = True
  End With
  Frame1.Visible = True

  Combo1.Text = ""
  Text1.Text = ""
  Text2.Text = ""
  Text3.Text = ""
  Text4.Text = ""
  Text6.Text = ""
  Text7.Text = ""
  Text5.Text = ""
  Text8.Text = ""
  Text9.Text = ""
  Text10.Text = ""
  Text11.Text = ""
  Text12.Text = ""
  Text13.Text = ""
  Text14.Text = ""
  Text15.Text = ""
  Text16.Text = "无"
 End Sub
Private Sub Command4_Click() '删除
  On Error GoTo DeleteErr
  Dim Resp As Integer
  Resp = MsgBox("你真的要删除该记录吗？", vbExclamation + vbOKCancel, pTitle)
  If Resp = 2 Then
     Exit Sub
  Else
   With adoPrimaryRS
     .Delete
     .MoveNext
    If .EOF Then .MoveLast
   End With
  End If
  
  Exit Sub
DeleteErr:
  MsgBox "删除操作有错误", vbExclamation + vbOKOnly, pTitle

End Sub
Private Sub Command7_Click() '取消
 ' On Error Resume Next
 On Error GoTo CancelErr
 If mbAddNewFlag = True Then
  adoPrimaryRS.Delete
 
  mbAddNewFlag = False
  Else
  mbEditFlag = False
  adoPrimaryRS.CancelUpdate
 End If
  If mvBookMark > 0 Then
   adoPrimaryRS.Bookmark = mvBookMark
  Else
   adoPrimaryRS.MoveFirst
  End If
Frame1.Visible = False
  Exit Sub
CancelErr:
    MsgBox "取消操作有错误", vbExclamation + vbOKOnly, pTitle
   Frame1.Visible = False
   Frame2.Visible = False
   mbAddNewFlag = False
End Sub
Private Sub Command6_Click()
  On Error GoTo UpdateErr
  adoPrimaryRS.UpdateBatch adAffectAll
  If mbAddNewFlag Then
    adoPrimaryRS.MoveLast              'move to the new record
  End If
  mbEditFlag = False
  mbAddNewFlag = False
  Frame1.Visible = False
  Exit Sub
UpdateErr:
   MsgBox "保存操作错误", vbExclamation + vbOKOnly, pTitle
   Frame1.Visible = False
   Frame2.Visible = True
End Sub

Private Sub Command5_Click()
  frmmain.Enabled = True
  Unload Me
End Sub