frmhuxinglogin.frm

一个优秀的售楼系统,可供毕业生毕业设计参考

VERSION 5.00
Begin VB.Form frmhuxinglogin 
   BackColor       =   &H00C0FFFF&
   Caption         =   "户型登记"
   ClientHeight    =   7215
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9060
   LinkTopic       =   "Form5"
   MaxButton       =   0   'False
   ScaleHeight     =   7215
   ScaleWidth      =   9060
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      BackColor       =   &H00C0FFFF&
      Caption         =   "户型登记"
      Height          =   3975
      Left            =   240
      TabIndex        =   1
      Top             =   3000
      Width           =   8535
      Begin VB.CommandButton cmdexit 
         Caption         =   "退出"
         Height          =   375
         Left            =   5880
         TabIndex        =   20
         Top             =   3480
         Width           =   1095
      End
      Begin VB.CommandButton cmddel 
         Caption         =   "删除"
         Height          =   375
         Left            =   4200
         TabIndex        =   19
         Top             =   3480
         Width           =   975
      End
      Begin VB.CommandButton cmdmodify 
         Caption         =   "修改"
         Height          =   375
         Left            =   2400
         TabIndex        =   18
         Top             =   3480
         Width           =   1095
      End
      Begin VB.CommandButton cmdadd 
         Caption         =   "增加"
         Height          =   375
         Left            =   720
         TabIndex        =   17
         Top             =   3480
         Width           =   975
      End
      Begin VB.TextBox txtjianjie 
         Height          =   975
         Left            =   1200
         TabIndex        =   15
         Top             =   2400
         Width           =   4335
      End
      Begin VB.ComboBox Combo1 
         Height          =   315
         Left            =   3960
         TabIndex        =   14
         Text            =   "选择房型"
         Top             =   1680
         Width           =   1575
      End
      Begin VB.TextBox txtfangxing 
         Enabled         =   0   'False
         Height          =   285
         Left            =   1200
         TabIndex        =   13
         Top             =   1680
         Width           =   1455
      End
      Begin VB.TextBox txttaomianji 
         Height          =   285
         Left            =   3960
         TabIndex        =   12
         Top             =   1080
         Width           =   975
      End
      Begin VB.TextBox txtjianzhumianji 
         Height          =   285
         Left            =   1200
         TabIndex        =   11
         Top             =   1080
         Width           =   855
      End
      Begin VB.TextBox txthuxingnum 
         Height          =   285
         Left            =   1200
         TabIndex        =   10
         Top             =   480
         Width           =   1455
      End
      Begin VB.Image Image1 
         Height          =   2655
         Left            =   5880
         Top             =   600
         Width           =   2415
      End
      Begin VB.Label Label9 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFFF&
         Caption         =   "图片："
         Height          =   195
         Left            =   5880
         TabIndex        =   16
         Top             =   360
         Width           =   540
      End
      Begin VB.Label Label8 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFFF&
         Caption         =   "简介："
         Height          =   195
         Left            =   360
         TabIndex        =   9
         Top             =   2520
         Width           =   540
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFFF&
         Caption         =   "<<-----"
         Height          =   195
         Left            =   3120
         TabIndex        =   8
         Top             =   1680
         Width           =   405
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFFF&
         Caption         =   "平方米"
         Height          =   195
         Left            =   5040
         TabIndex        =   7
         Top             =   1080
         Width           =   540
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFFF&
         Caption         =   "房型："
         Height          =   195
         Left            =   360
         TabIndex        =   6
         Top             =   1680
         Width           =   540
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFFF&
         Caption         =   "套内面积："
         Height          =   195
         Left            =   3000
         TabIndex        =   5
         Top             =   1080
         Width           =   900
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFFF&
         Caption         =   "平方米"
         Height          =   195
         Left            =   2160
         TabIndex        =   4
         Top             =   1080
         Width           =   540
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFFF&
         Caption         =   "建筑面积："
         Height          =   195
         Left            =   240
         TabIndex        =   3
         Top             =   1080
         Width           =   900
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFFF&
         Caption         =   "户型编号："
         Height          =   195
         Left            =   240
         TabIndex        =   2
         Top             =   480
         Width           =   900
      End
   End
   Begin VB.PictureBox gridhuxing 
      Height          =   2655
      Left            =   240
      ScaleHeight     =   2595
      ScaleWidth      =   8475
      TabIndex        =   0
      Top             =   120
      Width           =   8535
   End
End
Attribute VB_Name = "frmhuxinglogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs_huxing As New ADODB.Recordset
Dim gridclick As Boolean
Dim select_row As String              '记录选择的楼盘
Dim getrow As Long

Private Sub Combo1_Click()
txtfangxing.Text = Combo1.List(Combo1.ListIndex)
End Sub

Private Sub cmdadd_Click()
On Error GoTo adderror
If cmdadd.Caption = "保存" Then
   cmdadd.Caption = "增加"
If Trim(txthuxingnum.Text) = "" Then
   MsgBox "户型编号不能为空！", vbOKOnly + vbExclamation, "出错啦！"
   txthuxingnum.SetFocus
   Exit Sub
End If
If Trim(txtfangxing.Text) = "" Then
   MsgBox "请选择户型编号！", vbOKOnly + vbExclamation, "出错啦！"
   Exit Sub
End If
If Trim(txtjianzhumianji.Text) = "" Then
   MsgBox "建筑面积不能为空！", vbOKOnly + vbExclamation, "出错啦！"
   txtjianzhumianji.SetFocus
   Exit Sub
End If
If Trim(txttaomianji.Text) = "" Then
   MsgBox "套内面积不能为空！", vbOKOnly + vbExclamation, "出错啦！"
   txttaomianji.SetFocus
   Exit Sub
End If
If Not IsNumeric(txtjianzhumianji.Text) Then
      MsgBox "建筑面积请输入数字！", vbOKOnly + vbExclamation, ""
      txtjianzhumianji.SetFocus
      Exit Sub
End If
If Not IsNumeric(txttaomianji.Text) Then
      MsgBox "套内面积请输入数字！", vbOKOnly + vbExclamation, ""
      txttaomianji.SetFocus
      Exit Sub
End If
rs_huxing.MoveFirst
Dim i As Integer
For i = 0 To rs_huxing.RecordCount - 1
    If rs_huxing.Fields(0) = txthuxingnum.Text Then
       MsgBox "户型编号重复！", vbOKOnly + vbExclamation, "出错啦！"
       txthuxingnum.SetFocus
       Exit Sub
    End If
    rs_huxing.MoveNext
Next i
rs_huxing.MoveLast
rs_huxing.AddNew
rs_huxing.Fields(0) = txthuxingnum.Text
rs_huxing.Fields(1) = CSng(txtjianzhumianji.Text)
rs_huxing.Fields(2) = CSng(txttaomianji.Text)
rs_huxing.Fields(3) = txtfangxing.Text
rs_huxing.Fields(4) = txtjianjie.Text
rs_huxing.Fields(5) = txthuxingnum.Text
rs_huxing.Update
MsgBox "添加成功！", vbOKOnly + vbExclamation, "OK"
With gridhuxing
     .Rows = rs_huxing.RecordCount + 1
     .Row = gridhuxing.Rows - 1
     .Col = 0
     .Text = txthuxingnum.Text
     .Col = 1
     .Text = txtjianzhumianji.Text
     .Col = 2
     .Text = txttaomianji.Text
     .Col = 3
     .Text = txtfangxing.Text
     .Col = 4
     .Text = txtfangxing.Text
     .Col = 5
     .Text = txtjianjie.Text
End With
   cmdadd.Caption = "增加"
Else
   cmdadd.Caption = "保存"
   txthuxingnum.Text = ""
   txtjianzhumianji.Text = ""
   txttaomianji.Text = ""
   txtjianjie.Text = ""
   cmdmodify.Enabled = False
   cmddel.Enabled = False
End If
Exit Sub
adderror:
   MsgBox Err.Description
End Sub

Private Sub cmdmodify_Click()
On Error GoTo modifyerror
txthuxingnum.Enabled = False
If Trim(txtfangxing.Text) = "" Then
   MsgBox "房型不能为空！", vbOKOnly + vbExclamation, "出错啦！"
   txtfangxing.SetFocus
   Exit Sub
End If
rs_huxing.MoveFirst
Dim i As Integer
For i = 0 To rs_huxing.RecordCount - 1
    If rs_huxing.Fields(0) = txthuxingnum.Text Then
       rs_huxing.Fields(1) = CSng(txtjianzhumianji.Text)
       rs_huxing.Fields(2) = CSng(txttaomianji.Text)
       rs_huxing.Fields(3) = txtfangxing.Text
       rs_huxing.Fields(4) = txtjianjie.Text
       rs_huxing.Fields(5) = txthuxingnum.Text
       rs_huxing.Update
       MsgBox "修改成功！", vbOKOnly + vbExclamation, "OK"
       With gridhuxing
     .Row = getrow
     .Col = 0
     .Text = txthuxingnum.Text
     .Col = 1
     .Text = txtjianzhumianji.Text
     .Col = 2
     .Text = txttaomianji.Text
     .Col = 3
     .Text = txtfangxing.Text
     .Col = 4
     .Text = txtfangxing.Text
     .Col = 5
     .Text = txtjianjie.Text
       End With
       Exit Sub
    End If
    rs_huxing.MoveNext
Next i
modifyerror:
   MsgBox Err.Description
End Sub

Private Sub cmddel_Click()
Dim answer As String
Dim delete_row As String
On Error GoTo delerror
   answer = MsgBox("确定要删除吗？", vbYesNo, "")
   If answer = vbYes Then
       rs_huxing.MoveFirst
       Dim i As Integer
       For i = 0 To rs_huxing.RecordCount - 1
          If rs_huxing.Fields(0) = txthuxingnum.Text Then
             rs_huxing.Delete
             rs_huxing.Update
             MsgBox "删除成功！", vbOKOnly + vbExclamation, "OK"
             With gridhuxing
                  .RemoveItem getrow
             End With
             Exit Sub
          End If
          rs_huxing.MoveNext
       Next i
  Else
       Exit Sub
  End If
