frmhetonglogin.frm
来自「一个优秀的售楼系统,可供毕业生毕业设计参考」· FRM 代码 · 共 944 行 · 第 1/3 页
FRM
944 行
Top = 3000
Width = 900
End
Begin VB.Label Label15
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "车位价款："
Height = 180
Left = 3720
TabIndex = 15
Top = 2640
Width = 900
End
Begin VB.Label Label14
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "折扣率："
Height = 180
Left = 3960
TabIndex = 14
Top = 2280
Width = 720
End
Begin VB.Label Label13
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "销售员姓名："
Height = 180
Left = 3600
TabIndex = 13
Top = 1920
Width = 1080
End
Begin VB.Label Label12
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "购买人姓名："
Height = 180
Left = 3600
TabIndex = 12
Top = 1560
Width = 1080
End
Begin VB.Label Label11
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "楼盘资料："
Height = 180
Left = 3720
TabIndex = 11
Top = 1200
Width = 900
End
Begin VB.Label Label10
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "合同签订日期："
Height = 180
Left = 3360
TabIndex = 10
Top = 840
Width = 1260
End
Begin VB.Label Label9
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "合同状态："
ForeColor = &H000000FF&
Height = 180
Left = 3720
TabIndex = 9
Top = 480
Width = 900
End
Begin VB.Label Label8
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "合同总价："
Height = 180
Left = 600
TabIndex = 8
Top = 3000
Width = 900
End
Begin VB.Label Label7
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "楼盘价款："
Height = 180
Left = 600
TabIndex = 7
Top = 2640
Width = 900
End
Begin VB.Label Label6
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "合同单价："
Height = 180
Left = 600
TabIndex = 6
Top = 2280
Width = 900
End
Begin VB.Label Label5
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "销售人员编号："
Height = 180
Left = 240
TabIndex = 5
Top = 1920
Width = 1260
End
Begin VB.Label Label4
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "购买人身份证号："
Height = 180
Left = 120
TabIndex = 4
Top = 1560
Width = 1440
End
Begin VB.Label Label3
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "购买楼盘编号："
Height = 180
Left = 240
TabIndex = 3
Top = 1200
Width = 1260
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "认购日期："
Height = 180
Left = 600
TabIndex = 2
Top = 840
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "合同编号："
Height = 180
Left = 600
TabIndex = 1
Top = 480
Width = 900
End
End
Begin VB.Label Label31
AutoSize = -1 'True
BackColor = &H00C0FFFF&
Caption = "选择合同号查看合同："
Height = 180
Left = 240
TabIndex = 48
Top = 120
Width = 1800
End
End
Attribute VB_Name = "frmhetonglogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs_hetong As New ADODB.Recordset
Dim rs_kehu As New ADODB.Recordset
Dim selecthetong As String
Private Sub combofind_Click()
selecthetong = combofind.List(combofind.ListIndex)
displaymingxi
End Sub
Private Sub cmdadd_Click()
On Error GoTo saveerror
Dim sql As String
Dim i As Integer
If cmdadd.Caption = "签订合同" Then
If Trim(combolounum.Text) = "" Then
MsgBox "楼盘编号不能为空！", vbOKOnly + vbExclamation, "出错啦！"
combolounum.SetFocus
Exit Sub
End If
If Trim(combobuyerid.Text) = "" Then
MsgBox "购买人身份证号不能为空！", vbOKOnly + vbExclamation, "出错啦！"
combobuyerid.SetFocus
Exit Sub
End If
If Trim(combosaleid.Text) = "" Then
MsgBox "销售人员编号不能为空！", vbOKOnly + vbExclamation, "出错啦！"
combosaleid.SetFocus
Exit Sub
End If
sql = "select 合同.* from 合同"
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
rs_hetong.MoveFirst
Do While Not rs_hetong.EOF
If rs_hetong.Fields(1) = Trim(combolounum.Text) Then
MsgBox "此房已售出！", vbOKOnly + vbExclamation, "出错啦！"
combolounum.SetFocus
rs_hetong.Close
Exit Sub
End If
rs_hetong.MoveNext
Loop
sql = "select 楼盘.*,户型.* from 楼盘,户型 where 楼盘.hos_id = '" & combolounum.Text & "'" & _
" and 楼盘.hos_hstid = 户型.Hst_ID"
rs_kehu.CursorLocation = adUseClient
rs_kehu.Open sql, conn, adOpenKeyset, adLockPessimistic
rs_hetong.AddNew
rs_hetong.Fields(4) = rs_kehu.Fields(2) '合同单价
rs_kehu.Close
Label25.Caption = "已签订" '合同状态
rs_hetong.Fields(0) = Label22.Caption '合同编号
rs_hetong.Fields(1) = combolounum.Text '楼盘编号
rs_hetong.Fields(2) = combobuyerid.Text '购买人身份证号
rs_hetong.Fields(3) = combosaleid.Text '销售人员编号
If txtzhekou.Text <> "" Then
rs_hetong.Fields(5) = CSng(txtzhekou.Text) '折扣率
Else
rs_hetong.Fields(5) = Null
End If
rs_hetong.Fields(6) = CCur(Val(txtzhekou.Text) * 1000) '现金折扣
rs_hetong.Fields(7) = txtcheweinum.Text '车位编号
If txtcheweip.Text <> "" Then
rs_hetong.Fields(8) = CCur(txtcheweip.Text) '车位价款
End If
rs_hetong.Fields(9) = txtbasenum.Text '地下室编号
If txtbasep.Text <> "" Then
rs_hetong.Fields(10) = txtbasep.Text '地下室价款
End If
rs_hetong.Fields(11) = combofukuan.Text '还款方式
rs_hetong.Fields(12) = txtbank.Text '贷款银行
rs_hetong.Fields(13) = DTPicker1.Value '认购日期
rs_hetong.Fields(14) = DTPicker2.Value '合同签订日期
rs_hetong.Update
rs_hetong.Close
combofind.AddItem Label22.Caption
savegrid
MsgBox "签订成功！", vbOKOnly + vbExclamation, ""
txtinput.Visible = False
cmdadd.Caption = "新合同"
cmdmodify.Enabled = True
cmddel.Enabled = True
Else
cmdadd.Caption = "签订合同"
Label25.Caption = "未签订"
sql = "select * from 合同"
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
rs_hetong.MoveLast
Label22.Caption = CStr(rs_hetong.Fields(0) + 1)
cmdmodify.Enabled = False
cmddel.Enabled = False
rs_hetong.Close
combofukuan.Text = ""
combolounum.Text = ""
combobuyerid.Text = ""
combosaleid.Text = ""
txtprice.Text = ""
txtzhekou.Text = ""
txtcheweip.Text = ""
txtcheweinum.Text = ""
txtbasenum.Text = ""
txtcashzhekou.Text = ""
txtbasep.Text = ""
txtbank.Text = ""
Label23.Caption = ""
Label24.Caption = ""
Label27.Caption = ""
Label28.Caption = ""
Label26.Caption = ""
With gridhetong
.ScrollBars = flexScrollBarBoth
.FixedCols = 0
.Rows = 5
.Cols = 2
.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
gridhetong.Row = 0
gridhetong.Col = 0
gridhetong.Text = "日期"
gridhetong.Col = 1
gridhetong.Text = "金额"
End If
Exit Sub
saveerror:
MsgBox Err.Description
End Sub
Private Sub cmdmodify_Click()
On Error GoTo modifyerror
Dim sql As String
Dim i As Integer
If Trim(combobuyerid.Text) = "" Then
MsgBox "购买人身份证号不能为空！", vbOKOnly + vbExclamation, "出错啦！"
combobuyerid.SetFocus
Exit Sub
End If
If Trim(combosaleid.Text) = "" Then
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?