📄 frmyuding.frm
字号:
VERSION 5.00
Begin VB.Form frmYuDing
Caption = "预定租房"
ClientHeight = 4470
ClientLeft = 60
ClientTop = 345
ClientWidth = 8625
LinkTopic = "Form1"
ScaleHeight = 4470
ScaleWidth = 8625
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame1
Height = 2895
Left = 120
TabIndex = 3
Top = 1320
Width = 8295
Begin VB.TextBox Text1
Height = 375
Index = 8
Left = 5280
TabIndex = 23
Top = 2160
Width = 1695
End
Begin VB.TextBox Text1
Height = 375
Index = 7
Left = 1440
TabIndex = 21
Top = 2160
Width = 1215
End
Begin VB.TextBox Text1
Height = 375
Index = 6
Left = 5280
TabIndex = 19
Top = 1560
Width = 1695
End
Begin VB.TextBox Text1
Height = 375
Index = 5
Left = 1440
TabIndex = 16
Top = 1560
Width = 1215
End
Begin VB.TextBox Text1
Height = 375
Index = 4
Left = 5280
TabIndex = 13
Top = 960
Width = 1215
End
Begin VB.TextBox Text1
Height = 375
Index = 3
Left = 1440
TabIndex = 11
Top = 960
Width = 1215
End
Begin VB.TextBox Text1
Height = 375
Index = 2
Left = 6720
TabIndex = 9
Top = 360
Width = 1215
End
Begin VB.TextBox Text1
Height = 375
Index = 1
Left = 3960
TabIndex = 7
Top = 360
Width = 1215
End
Begin VB.TextBox Text1
Height = 375
Index = 0
Left = 1440
TabIndex = 5
Top = 360
Width = 1215
End
Begin VB.Label Label4
Caption = "月"
Height = 255
Left = 2760
TabIndex = 24
Top = 1680
Width = 375
End
Begin VB.Label Label1
Caption = "预定日期"
Height = 255
Index = 8
Left = 4200
TabIndex = 22
Top = 2280
Width = 735
End
Begin VB.Label Label1
Caption = "业 务 员"
Height = 255
Index = 7
Left = 360
TabIndex = 20
Top = 2280
Width = 735
End
Begin VB.Label Label1
Caption = "计划起租日期"
Height = 255
Index = 6
Left = 3840
TabIndex = 18
Top = 1680
Width = 1215
End
Begin VB.Label Label3
Caption = "元"
Height = 255
Left = 2760
TabIndex = 17
Top = 1080
Width = 375
End
Begin VB.Label Label1
Caption = "计划租期"
Height = 255
Index = 5
Left = 360
TabIndex = 15
Top = 1680
Width = 735
End
Begin VB.Label Label2
Caption = "天"
Height = 255
Left = 6720
TabIndex = 14
Top = 1080
Width = 375
End
Begin VB.Label Label1
Caption = "定金有效期"
Height = 255
Index = 4
Left = 3960
TabIndex = 12
Top = 1080
Width = 975
End
Begin VB.Label Label1
Caption = "定 金"
Height = 255
Index = 3
Left = 360
TabIndex = 10
Top = 1080
Width = 735
End
Begin VB.Label Label1
Caption = "预定房屋编号"
Height = 255
Index = 2
Left = 5520
TabIndex = 8
Top = 480
Width = 1215
End
Begin VB.Label Label1
Caption = "预定客户"
Height = 255
Index = 1
Left = 3000
TabIndex = 6
Top = 480
Width = 735
End
Begin VB.Label Label1
Caption = "预定单编号"
Height = 255
Index = 0
Left = 360
TabIndex = 4
Top = 480
Width = 975
End
End
Begin VB.Frame Frame3
Caption = "功能键"
Height = 975
Left = 600
TabIndex = 0
Top = 120
Width = 7335
Begin VB.CommandButton cmdDingJin
Caption = "收取定金"
Height = 495
Left = 3360
TabIndex = 27
Top = 240
Width = 975
End
Begin VB.CommandButton cmdAddQZClient
Caption = "添加求租客户"
Height = 495
Left = 1800
TabIndex = 26
Top = 240
Width = 1215
End
Begin VB.CommandButton cmdReset
Caption = "清空重填"
Height = 495
Left = 4680
TabIndex = 25
Top = 240
Width = 975
End
Begin VB.CommandButton cmdYuDing
Caption = "预 定"
Height = 495
Left = 480
TabIndex = 2
Top = 240
Width = 975
End
Begin VB.CommandButton cmdClose
Caption = "关 闭"
Height = 495
Left = 6000
TabIndex = 1
Top = 240
Width = 975
End
End
End
Attribute VB_Name = "frmYuDing"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义一些变量
Dim sqlyd As String
Dim sqlhc As String
Dim sqlcc As String
Dim sqlydc As String
Dim rs_yd As New ADODB.Recordset '用于打开预定表
Dim rs_hc As New ADODB.Recordset '用于检查房屋编号
Dim rs_cc As New ADODB.Recordset '用于检查预定客户
Dim rs_ydc As New ADODB.Recordset '用于检查预定表
Private Sub cmdAddQZClient_Click()
frmQZClient.Show
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdDingJin_Click()
fromYuding = True
cmdDingJin.Enabled = False
frmPayDingJin.Show
End Sub
Private Sub cmdReset_Click()
For i = 0 To 8
Text1(i).Text = ""
Next i
'设定定金有效期为5天
Text1(4).Text = 5
'设定预定日期为当前日期
Text1(8).Text = Date
cmdYuDing.Enabled = True
End Sub
Private Sub cmdYuDing_Click()
'预定前先检查数据完整性
If Text1(0).Text = "" Then
MsgBox "预定单编号不可为空！", vbOKOnly + vbInformation, "注意"
Text1(0).SetFocus
Exit Sub
ElseIf Text1(1).Text = "" Then
MsgBox "预定客户不可为空！", vbOKOnly + vbInformation, "注意"
Text1(1).SetFocus
Exit Sub
ElseIf Text1(2).Text = "" Then
MsgBox "预定房屋编号不可为空！", vbOKOnly + vbInformation, "注意"
Text1(2).SetFocus
Exit Sub
ElseIf Text1(3).Text = "" Or IsNumeric(Text1(3).Text) = False Then
MsgBox "定金应为数字！", vbOKOnly + vbInformation, "注意"
Text1(3).SetFocus
Exit Sub
ElseIf Text1(4).Text = "" Or IsNumeric(Text1(4).Text) = False Then
MsgBox "定金有效期应为数字！", vbOKOnly + vbInformation, "注意"
Text1(4).SetFocus
Exit Sub
ElseIf Text1(5).Text = "" Or IsNumeric(Text1(5).Text) = False Then
MsgBox "计划租期应为数字！", vbOKOnly + vbInformation, "注意"
Text1(5).SetFocus
Exit Sub
ElseIf Text1(6).Text = "" Or IsDate(Text1(6).Text) = False Then
MsgBox "计划起租日期应为这样的日期格式：2003-7-15！", vbOKOnly + vbInformation, "注意"
Text1(6).SetFocus
Exit Sub
ElseIf Text1(7).Text = "" Then
MsgBox "业务员不可为空！", vbOKOnly + vbInformation, "注意"
Text1(7).SetFocus
Exit Sub
ElseIf Text1(8).Text = "" Or IsDate(Text1(8).Text) = False Then
MsgBox "预定日期应为这样的日期格式：2003-7-15！", vbOKOnly + vbInformation, "注意"
Text1(8).SetFocus
Exit Sub
End If
'判断该预定单编号是否存在
sqlydc = "select * from YuDing where 预定单编号 = '" & Text1(0).Text & "'"
rs_ydc.Open sqlydc, conn, adOpenStatic, adLockOptimistic
If rs_ydc.EOF = False Then
MsgBox "该预定单编号已经存在，请填入一个新的编号！", vbOKOnly + vbInformation, "注意"
rs_ydc.Close
Text1(0).SetFocus
Exit Sub
End If
rs_ydc.Close
'还需要判断该预定客户是否在求租客户表中
sqlcc = "select * from QZClient where 求租客户姓名 = '" & Text1(1).Text & "'"
rs_cc.Open sqlcc, conn, adOpenStatic, adLockOptimistic
If rs_cc.EOF = True Then
MsgBox "该预定客户还未存入求租客户表中，请先加入求租客户表！", vbOKOnly + vbInformation, "注意"
rs_cc.Close
cmdAddQZClient.SetFocus
Exit Sub
End If
rs_cc.Close
'需要判断该房屋状态，如果为已租，则提醒用户，如果为预定，则不可预定，如果为未租，则可预定
sqlhc = "select * from House where 房屋编号 = '" & Text1(2).Text & "'"
rs_hc.Open sqlhc, conn, adOpenStatic, adLockOptimistic
If rs_hc.EOF = True Then
MsgBox "该房屋编号不存在，请选择正确的房屋编号！", vbOKOnly + vbInformation, "注意"
Text1(2).SetFocus
rs_hc.Close
Exit Sub
Else
If rs_hc.Fields(8) = "已租" Then
'房屋为已租时，也可预定，预定以后的租期，但要提醒用户
Dim answer As String
answer = MsgBox("该房屋已经出租了，是否仍要预定？", vbYesNo, "注意")
If answer = vbYes Then
sqlyd = "select * from YuDing "
rs_yd.Open sqlyd, conn, adOpenStatic, adLockOptimistic
rs_yd.AddNew
For i = 0 To 8
rs_yd.Fields(i) = Text1(i).Text
Next i
rs_yd.Update
MsgBox "已成功加入预定表！", vbOKOnly + vbInformation, "注意"
rs_yd.Close
rs_hc.Close
'最后需要设置预定按钮不可用和收取定金按钮可用
cmdYuDing.Enabled = False
cmdDingJin.Enabled = True
Exit Sub
Else
rs_hc.Close
Exit Sub
End If
ElseIf rs_hc.Fields(8) = "未租" Then
'房屋为未租时，可以预定
sqlyd = "select * from YuDing "
rs_yd.Open sqlyd, conn, adOpenStatic, adLockOptimistic
rs_yd.AddNew
For i = 0 To 8
rs_yd.Fields(i) = Text1(i).Text
Next i
rs_yd.Update
'修改房屋状态
rs_hc(8) = "预定"
rs_hc.Update
MsgBox "已成功加入预定表！", vbOKOnly + vbInformation, "注意"
rs_yd.Close
rs_hc.Close
'最后需要设置预定按钮不可用和收取定金按钮可用
cmdYuDing.Enabled = False
cmdDingJin.Enabled = True
Exit Sub
ElseIf rs_hc.Fields(8) = "预定" Then
'房屋为预定时，不可以再次预定
MsgBox "该房屋已被预定，请选择另外的房屋！", vbOKOnly + vbInformation, "注意"
rs_hc.Close
Exit Sub
End If
End If
End Sub
Private Sub Form_Load()
Dim X0 As Long
Dim Y0 As Long
'让窗体居中
X0 = Screen.Width
Y0 = Screen.Height
X0 = (X0 - Me.Width) / 2
Y0 = (Y0 - Me.Height) / 2
Me.Move X0, Y0
'开始时，收取定金按钮应不可用，必须单击预定按钮成功后，才设为可用
cmdDingJin.Enabled = fale
'判断是菜单直接调用还是求租客户资料窗体调用本窗体
If fromqzc = False Then
For i = 0 To 8
Text1(i).Text = ""
Next i
ElseIf fromqzc = True Then
Text1(1).Text = frmQZClient.Text1(1).Text
Text1(2).Text = frmQZClient.Text1(8).Text
End If
'设定定金有效期为5天
Text1(4).Text = 5
'设定预定日期为当前日期
Text1(8).Text = Date
End Sub
Private Sub Form_Unload(Cancel As Integer)
'设置fromqzc=false
fromqzc = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -