frmbuildinglogin.frm

来自「一个优秀的售楼系统,可供毕业生毕业设计参考」· FRM 代码 · 共 608 行 · 第 1/2 页

Private Sub cmdadd_Click()
On Error GoTo adderror
If cmdadd.Caption = "保存" Then
   cmdadd.Caption = "增加"
If Trim(txtnum.Text) = "" Then
   MsgBox "楼盘编号不能为空！", vbOKOnly + vbExclamation, "出错啦！"
   txtnum.SetFocus
   Exit Sub
End If
If Trim(txthuxingnum.Text) = "" Then
   MsgBox "请选择户型编号！", vbOKOnly + vbExclamation, "出错啦！"
   Exit Sub
End If
If Trim(txtprice.Text) = "" Then
   MsgBox "价格不能为空！", vbOKOnly + vbExclamation, "出错啦！"
   txtprice.SetFocus
   Exit Sub
End If
If Not IsNumeric(txtprice.Text) Then
      MsgBox "价格请输入数字！", vbOKOnly + vbExclamation, ""
      txtprice.SetFocus
      Exit Sub
End If
rs_loupan.MoveFirst
Dim i As Integer
For i = 0 To rs_loupan.RecordCount - 1
    If rs_loupan.Fields(0) = txtnum.Text Then
       MsgBox "楼盘编号重复！", vbOKOnly + vbExclamation, "出错啦！"
       txtnum.SetFocus
       Exit Sub
    End If
    rs_loupan.MoveNext
Next i
rs_loupan.MoveLast
rs_loupan.AddNew
rs_loupan.Fields(0) = txtnum.Text
rs_loupan.Fields(1) = txthuxingnum.Text
rs_loupan.Fields(2) = CCur(txtprice.Text)
rs_loupan.Update
MsgBox "添加成功！", vbOKOnly + vbExclamation, "OK"
cmdadd.Caption = "增加"
With gridloupan
     .Rows = rs_loupan.RecordCount + 1
     .Row = gridloupan.Rows - 1
     .Col = 0
     .Text = txtnum.Text
     .Col = 1
     .Text = txthuxingnum.Text
     .Col = 2
     .Text = txtlouhao.Text
     .Col = 3
     .Text = txtdanyuan.Text
     .Col = 4
     .Text = txtlouceng.Text
     .Col = 5
     .Text = txtfanghao.Text
     .Col = 6
     .Text = txtprice.Text
End With
Else
   cmdadd.Caption = "保存"
   txtnum.Text = ""
   txtprice.Text = ""
   cmdmodify.Enabled = False
   cmddel.Enabled = False
End If
Exit Sub
adderror:
   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_loupan.MoveFirst
       Dim i As Integer
       For i = 0 To rs_loupan.RecordCount - 1
          If rs_loupan.Fields(0) = txtnum.Text Then
             rs_loupan.Delete
             rs_loupan.Update
             MsgBox "删除成功！", vbOKOnly + vbExclamation, "OK"
             With gridloupan
                  .RemoveItem getrow
             End With
             Exit Sub
          End If
          rs_loupan.MoveNext
       Next i
  Else
       Exit Sub
  End If
Exit Sub
delerror:
   MsgBox Err.Description
End Sub

Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim sql As String
On Error GoTo loaderror
sql = "select * from 楼盘"
rs_loupan.CursorLocation = adUseClient
rs_loupan.Open sql, conn, adOpenKeyset, adLockPessimistic     '打开数据库
sql = "select * from 户型"
rs_huxing.CursorLocation = adUseClient
rs_huxing.Open sql, conn, adOpenKeyset, adLockPessimistic
displaygrid
displaycombo
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
gridloupan.Row = 0
If Not rs_loupan.EOF Then
   rs_loupan.MoveFirst
   Do While Not rs_loupan.EOF
            gridloupan.Row = gridloupan.Row + 1
            gridloupan.Col = 0
            If Not IsNull(rs_loupan.Fields(0)) Then gridloupan.Text = rs_loupan.Fields(0) _
                    Else gridloupan.Text = ""
            gridloupan.Col = 1
            If Not IsNull(rs_loupan.Fields(1)) Then gridloupan.Text = rs_loupan.Fields(1) _
                    Else gridloupan.Text = ""
            gridloupan.Col = 2
            gridloupan.Text = Mid(rs_loupan.Fields(0), 1, 2)
            gridloupan.Col = 3
            gridloupan.Text = Mid(rs_loupan.Fields(0), 3, 2)
            gridloupan.Col = 4
            gridloupan.Text = Mid(rs_loupan.Fields(0), 5, 2)
            gridloupan.Col = 5
            gridloupan.Text = Mid(rs_loupan.Fields(0), 7, 2)
            gridloupan.Col = 6
            If Not IsNull(rs_loupan.Fields(2)) Then gridloupan.Text = rs_loupan.Fields(2) _
                   Else gridloupan.Text = ""
            rs_loupan.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 gridloupan
    .ScrollBars = flexScrollBarBoth
    .FixedCols = 1
    .Rows = rs_loupan.RecordCount + 1
    .Cols = 7
    .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
