📄 frmupdatecheckin.frm
字号:
VERSION 5.00
Begin VB.Form frmUpdateCheckIn
Caption = "入住信息修改"
ClientHeight = 6000
ClientLeft = 60
ClientTop = 345
ClientWidth = 7860
LinkTopic = "Form1"
ScaleHeight = 6000
ScaleWidth = 7860
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command3
Caption = "返回(&C)"
Height = 375
Left = 4320
TabIndex = 24
Top = 5400
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "修改(&U)"
Height = 375
Left = 2400
TabIndex = 23
Top = 5400
Width = 1335
End
Begin VB.Frame Frame2
Caption = "顾客信息"
Height = 1935
Left = 120
TabIndex = 11
Top = 3240
Width = 7575
Begin VB.TextBox txtCusMemo
Height = 1320
Left = 4800
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 16
Top = 360
Width = 2175
End
Begin VB.TextBox txtName
Height = 270
Left = 1320
MaxLength = 5
TabIndex = 15
Top = 360
Width = 2175
End
Begin VB.TextBox txtID
Height = 270
Left = 1320
MaxLength = 18
TabIndex = 14
Top = 720
Width = 2175
End
Begin VB.TextBox txtDateIn
Height = 270
Left = 1320
MaxLength = 10
TabIndex = 13
Top = 1080
Width = 2172
End
Begin VB.TextBox txtDiscount
Height = 270
Left = 1320
MaxLength = 3
TabIndex = 12
Top = 1440
Width = 1572
End
Begin VB.Label Label2
Caption = "%"
Height = 255
Index = 8
Left = 3000
TabIndex = 22
Top = 1440
Width = 495
End
Begin VB.Label Label2
Caption = "备 注 信 息："
Height = 255
Index = 7
Left = 3720
TabIndex = 21
Top = 360
Width = 1095
End
Begin VB.Label Label2
Caption = "入 住 时 间："
Height = 255
Index = 11
Left = 240
TabIndex = 20
Top = 1080
Width = 1095
End
Begin VB.Label Label2
Caption = "折 扣："
Height = 255
Index = 6
Left = 240
TabIndex = 19
Top = 1440
Width = 1095
End
Begin VB.Label Label2
Caption = "身份证号码："
Height = 255
Index = 5
Left = 240
TabIndex = 18
Top = 720
Width = 1095
End
Begin VB.Label Label2
Caption = "顾 客 姓 名："
Height = 255
Index = 4
Left = 240
TabIndex = 17
Top = 360
Width = 1095
End
End
Begin VB.Frame Frame1
Caption = "客房信息"
Height = 1935
Index = 1
Left = 120
TabIndex = 3
Top = 1200
Width = 7575
Begin VB.ComboBox cboRoom
Height = 315
Left = 1320
TabIndex = 26
Top = 480
Width = 2175
End
Begin VB.TextBox txtMemo
Height = 720
Left = 1320
MaxLength = 5
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 6
Top = 960
Width = 2175
End
Begin VB.TextBox txtPrice
Height = 285
Left = 4800
TabIndex = 5
Top = 960
Width = 2175
End
Begin VB.TextBox txtType
Height = 285
Left = 4800
TabIndex = 4
Top = 480
Width = 2175
End
Begin VB.Label Label2
Caption = "房间单价："
Height = 255
Index = 3
Left = 3720
TabIndex = 10
Top = 960
Width = 975
End
Begin VB.Label Label2
Caption = "房间编号："
Height = 255
Index = 0
Left = 240
TabIndex = 9
Top = 480
Width = 975
End
Begin VB.Label Label2
Caption = "房间种类："
Height = 255
Index = 1
Left = 3720
TabIndex = 8
Top = 480
Width = 975
End
Begin VB.Label Label2
Caption = "备注信息："
Height = 255
Index = 2
Left = 240
TabIndex = 7
Top = 1080
Width = 975
End
End
Begin VB.Frame Frame1
Caption = "选择条件"
Height = 855
Index = 0
Left = 120
TabIndex = 0
Top = 120
Width = 7575
Begin VB.TextBox txtRoomNo
Height = 285
Left = 1080
TabIndex = 25
Top = 360
Width = 2415
End
Begin VB.CommandButton Command1
Caption = "查询入住信息(&Q)"
Height = 375
Left = 4440
TabIndex = 2
Top = 360
Width = 1575
End
Begin VB.Label Label1
Caption = "房间号："
Height = 255
Left = 360
TabIndex = 1
Top = 360
Width = 735
End
End
End
Attribute VB_Name = "frmUpdateCheckIn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public sqlStr As String
Public msgText As String
Public oldRoomNo As String
Private Sub cboRoom_Click()
getRoomInfo
End Sub
Private Sub Command1_Click()
getCheckInfo
cboRoom_Click
End Sub
Private Sub Command2_Click()
Dim rstCheckIn As ADODB.Recordset
Dim rstRoom As ADODB.Recordset
Dim customerName As String
Dim customerID As String
Dim discount As Integer
Dim roomNo As String
Dim custMemo As String
Dim dateIn As String
roomNo = cboRoom.Text
customerName = txtName.Text
customerID = txtID.Text
discount = Val(txtDiscount.Text)
custMemo = txtCusMemo.Text
If oldRoomNo <> cboRoom.Text Then
checkout oldRoomNo
roomNo = cboRoom.Text
customerName = txtName.Text
customerID = txtID.Text
discount = Val(txtDiscount.Text)
custMemo = txtCusMemo.Text
'进行信息验证
'得到入住日期
dateIn = Format(Date, "yyyy-mm-dd")
'添加新记录
sqlStr = "select * from checkIn"
Set rstCheckIn = ExecuteSQL(sqlStr, msgText)
rstCheckIn.AddNew
rstCheckIn.Fields("roomNO") = roomNo
rstCheckIn.Fields("customerName") = customerName
rstCheckIn.Fields("customerID") = customerID
rstCheckIn.Fields("discount") = discount
rstCheckIn.Fields("memo") = custMemo
rstCheckIn.Fields("date_in") = Format(Date, "yyyy-mm-dd")
rstCheckIn.Update
rstCheckIn.Close
'修改房间的入住信息，将hasBooked字段的值更改为“是”
changeRoomStatus roomNo, "是"
Else
updateCheckIn cboRoom.Text
End If
MsgBox "房间修改完成！", vbOKOnly + vbExclamation, "警告"
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_Load()
initRoom
End Sub
Sub initRoom()
'初始化房间列表
Dim rstRoom As ADODB.Recordset
cboRoom.Clear
'初始化入住日期
sqlStr = "select DISTINCT roomno from checkIn where hasPaid='是'"
Set rstRoom = ExecuteSQL(sqlStr, msgText)
If Not rstRoom.EOF Then
Do While Not rstRoom.EOF
cboRoom.AddItem Trim(rstRoom.Fields(0))
rstRoom.MoveNext
Loop
Else
MsgBox "请添加客房类型！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
rstRoom.Close
End Sub
Sub getRoomInfo()
'查询房间信息
Dim rstRoom As ADODB.Recordset
sqlStr = "select * from roomInfo where roomNO='" & Trim(cboRoom.Text) & "'"
Set rstRoom = ExecuteSQL(sqlStr, msgText)
If Not rstRoom.EOF Then
txtPrice = rstRoom!roomPrice
txtType.Text = rstRoom!roomType
txtMemo.Text = rstRoom!roomMemo
Else
MsgBox "没有找到相关数据！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
rstRoom.Close
End Sub
Sub getCheckInfo()
'查询入住信息
Dim rstCheck As ADODB.Recordset
sqlStr = "select * from checkIn where roomNo='" & Trim(txtRoomNo.Text) & "'" _
& " AND hasPaid='否'"
Set rstCheck = ExecuteSQL(sqlStr, msgText)
If Not rstCheck.EOF Then
oldRoomNo = txtRoomNo.Text
cboRoom.Text = txtRoomNo.Text
txtName = rstCheck!customerName
txtID.Text = rstCheck!customerID
txtDateIn.Text = rstCheck!date_in
txtDiscount.Text = rstCheck!discount
txtCusMemo.Text = rstCheck!Memo
Else
MsgBox "没有找到相关数据！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
rstCheck.Close
End Sub
Sub checkout(roomNo As String)
'房间结帐
Dim rstCheckIn As ADODB.Recordset
Dim dateOut As Date
Dim dateIn As Date
Dim days As Integer
Dim totalfee As Double
'首先查找房间相关信息并修改结帐相关字段
changeRoomStatus roomNo, "否"
'查找该房间的登记信息，并修改相关结帐信息
sqlStr = "select * from checkIn where roomNo='" & roomNo & "'" _
& " AND hasPaid='否'"
Set rstCheckIn = ExecuteSQL(sqlStr, msgText)
dateOut = Format(Date, "yyyy-mm-dd")
If Not rstCheckIn.EOF Then
'住宿费结算
dateIn = CDate(rstCheckIn.Fields("date_in"))
dateOut = Date
days = DateDiff("d", dateIn, dateOut)
If days = 0 Then
totalfee = 0
Else
totalfee = days * Val(getRoomPrice(roomNo)) _
* Val(rstCheckIn.Fields("discount")) / 100
End If
'更新数据库中的相关信息
rstCheckIn.Fields("date_out") = dateOut
rstCheckIn.Fields("hasPaid") = "是"
rstCheckIn.Fields("totalPaid") = totalfee
rstCheckIn.Update
Else
MsgBox "没有找到相关数据！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
rstCheckIn.Close
MsgBox "应交纳住宿费用：" & totalfee & "元。"
End Sub
Sub changeRoomStatus(roomNo As String, status As String)
Dim conn As ADODB.Connection
'修改房间信息中hasBooked字段的值
sqlStr = "Update roomInfo set hasbooked='" & status & "'" _
& " where roomNo='" & roomNo & "'"
On Error GoTo exitSub
Set conn = New ADODB.Connection
conn.Open connStr
conn.Execute sqlStr
exitSub:
conn.Close
End Sub
Function getRoomPrice(roomNo As String) As Double
Dim rstPrice As ADODB.Recordset
'获取指定房间的价格
sqlStr = "select roomprice from roomInfo" _
& " where roomNo='" & roomNo & "'"
Set rstPrice = ExecuteSQL(sqlStr, msgText)
If Not rstPrice.EOF Then
getRoomPrice = Val(rstPrice.Fields("roomprice"))
Else
MsgBox "没有找到该房间的相关价格信息！！！"
End If
rstPrice.Close
End Function
Sub updateCheckIn(roomNo As String)
Dim conn As ADODB.Connection
'修改房间入住信息
sqlStr = "Update checkin set customerName='" & txtName.Text _
& "',customerID='" & txtID.Text & "',discount=" _
& txtDiscount.Text & ",[memo]='" & txtMemo.Text _
& "' where roomNo='" & roomNo & "' AND hasPaid='否'"
On Error GoTo exitSub
Set conn = New ADODB.Connection
conn.Open connStr
conn.Execute sqlStr
exitSub:
conn.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -