frm_yezhu_add.frm

前些年帮人写的毕业设计

VERSION 5.00
Begin VB.Form Frm_yezhu_add 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "业主添加"
   ClientHeight    =   3165
   ClientLeft      =   4470
   ClientTop       =   2865
   ClientWidth     =   3510
   Icon            =   "Frm_yezhu_add.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3165
   ScaleWidth      =   3510
   StartUpPosition =   1  '所有者中心
   Begin VB.TextBox Text1 
      Height          =   300
      Left            =   1200
      TabIndex        =   7
      Top             =   600
      Width           =   2055
   End
   Begin VB.TextBox Text2 
      Height          =   300
      Left            =   1200
      TabIndex        =   6
      Top             =   1020
      Width           =   2055
   End
   Begin VB.TextBox Text3 
      Height          =   300
      Left            =   1200
      TabIndex        =   5
      Top             =   1440
      Width           =   2055
   End
   Begin VB.TextBox Text4 
      Height          =   300
      Left            =   1200
      TabIndex        =   4
      Top             =   1860
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   375
      Left            =   420
      TabIndex        =   3
      Top             =   2520
      Width           =   1035
   End
   Begin VB.CommandButton Command2 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   1980
      TabIndex        =   2
      Top             =   2520
      Width           =   975
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   1200
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   180
      Width           =   2055
   End
   Begin VB.Label Label4 
      Caption         =   "业主姓名"
      Height          =   255
      Left            =   240
      TabIndex        =   11
      Top             =   660
      Width           =   735
   End
   Begin VB.Label Label5 
      Caption         =   "身份证号"
      Height          =   195
      Left            =   240
      TabIndex        =   10
      Top             =   1080
      Width           =   795
   End
   Begin VB.Label Label6 
      Caption         =   "职 业"
      Height          =   255
      Left            =   240
      TabIndex        =   9
      Top             =   1500
      Width           =   555
   End
   Begin VB.Label Label7 
      Caption         =   "电 话"
      Height          =   255
      Left            =   240
      TabIndex        =   8
      Top             =   1920
      Width           =   555
   End
   Begin VB.Label Label1 
      Caption         =   "房 号"
      Height          =   315
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   495
   End
End
Attribute VB_Name = "Frm_yezhu_add"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    On Error GoTo myerr
    Dim cn As ADODB.Connection
    Dim rst As New ADODB.Recordset
    Set cn = GetCn
    rst.Open "select fh,id from fangchan order by 1", cn, 0, 1
    If rst.BOF And rst.EOF Then
        MsgBox "请先建立房产信息！", vbExclamation, "提示"
        Exit Sub
    End If
    Combo1.Clear
    Do While Not rst.EOF
        Combo1.AddItem rst(0)
        Combo1.ItemData(Combo1.NewIndex) = rst(1)
        rst.MoveNext
    Loop
    rst.Close
    cn.Close
    
    Combo1.ListIndex = 0
    Exit Sub
myerr:
    Select Case Err
        Case -2147217904
            If rst.State = 1 Then rst.Close
            rst.Open "select count(*) from zfangchan", cn, 0, 1
            If rst(0) = 0 Then
                MsgBox "请先建立房产信息！", vbExclamation, "提示"
                Exit Sub
            Else
                MsgBox Error, vbExclamation, "提示"
            End If
        Case Else
            MsgBox Error, vbExclamation, "提示"
    End Select

End Sub

Private Sub Command1_Click()
    On Error GoTo myerr
    Dim cn As ADODB.Connection
    Dim rst As New ADODB.Recordset
    
    If Trim(Combo1) = "" Then
        MsgBox "房号不能为空！", vbExclamation, "提示"
        Text1.SetFocus
        Exit Sub
    End If
    If Trim(Text1) = "" Then
        MsgBox "业主姓名不能为空！", vbExclamation, "提示"
        Text1.SetFocus
        Exit Sub
    End If
    If Trim(Text2) = "" Then
        MsgBox "身份证号不能为空！", vbExclamation, "提示"
        Text2.SetFocus
        Exit Sub
    End If
    If Trim(Text3) = "" Then
        MsgBox "业主职业不能为空！", vbExclamation, "提示"
        Text3.SetFocus
        Exit Sub
    End If
    If Trim(Text4) = "" Then
        MsgBox "电话不能为空！", vbExclamation, "提示"
        Text4.SetFocus
        Exit Sub
    End If
    If Len(Text1) > 8 Then
        MsgBox "业主姓名超长！", vbExclamation, "提示"
        Text1.SetFocus
        Exit Sub
    End If
    If Len(Text2) > 18 Then
        MsgBox "身份证号超长！", vbExclamation, "提示"
        Text2.SetFocus
        Exit Sub
    End If
    If Len(Text3) > 50 Then
        MsgBox "职业超长！", vbExclamation, "提示"
        Text3.SetFocus
        Exit Sub
    End If
    If Len(Text4) > 20 Then
        MsgBox "电话超长！", vbExclamation, "提示"
        Text4.SetFocus
        Exit Sub
    End If
    Set cn = GetCn
    rst.Open "select * from yezhu where fid=" & Combo1.ItemData(Combo1.ListIndex), cn, 0, 1
    If Not (rst.BOF And rst.EOF) Then
        MsgBox "该房号已存在业主！", vbExclamation, "提示"
        Combo1.SetFocus '
        rst.Close
        Exit Sub
    End If
    rst.Close
    cn.Execute "insert into yezhu (fid,xm,sfz,zy,dh) values (" & Combo1.ItemData(Combo1.ListIndex) & ",'" & Text1 & "','" & Text2 & "','" & Text3 & "','" & Text4 & "')"
    MsgBox "已成功保存！", vbExclamation, "提示"
    Unload Me
    Exit Sub
myerr:
    MsgBox Error, vbExclamation, "提示"
    
End Sub