gridloupan.Row = 0
gridloupan.Col = 0
gridloupan.Text = "楼盘编号"
gridloupan.Col = 1
gridloupan.Text = "户型编号"
gridloupan.Col = 2
gridloupan.Text = "楼号"
gridloupan.Col = 3
gridloupan.Text = "单元"
gridloupan.Col = 4
gridloupan.Text = "  楼层"
gridloupan.Col = 5
gridloupan.Text = "房号"
gridloupan.Col = 6
gridloupan.Text = "报价"
Exit Sub
setheaderror:
   MsgBox Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
rs_loupan.Close
rs_huxing.Close
End Sub

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

Public Sub displaymingxi()
txtnum.Text = select_row
txtlouhao.Text = gridloupan.TextMatrix(getrow, 2)
txtdanyuan.Text = gridloupan.TextMatrix(getrow, 3)
txtlouceng.Text = gridloupan.TextMatrix(getrow, 4)
txtfanghao.Text = gridloupan.TextMatrix(getrow, 5)
txthuxingnum.Text = gridloupan.TextMatrix(getrow, 1)
txtprice.Text = gridloupan.TextMatrix(getrow, 6)
Dim i As Integer
rs_huxing.MoveFirst
For i = 0 To rs_huxing.RecordCount
    If rs_huxing.Fields(0) = gridloupan.TextMatrix(getrow, 1) Then
       Label11.Caption = "房型：" + CStr(rs_huxing.Fields(3)) + vbCrLf + _
                        "建筑面积：" + CStr(rs_huxing.Fields(1)) + vbCrLf + _
                        "套内面积：" + CStr(rs_huxing.Fields(2)) + vbCrLf + _
                        "房型简介："
       If IsNull(rs_huxing.Fields(4)) Then
           Label11.Caption = Label11.Caption + ""
       Else
           Label11.Caption = Label11.Caption + rs_huxing.Fields(4)
       End If
       Exit Sub
    End If
    rs_huxing.MoveNext
Next i
End Sub

Public Sub displaycombo()
On Error GoTo displayerror
If Not rs_huxing.EOF Then
   rs_huxing.MoveFirst
   Do While Not rs_huxing.EOF
            Combo1.AddItem rs_huxing.Fields(0)
            rs_huxing.MoveNext
   Loop
End If
Exit Sub
displayerror:
     MsgBox Err.Description
End Sub

Private Sub txtnum_KeyPress(KeyAscii As Integer)
On Error GoTo texterror
If KeyAscii = 13 Then
     If IsNull(Trim(txtnum.Text)) Then
        MsgBox "楼盘编号不能为空！", vbOKOnly + vbExclamation, "出错啦！"
        txtnum.SetFocus
        Exit Sub
     End If
     If Len(txtnum.Text) <> 8 Then
        MsgBox "楼盘编号格式不对，应该为“00000000”！", vbOKOnly + vbExclamation
        txtnum.SetFocus
        Exit Sub
     End If
     txtnum.Text = Format(txtnum.Text, "00000000")
     txtlouhao.Text = Mid(txtnum.Text, 1, 2)
     txtdanyuan.Text = Mid(txtnum.Text, 3, 2)
     txtlouceng.Text = Mid(txtnum.Text, 5, 2)
     txtfanghao.Text = Mid(txtnum.Text, 7, 2)
     txtprice.SetFocus
End If
Exit Sub
texterror:
 MsgBox Err.Description
End Sub

Private Sub txtprice_KeyPress(KeyAscii As Integer)
On Error GoTo texterror
If KeyAscii = 13 Then
   If Not IsNumeric(txtprice.Text) Then
      MsgBox "价格请输入数字！", vbOKOnly + vbExclamation, ""
      txtprice.SetFocus
      Exit Sub
   End If
      cmdadd.SetFocus
End If
Exit Sub
texterror:
  MsgBox Err.Description
End Sub