Exit Sub
delerror:
   MsgBox Err.Description
End Sub

Private Sub cmdexit_Click()
rs_huxing.Close
Unload Me
End Sub

Private Sub Form_Load()
Dim sql As String
On Error GoTo loaderror
sql = "select * from 户型"
rs_huxing.CursorLocation = adUseClient
rs_huxing.Open sql, conn, adOpenKeyset, adLockPessimistic
displaygrid
Combo1.AddItem "二室二厅"
Combo1.AddItem "一室二厅"
Combo1.AddItem "一室二厅"
Combo1.AddItem "复    式"
Combo1.AddItem "三室二厅"
cmdmodify.Enabled = False
cmddel.Enabled = False
gridclick = False
Exit Sub
loaderror:
   MsgBox Err.Description
End Sub

Public Sub displaygrid()
Dim i As Integer
On Error GoTo displayerror
setgrid
setgridhead
gridhuxing.Row = 0
If Not rs_huxing.EOF Then
   rs_huxing.MoveFirst
   Do While Not rs_huxing.EOF
            gridhuxing.Row = gridhuxing.Row + 1
            gridhuxing.Col = 0
            If Not IsNull(rs_huxing.Fields(0)) Then gridhuxing.Text = rs_huxing.Fields(0) _
                   Else gridhuxing.Text = ""
            gridhuxing.Col = 1
            If Not IsNull(rs_huxing.Fields(1)) Then gridhuxing.Text = rs_huxing.Fields(1) _
                   Else gridhuxing.Text = ""
            gridhuxing.Col = 2
            If Not IsNull(rs_huxing.Fields(2)) Then gridhuxing.Text = rs_huxing.Fields(2) _
                   Else gridhuxing.Text = ""
            gridhuxing.Col = 3
            If Not IsNull(rs_huxing.Fields(3)) Then gridhuxing.Text = rs_huxing.Fields(3) _
                   Else gridhuxing.Text = ""
            gridhuxing.Col = 4
            If Not IsNull(rs_huxing.Fields(5)) Then gridhuxing.Text = rs_huxing.Fields(5) _
                   Else gridhuxing.Text = ""
            gridhuxing.Col = 5
            If Not IsNull(rs_huxing.Fields(4)) Then gridhuxing.Text = rs_huxing.Fields(4) _
                   Else: gridhuxing.Text = ""
            rs_huxing.MoveNext
   Loop
End If
displayerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Public Sub setgrid()
Dim i As Integer
On Error GoTo seterror
With gridhuxing
    .ScrollBars = flexScrollBarBoth
    .FixedCols = 1
    .Rows = rs_huxing.RecordCount + 1
    .Cols = 6
    .SelectionMode = flexSelectionByRow
For i = 0 To .Rows - 1
    .RowHeight(i) = 315
Next
For i = 0 To .Cols - 1
    .ColWidth(i) = 1300
Next i
End With
Exit Sub
seterror:
     MsgBox Err.Description
End Sub

Public Sub setgridhead()
On Error GoTo setheaderror
gridhuxing.Row = 0
gridhuxing.Col = 0
gridhuxing.Text = "户型编号"
gridhuxing.Col = 1
gridhuxing.Text = "建筑面积"
gridhuxing.Col = 2
gridhuxing.Text = "套内面积"
gridhuxing.Col = 3
gridhuxing.Text = "户型"
gridhuxing.Col = 4
gridhuxing.Text = "  图片文件"
gridhuxing.Col = 5
gridhuxing.Text = "户型简介"
Exit Sub
setheaderror:
   MsgBox Err.Description
End Sub

Private Sub gridhuxing_Click()
On Error GoTo griderror
gridclick = True
cmdmodify.Enabled = True
cmddel.Enabled = True
getrow = gridhuxing.Row
If gridhuxing.Rows = 1 Then
   MsgBox "无相关纪录", vbOKOnly + vbExclamation, ""
Else
select_row = gridhuxing.TextMatrix(getrow, 0)
displaymingxi
End If
griderror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Public Sub displaymingxi()
txthuxingnum.Text = select_row
txtjianzhumianji.Text = gridhuxing.TextMatrix(getrow, 1)
txttaomianji.Text = gridhuxing.TextMatrix(getrow, 2)
txtfangxing.Text = gridhuxing.TextMatrix(getrow, 3)
txtjianjie.Text = gridhuxing.TextMatrix(getrow, 5)
Dim pic As String
If gridhuxing.TextMatrix(getrow, 4) <> "" Then
pic = gridhuxing.TextMatrix(getrow, 4)
Image1.Picture = LoadPicture(App.Path & "\ico\" & pic & ".bmp")
Else
Image1.Picture = LoadPicture()
End If
End Sub