Rooms 客房信息表

列名	数据类型	可否为空	说　明
Bookno	Varchar	NOT NULL	订房编号
Customname	Varchar	NOT NULL	顾客姓名
CustomID	Varchar	NOT NULL	身份证号码
Roomno	Varchar	NOT NULL	客房编号
Indate	Datetime	NULL	入住日期
Discount	Numeric	NULL	折扣
Inmeno	Text	NULL	备注
Checkdate	Datetime	NULL	结算日期
Amount	Numeric	NULL	金额

Bookin 订房信息表
⒌数据库结构的实现
利用SQL 2000数据库系统中的查询分析实现数据库的逻辑结构，其表格如下：
创建系统用户表格 user_Info
CREATE TABLE [dbo].[user_Info1](
 [user_ID][char](10) COLLATE Chinese_PRC_CI_AS NOT NULL,
 [user_PWD] [char] (10) COLLATE Chinese_PRC_CI_AS NULL,
 [user_Des] [char](10) COLLATE Chinese_PRC_CI_AS NULL
 ) ON [PRIMARY]
创建客房标准信息表格　roomtype
 CREATE TABLE [dbo].[roomtype](
 [typeid][char](10) COLLATE Chinese_PRC_CI_AS NOT NULL,
 [typename][char](10) COLLATE Chinese_PRC_CI_AS NOT NULL,
 [area][numeric](5,0) NULL,
 [bednum][numeric](2,0) NULL,
 [haircondition][char](2) COLLATE Chinese_PRC_CI_AS NULL,
 [htelephone][char](2) COLLATE Chinese_PRC_CI_AS NULL,
 [htelevision][char](2) COLLATE Chinese_PRC_CI_AS NULL,
 [htoilet][char](2) COLLATE Chinese_PRC_CI_AS NULL,
 [price][numeric](10,2)NULL
 ) ON [PRIMARY]
创建客房信息表格　rooms
CREATE TABLE [dbo].[rooms](
 [roomNO][char](10) COLLATE Chinese_PRC_CI_AS NOT NULL,
 [roomtype][char](10) COLLATE Chinese_PRC_CI_AS NOT NULL,
 [roomposition][char](20) COLLATE Chinese_PRC_CI_AS NULL,
 [roomprice][numeric](10,2) NULL,
 [putup][char](2) COLLATE Chinese_PRC_CI_AS NOT NULL,
 [roommemo][text] COLLATE Chinese_PRC_CI_AS NULL
) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]
创建订房信息表bookin
CREATE TABLE [dbo].[bookin](
 [bookno][char](14) COLLATE Chinese_PRC_CI_AS NOT NULL,
 [customname][char](10) COLLATE Chinese_PRC_CI_AS NOT NULL,
 [customID][char](18) COLLATE Chinese_PRC_CI_AS NOT NULL,
 [roomno][char](10) COLLATE Chinese_PRC_CI_AS NOT NULL,
 [indate][datetime] NULL,
 [discount][numeric](2,0) NULL,
 [inmemo][text] COLLATE Chinese_PRC_CI_AS NULL,
 [checkdate][datetime] NULL,
 [ammount][numeric](10,2) NULL
) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]
⑴创建公用模块 Module1.bas
 添加公共数据操作函数，用以执行各种SQL语句。添加函数ExecuteSQL，代码如下：
Public Function ExecuteSQL(ByValSQL As String,MsgString AsString)_ As ADODB.Recordset
‘执行SQL语句，并返回记录集对象
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sTokens() As String
‘异常处理
On Error GoTo ExecuteSQL_Error’
‘用Split函数产生一个包含各个子串的数组
 sTokens=Split(SQL)
 Set cnn=NEW ADODB.Connection
‘打开连接
 cnn.Open ConnectString
 If InStr(“INSERT,DELETE,UPDATE”,UCase$(sTokens(0))) Then
 Cnn.Execute SQL
 MsgString=sTokens(0)&”query successful”
 Else
 Set rst=NEW ADODO.Recordset
 rst.Open Trim$(SQL),cnn,adOpenKeyset,adLockOptimistic
 rst.MoveLast
 get RecordCount
 ‘返回记录集对象
 Set ExecuteSQL=rst
 MsgString=”查询到”&rst.RecordCount&”条记录”
 End If
ExecuteSQL_Exit:
 Set rst=Nothing
 Set cnn=Nothing
 Exit Function
ExecuteSQL_Error:
 MsgString=”查询错误:”&Err.Description
 Resume ExecuteSQL_Exit
End Function
Public Sub EnterToTab(Keyasc As Integer)
‘判断是否为回车键
 If Keyasc=13 Then ‘ Keyasc用来保存当前按键
 ‘转换成Tab键
 SendKeys”{TAB}”
 End If
End sub
‘添加全局变量，用来记录各个窗口的读写状态，代码如下：
Public flagTedit As Boolean ‘ 标示是否进入修改的窗体
Public flagRedit As Boolean
Public flagBedit As Boolean
Public flagCedit As Boolean
Public gintCmode As Integer
Public gintTmode As Integer ’记录是添加还是修改状态，1为添加，2为修改
Public gintRmode As Integer
Public gintBmode As Integer
Public flagSedit As Boolean
⑵系统用户管理模块的创建
用户管理模块主要实现：
 •用户登陆。
 •添加用户。
•修改用户
 具体客房标准添加代码：
Private Sub Form_Load() ‘载入窗体后，判断所处状态
 Dim intCount As Integer
 Dim MsgText As String
 Dim i As Integer
 If gintTmode=1 Then ‘判断是否属于添加状态
 Me.Caption=Me.Caption & ”添加”
 For i=0 To 3
 Combo1(i).AddItem ”否”
 Combo1(i).AddItem ”是”
 Combo1(i).ListIndex=0
 Next i
 ElseIf gintTmode=2 Then ‘判断是否处于修改状态
 Set mrc=ExecuteSql(txtSQL,MsgText)
 If mrc.EOF=false Then
 With mrc
 For intCount=0 To 3
 txtItem(intCount)=.Fields(intCount)
 Next intCount
 txtItem(4)=.Fileds(8)
 For i=0 To 3
 Combo1(i).Additem ”否”
 Combo1(i).Additem ”是”
 Combo1(i).ListIndex=0
 Next i
 End With
 txtItem(0).Enabled=False
 End If
 Me.Caption=Me.caption&”修改”
End If
mblChang=False
End Sub
Private Sub cmd_Click()’用户输入内容完毕后，单击cmdSave按钮触发Click事件
 Dim intCount As Integer
 Dim sMeg As String
 Dim MsgText As String
 For intCount=0 To 4 ‘判断是否输入内容
 If Trim(txtItem(intCount)&””)=”” Then
 Select Case intCount
 Case 0
 sMeg=”标准编号”
 Case 1
 sMeg=”标准名称”
 Case 2
 sMeg=”房间面积”
 Case 3
 sMeg=”床位数量”
 Case 4
 sMeg=”床位单价”
 End Select
 sMeg=sMeg&”不能为空!”
 MsgBox sMeg,vbOkOnly+vbExclamation,”警告”
 txtItem(intCount).SetFocus
 Exit Sub
 End if
 Next intCount ‘判断输入内容是否为数字
 For intCount=2 To 4
 If Not IsNumeric(Trim(txtItem(intCount))) Then
 Select Case intCount
 Case 2
 sMeg=”房间面积”
 Case 3
 sMeg=”床位数量”
 Case 4
 sMeg=”床位单价”
 End Select
 sMeg=sMeg&”请输入数字!”
MsgBox sMeg,vbOKOnly+vbExclamation,”警告”
txtItem(intCount).SeFocus
Exit Sub
 End If
 Next intCount
 If gintTmode=1 Then ‘判断是否有相同ID记录
 txtSQL=”select*from roomtype where typeid_ =’”&Trim(txtItem(0))&”’”
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 If mrc.EOF=False Then
 MsgBox “已经存在此标准编号的记录!”,vbOKOnly+vbExclamation,”警告”
 txtItem(0).SetFocus
 Exit Sub
 End If
 Mrc.Close
 End If
 txtSQL=”select * from roomtype where typeid<>’”&Trim(txtItem(0))&”’and typename=’”&Trim(txtItem(1))&”’”
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 If mrc.EOF=False Then
 MsgBox”已经存在相同客房标准的记录!”,vbOKOnly+vbExclamation,“警告”
 txtItem(1).Setfocus
 Exit Sub
 End If
 txtSQL=”delete from roomtype where typeid=’”&Trim(txtItem(0))&”’”‘删除已有记录
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 txtSQL=”select *from roottype”‘添加新记录
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 mrc.AddNew
 For intCount=0 To 3
 mrc.Fields(intCount)=Trim(txtItem(intCount))
 Next intCount
 For intCount=0 To 3
 mrc.Fields(intCount+4)=Trim(Combo1(intCount))
 Next intCount
 mrc.Fields(8)=Trim(txtItem(4))
 mrc.Update ‘更新数据库
 mrc.Close
 if gintTmode=1 Then ‘判断是否属于添加状态
 MsgBox “添加纪录成功!”,vbOKOnly+vbExclamtion,“添加记录”
 For intCount=0 To 4
 txtItem(intCount)=”” ‘清除已经输入的内容
 Next intCount
 For intCount=0 To 3
 Combo1(intCount).ListIndex=0
 Next intCount
 mblChange=False’判断是否打开窗口
 if flagTedit Then
 Unload frmRoomtype
 frmRoomtype.txtSQL=“select *from roomtype”
 frmRoomtype.Show
 End If
 ElseIf gintTmode=2 Then ‘判断是否处于修改状态
 Unload Me
 If flagTedit Then
 Unload frmRoomtype
 EndIf
 frmRoomtype.txtSQL=”select *from roomtype”
 frmRoomtype.Show
 End If
End Sub
Private Sub txtItem_GotFocus(Index As Integer)’文本框获得焦点时触发该事件，即自动选中输入的内容，便于修改
txtItem(Index).SelStart=0
txtItem(Index).SelLength=Len(txtItem(Index))
End Sub
Private Sub cmdExit_Click()’单击按钮cmdExit取消添加信息
If mblChange And cmdSave.Enabled Then
 If MsgBox(“保存当前记录的变化吗？”,vbOKCancel+vbExclamation,”警告”)=vbOK Then ‘保存
 Call cmdSave_Click
 End If
End If
Unload Me
End Sub
Private Sub txtItem_KeyDown(Index As Integer,KeyCode As Integer,Shift_ As Integer)‘输入完内容，单击回车键将自动进入下一个文本框，触发文本框的Keydown事件
 EnterToTab KeyCode
End Sub
⑶修改客房标准窗体的创建
Private Sub From_Load()
ShowTitle
ShowData
flagTedit=True
End Sub
Private Sub ShowTitle()‘调用showTitle函数，显示表头
Dim i As Integer
With msgList
 .Cols=10
 .TextMatrix(0,1)=”标准编号”
 .TextMatrix(0,2)=”标准名称”
 .TextMatrix(0,3)=”房间面积”
 .TextMatrix(0,4)=”床位数量”
 .TextMatrix(0,5)=”是否有空调”
 .TextMatrix(0,6)=”是否有电话”
 .TextMatrix(0,7)=”是否有电视”
 .TextMatrix(0,8)=”是否有卫生间”
 .TextMatrix(0,9)=”房间单价”
 .FixedRows=1‘固定表头
 For i=0 To 9 ‘设置各列的对齐方式
 .ColAlignment(i)=0
 Next i
 .FillStyle=flexFillRepeat‘表头项居中
 .Col=0
 .Row=0
 .RowSel=1
 .ColSel=.Cols-1
 .CellAlignment=4
 .ColWidth(0)=300‘设置单元大小
 .ColWidth(1)=1000
 .ColWidth(2)=2000
 .ColWidth(3)=2000
 .ColWidth(4)=1000
 .ColWidth(5)=1000
 .ColWidth(6)=1000
 .ColWidth(7)=1000
 .ColWidth(8)=1000
 .ColWidth(9)=1000
 .Row=1
End With
End Sub
Private Sub ShowData()‘调用showData函数，显示记录列表
 Dim i As Integer
 Set mrc=ExecuteSQL(txtSQL,MsgText)‘根据需要设置SQL语句，显示需要的记录
 With msgList
 .Rows=1
 Do While Not mrc.EOF
 .Rows=Rows+1
 For i=1 To mrc.Fields.Count
 Select Case mrc.Fields(i-1).Type
 Case adDBDate
 .TextMatrix(.Rows-1,i)=Format(mrc.Fields(i-1)&””,”yyyy-mm-dd”)
 Case Else
 .TextMatrix(.Rows-1,i)=mrc.Fields(i-1)&””
 End Select
 Next i
 Mrc.MoveNext
 Loop
 End With
 mrc.Close
End Sub
Private Sub msgList_MouseUp(Button As Integer,Shift As Integer,x As Single,y As Single)‘选择记录，然后单击鼠标右键，触发MouseUp事件
 If Button=2 And Shift=0 Then
 PopupMenu fMainFrom.menuRoomtype
 End If
End Sub
Private Sub menuModifyroomtype_Click()
 Dim intCount As Integer
 If flagTedit Then ‘判断是否打开记录窗体
 If frmRoomtype.msgList.Rows>1 Then
 fintTmode=2‘设置为修改状态
 intCount=frmRoomtype.msgList.Row‘记下选择记录
 frmRoomtype1.txtSQL=”select*from roomtype where typeid’”&Trim(frmRoomtype.msgList.TextMatrix(intCount,1))&”’”
 frmRoomtype1.Show
 Else
 Call menuAddroomtype_Click
 End If
 Else
 frmRoomtype.txtSQL=”select*from roomtype”
 frmRoomtype.Show
 End If
End Sub
Private Sub From_Resize()‘窗体变化时，调整标签和表格位置，使标签处于窗体的最上方，而表格始终处于标签下方
 If Me.WindowState<>vbMinimized And fMainFrom.WindowState<>vbMinimized Then‘边界处理
 If Me.Scaleheight<10*lblTitle.Height Then
 Exit Sub
 End If
 If Me.ScaleWidth<lblTitle.Width+lblTitle.Width/2 Then
 Exit Sub
 End If
 lblTitle.Top=lblTitle.Height‘控制控件的位置
 lblTitle.Left=(Me.Width-lblTitle.Width)/2
 msgList.Top=lblTitle.Top+lblTitle.Height+lblTitle.Height/2
 msgList.Width=Me.ScaleWidth-200
 msgList.Left=Me.ScaleLeft+100
 msgList.Height=Me.ScaleHeight-msgList.Top-200
 End If
End Sub
⑷删除客房标准
Private Sub menuDeleteroomtype_Click()
 Dim txtSQL As String
 Dim intCount As Integer
 Dim mrc As ADODB.Recordset
 Dim MsgText As String
 If flagTedit Then ‘判断是否打开记录窗体
 If frmRoomtype.msgList.Rows>1 Then
 If MsgBox(“真的要删除这条文件记录么？”，vbOKCancel+vbExclamation,”警告”)=vbOK Then
 intCount=frmRoomtype.msgList.Row
 txtSQL=”delete from roomtype where typeid’”&Trim(frmRoomtype.msgList.TextMatrix(intCount,1))&”’”
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 Unload frmRoomtype‘关闭记录窗体
 frmRoomtype.txtSQL=”select*from roomtype”‘重新选择所有记录
 frmRoomtype.Show
 End If
 End If
 End If
End Sub
⑸客房信息管理模块的创建
 客房信息管理模块主要实现如下功能：
 •添加客房信息
 •修改客房信息
 •删除客房信息
 •查询客房信息
 具体实现代码如下：
Private Sub From_Load()‘载入窗体时，自动添加客房信息种类
 Dim sSql As String
 Dim intCount As Integer
 Dim MsgText As String
 Dim mrcc As ADODB.Recordset
 If gintRmode=1 Then ‘判断是否处于添加状态
 Me.Caption=me.Caption&“添加”
 txtSQL=”select DISTINCT typename from roomtype”
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 If Not mrc.EOF Then
 Do While Not mrc.EOF
 cboItem(0).AddItem Trim(mrc.Fields(0))
 mrc.MoveNext
 Loop
 cboItem(0).ListIndex=0‘显示记录内容
 Else
 MsgBox “请先进行客房标准设置!”,vbOKOnly+vbExclamation,“警告”
 cmdSave.Enabled=False
 Exit Sub
 End If
 mrc.Close
 ElseIf gintRmode=2 Then ‘判断是否处于修改状态
 Set mrcc=ExecuteSQL(txtSQL,MsgText)‘设置SQL语句显示当前选择记录
 If mrcc.EOF=False Then
 With mrcc
 txtItem(0)=.Fields(0)
 For intCount=1 To 2
 If Not IsNull(.Fields(intCount+1))Then‘判断内容是否为空
 txtItem(intCount)=.Fields(intCount+1)
 End If
 Next intCount
 txtItem(3)=.Fields(5)
 txtSQL=”select DISTINCT typename from roomtype”
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 If Not mrc.EOF Then
 Do While Not mrc.EOF
 cboItem(0).AddItem Trim(mrc.Fields(0))
 mrc.MoveNext
 Loop
 cboItem(0).ListIndex=0
 Else
 MsgBox“请先进行客房标准设置!”,vbOKOnly+vbExclamation,“警告”
 cmdSave.Enabled=False
 Exit Sub
 End If
 mrc.Close
 End With
 End If
 mrcc.Close
 Me.Caption=Me.Caption&“修改”
 End If
 mblChange=False
End Sub
Private Sub cmdSave_Click()‘单击保存按钮触发事件
 Dim intCount As Integer
 Dim sMeg As String
 Dim mrcc As ADODB.Recordset
 Dim Msgtext As String
 For intCount=0 To 3
 If Trim(TxtItem(intCount)&””)=”” Then
 Select Case intCount
 Case 0
 sMeg=“客房编号”
 Case 1
 sMeg=“客房位置”
 End Select
 sMeg=sMeg&“不能为空！”
 MsgBox sMeg,vbOKOnly+vbExclamation,“警告”
 txtItem(intCount).SetFocus
 Exit Sub
 End If
 Next intCount
 If gintRmode=1 Then‘判断是否有重复记录
 txtSQL=”select * from rooms where roomNO=‘”&Trim(txtItem(0))&”’”
 Set mrc=ExecuteSQL(txtSQL,msgText)
 If mrc.EOF=False Then
 MsgBox “已经存在此客房编号的记录！”,vbOKOnly+vbExclamation,“警告”
 txtItem(0).SetFocus
 Exit Sub
 End If
 mrc.Close
 End If
 If gintRmode=2 Then ‘判断是否处于修改状态
 txtSQL=”delete from rooms where roomNO=‘”&Trim(txtItem(0))&”’”
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 End If
 txtSQL=”select*from rooms”‘再加入新记录
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 mrc.AddNew‘为数据库对象添加记录
 mrc.Fields(0)=Trim(txtItem(0))
 mrc.Fields(1)=Trim(txtItem(0))
 For intCount=1 To 2
 If Trim(txtItem(intCount)&””)=”” Then
 mrc.Fields(intCount+1)=Null
 Else
 mrc.Fields(intCount+1)=Trim(txtItem(intCount))
 End If
 Next intCount
 mrc.Fields(4)=””
 mrc.Fields(5)=Trim(txtItem(3))
 mrc.Update
 mrc.Close
 If gintRmode=1 Then
 For intCount=0 To 3
 txtItem(intCount)=””
 Next intCount
 mblChange=False
 If flagRedit Then
 Unload frmRoom
 frmRoom.txtSQL=”select*from rooms”‘重新显示数据
 frmRoom.Show
 End If
 ElseIf gintRmode=2 Then
 Unload Me
 If flagRedit Then
 Unload frmRoom
 End If
 frmRoom.txtSQL=”select*from rooms”
 frmRoom.Show
 End If
End Sub
•修改客房信息
Private Sub menuModifyroom_Click()‘选择修改房间信息，触menuModifyroom的Click事件,程序判断为修改状态后，首先删除原有记录，然后把新内容加入到数据库中
 Dim intCount As Integer
 If flagRedit Then ‘判断记录窗体是否打开
 If frmRoom.msgList.Rows>1 Then‘判断客房信息列表内容是否为空
 gintRmode=2‘设置为修改状态
　　　　 intCount=frmRoom.msgList.Row‘纪录当前记录位置
frmRoom1.txtSQL=”select*from rooms where roomNO=’”&Trim(frmRoom.msgList.TextMatrix(intCount,1))&”’”
frmRoom1.Show
 Else
 Call menuAddroom_Click‘添加记录
　　　End If
Else
 frmRoom.txtSQL=”select*from rooms”
 frmRoom.Show
End If
End Sub
•删除客房信息
Private Sub menuDeleteroom_Click()
 Dim txtSQL As String
 Dim intCount As Integer
 Dim mrc As ADODB.Recordset
 Dim MsgText As String
 If flagTedit Then
 If frmRoom.msgList.Rows>1 Then‘判断客房信息列表内容是否为空
　　 If MsgBox(“真的要删除这条文件记录么？”,vbOKCancel+vbExclamation,“警告”)=vbOK Then
 intCount=frmRoom.msgList.Row‘记载当前记录位置
　　 txtSQL=”delete from rooms where roomNO=‘”&Trim(frmRoom.msgList.TextMatrix(intCount,1)&”’”
 Set mrc=ExecuteSQL(txtSQL,MsgText)‘执行删除操作
　　　　　　　　Unload frmRoom
 frmRoom.txtSQL=”select*from rooms”
 frmRoom.Show
 End If
 End If
 End If
End Sub
•查询客房信息
Private Sub From_Load()‘载入窗体时，将自动加入所有记录的入库时间
 Dim i As Integer
 Dim j As Integer
 Dim sSql As String
 Dim txtSQL As String
 Dim MsgText As String
 Dim mrc As ADODB.Recordset
 txtSQL=”select DISTINCT typename from roomtype”‘初始化客房种类
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 If Not mrc.EOF Then
 Do While Not mrc.EOF
 Combo1.AddItem Trim(mrc.Fields(0))
 Mrc.MoveNext
 Loop
 Combo1.ListIndex=0
 Else
 MsgBox “请先进行客房标准设置!”,vbOKOnly+vbExclamation,”警告”
 Exit Sub
 End If
 mrc.Close
End Sub
Private Sub cmdOK_Click()‘设置完查询内容和方式后，单击cmdOk按钮查询
 Dim sQSql As String
 If chkItem(0).Value=vbChecked Then
 sQSql=”roomNO=’”&Trim(txtItem(0)&””)&”’”
 End If
 If chkItem(1).Value=vbChecked Then
 If Trim(sQSql&””)=”” Then
 sQSql=”roomtype=’”&Trim(Combo1&””)&”’”
 Else
 sQSql=sQSql&”and roomtype=’”&Trim(Combo1&””)&”’”
 End If
 End If
 If Trim(sQSql)=”” Then
 MsgBox “请设置查询条件！”,vbOKOnly+vbExclamation,“警告”
 Exit Sub
 Else
 If flagRedit Then
 Unload frmRoom
 End If
 frmRoom.txtSQL=”select*from rooms where”&sQSql
 frmRoom.Show
 End If
 Me.Hide
End Sub
⑹订房信息管理模块的创建
订房信息管理模块主要实现如下功能：
•查询剩余客房信息
•添加订房信息
•修改订房信息
•删除订房信息
•查询订房库信息
具体实现代码如下：
Private Sub From_Load()‘载入窗体时，程序将自动加入客房种类和客房单价
 Dim txtSQL As String
 Dim MsgText As String
 Dim mrc As ADODB.Recordset
 txtSQL=”select distinct typename from roomtype”‘选择所有客房种类
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 If Not mrc.EOF Then
 Do While Not mrc.EOF
 Combo1(0).AddItem mrc.Fields(0)
 mrc.MoveNext
 Loop
 End If
 mrc.Close
 txtSQL=”select distinct price from roomtype”
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 If Not mrc.EOF Then
 Do While Not mrc.EOF
 Combo1(1).AddItem mrc.Fields(0)
 Combo1(2).AddItem mrc.Fields(0)
 mrc.MoveNext
 Loop
 End If
 mrc.Close
End Sub
Private Sub cmdOK_Click()
 Dim sQSql As String
 If chkItem(0).Value=vbChecked Then
 sQSql=”roomtype=’”&Trim(Combo1(0)&””)&”’”
 End if
 If chkItem(1).Value=vbChecked Then
 If Trim(sQSql&””)=”” Then
 If Trim(Combo1(1)&””)<>””And Trim(Combo1(2)&””)<>””
Then
 sQSql=”roomprice<=’”&Trim(Combo1(1)&””)&And roomprice >=’”&Trim(Combo1(2)&””)”’”
 ElseIf Trim(Combo1(1)&””)=””And Trim(Combo1(2)&””)<>””Then
 sQSql=”roomprice >=’”&Trim(Combo1(2)&””)&”’”
 ElseIf Trim(Combo1(1)&””)<>””And Trim(Combo1(2)&””=””Then
 sQSql=”roomprice<=’”&Trim(Combo1(1)&””)&”’”
 End If
 Else
 If Trim(Combo1(1)&””)<>””And Trim(Combo1(2)&””)<>””Then
 sQSql=sQSql&”androomprice>=’”&Trim(Combo1(1)&””)&”’and roomprice >=’”&Trim(Combo1(2)&””)&”’”
 ElseIf Trim(Combo1(1)&””)=””And Trim(Combo1(2)&””)<>””Then
 sQSql=sQSql&”and roomprice >=’”&Trim(Combo1(2)&””)&”’”
 ElseIf Trim(Combo1(1)&””)<>””And Trim(Combo1(2)&””)=””Then
 sQSql=sQSql&”and roomprice<=’”&Trim(Combo1(1)&””)&”’”
 End If
 End If
 If Trim(sQSql)=”” Then
 MsgBox “请设置查询条件!”,vbOKOnly+vbExclamation,“警告”
 Exit Sub
 Else
 If flagRedit Then
 Unload frmRoom
 End If
 frmRoom.txtSQL=”select*from rooms where”&sQSql&”and putup”<>’y’”
 frmRoom.Show
 flagSedit=True
 End If
 Me.Hide
End Sub
Private Sub From_Load()‘添加订房信息，载入窗体时把所有未预定的客房信息加入其中
 Dim sSql As String
 Dim intCount As Integer
 Dim MsgText As String
 If flagSedit Then ‘判断打开方式
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 If Not mrc.EOF Then
 For intCount=0 To 3
 cboItem(intCount).AddItem mrc.Fields(intCount)
 cboItem(intCount).ListIndex=0
 Next intCount
 txtItem(5)=mrc.Fields(5)
 End If
 mrc.Close
 txtNo=GetRkno()
 gintBmode=1
 Else
 If gintBmode=1 Then
 Me.Caption=Me.Caption&“添加”
 txtSQL=”select DISTINCT roomNO from rooms where putup<>’y’”
 Set mrc=ExecuteSQL(txtSQL.MsgText)
 If Not mrc.EOF Then
 Do While Not mrc.EOF
 cboItem(0).AddItem Trim(mrc.Fields(0))
 mrc.MoveNext
 Loop
 Else
 MsgBox “请先进行客房登记!”,vbOKOnly+vbExclamation,“警告”
 cmdSave.Enabled=False
 Exit Sub
 End If
 mrc.Close
 txtNo=GetRkno
 ElseIf gintBmode=2 Then
 Set mrc.ExecuteSQL(txtSQL,MsgText)
 If mrc.EOF Then
 With mrc
 txtNO=!bookno
 For intCount=0 To 1
 If Not IsNull(.Fields(intCount+1)) Then
 txtItem(intCount)=.Fields(intCount+1)
 End If
 Next intCount
 cboItem(0).AddItem !roomno
 cboItem(0).ListIndex=0
 For intCount=2 To 4
 If Not IsNull(.Fields(intCount+2)) Then
 txtItem(intCount)=.Fields(intCount+2)
 End If
 Next intCount
 End With
 End If
 mrc.Close
 Me.Caption=Me.Caption&“修改”
 txtSQL=”select*from rooms where roomNO=’”&Trim(cboItem(0))&”’”
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 If Not mrc.EOF Then
 For intCount=1 To 3
 cboItem(intCount).AddItem mrc.Fields(intCount)
 cboItem(intCount).ListIndex=0
 Next intCount
 txtItem(5)=mrc.Fields(5)
 End If
 mrc.Close
 End If
End If
 mblChange=False
End Sub
Private Sub cmdSave_Click()‘添加记录到数据库中
 Dim intCount As Integer
 Dim sMeg As String
 Dim mrcc As ADODB.Recordset
 Dim MsgText As String
 For intCount=0 To 3‘判断输入内容是否为空
 If Trim(txtItem(intCount)&””)=”” Then
 Select Case intCount
 Case 0
 sMeg=“顾客姓名”
 Case 1
 sMeg=“身份证号码”
 Case 2
 sMeg=“折扣”
 Case 3
 sMeg=“入住时间”
 End Select
 sMeg=sMeg&“不能为空!”
 MsgBox sMeg,vbOKOnly+vbExclamation,“警告”
 txtItem(intCount).SetFocus
 Exit Sub
 End If
 Next intCount
 For intCount=0 To 3
 If Trim(vboItem(intCount)&””)=””Then
 Select Case intCount
 Case 0
 sMeg=“客房编号”
 Case 1
 sMeg=“客房种类”
 Case 2
 sMeg=“客房位置”
 Case 3
 sMeg=“客房单价”
 End Select
 sMeg=sMeg&“不能为空！”
 MsgBox sMeg,vbOKOnly+vbExclamation,“警告”
 cboItem(intCount).SetFocus
 Exit Sub
 End If
 Next intCount
 If IsDate(txtItem(2)) Then
 txtItem(2)=Format(txtItem(2),”yyyy-mm-dd”)
 Else
 MsgBox “入库时间应输入日期(yyyy-mm-dd)!”,vbOKOnly+vbExclamation,”警告”
 txtItem(2).SetFocus
 Exit Sub
 End If
 For intCount=1 To 3 Step 2
 If Not IsNumeric(txtItem(intCount)) Then
 MsgBox “请输入数字”,vbOKOnly+vbExclamation,“警告”
 txtItem(intCount).SetFocus
 Exit Sub
 End If
 Next intCount
 If gintBmode =2 Then
 txtSQL=”delete from booking where bookno=’”&Trim(txtNo)&”’”
 Set mrcc=ExecuteSQL(txtSQL,MsgText)
 End If
 txtSQL=”select*from booking”
 Set mrcc=ExecuteSQL(txtSQL,MsgText)
 mrcc.AddNew
 mrcc.Fields(0)=txtNO
 For intCount=0 To 1
 mrcc.Fields(intCount+1)=txtItem(intText)
 Next intCount
 mrcc.Fields(3)=cboItem(0)
 For intCount=2 To 4
 mrcc.Fields(intCount+2)=txtItem(intCount)
 Next intCount
 mrcc.Fields(8)=0
 mrcc.Update
 mrcc.Close
 txtSQL=”select*from rooms where roomNO=’”&Trim(vboItem(0))&”’”
 Set mrcc=ExecuteSQL(txtSQL,MsgText)
 If Not mrcc.EOf Then
 mrcc!putup=”y”
 End If
 mrcc.Update
 mrcc.Close
 If gintBmode=1 Then
 MsgBox “添加订房信息成功!”,vbOKOnly+vbExclamation,“添加订房消息”
 Unload Me
 If flagBedit Then
 Unload frmBookin
 End If
 frmBookin.txtSQL=”select bookno,customname,customID,roomno,indate,discount,inmemo from booking where amount=’0’”
 frmBookin.Show
 Else
 MsgBox“修改订房信息成功!”,vbOKOnly+vbExclamation,“修改订房信息”
 Unload Me
 If flagBedit Then
 Unload frmBookin
 End If
 frmBookin.txtSQL=”select bookno,customname,customID,roomno,indate,discount,inmemo from booking where amount =’0’”
 frmBookin.Show
 End If
End Sub
⑺结算信息管理模块的创建
结算信息管理模块主要实现如下功能：
•添加结算信息
•修改结算信息
•查询结算信息
具体实现代码如下：
Private Sub From_Load()‘窗体载入时，自动加入所有未结算客房信息
 Dim sSql As String
 Dim intCount As Integer
 Dim MsgText As String
 If gintCmode=1 Then ‘判断是否处于添加状态
 Me.Caption=Me.Caption&“添加”
 txtSQL=”select DISTINCT roomno from booking where amount=’0’”‘初始化客房编号，选择所有未结算客房编号
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 If Not mrc.EOF Then
 Do While Not mrc.EOF
 cboItem(0).AddItem Trim(mrc!roomno)
 mrc.MoveNext
 Loop
 Else
 MsgBox “没有顾客入住!”,vbOKOnly+vbExclamation,“警告”
 cmdSave.Enabled=False
 Exit Sub
 End If
 mrc.Close
 ElseIf gintCmode=2 Then‘判断是否处于修改状态
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 If mrc.EOF=False Then
 With mrc
 txtNo =mrc.Fields(0)
 For intCount=0 To 1
 txtItem(intCount)=.Fields(intCount+1)
 Next intCount
 cboItem(0).AddItem.fields(3)
 cboItem(0).ListIndex=0
 For intCount=2 To 3
 If Not IsNull(.Fields(intCount+2)) Then
 txtItem(intCount)=.Fields(intCount+2)
 End If
 Next intCount
 txtItem(5)=.Fields(6)
 txtItem(4)=.Fields(7)
 End With
 End If
 mrc.Close
 txtSQL=”select*from rooms where roomNO=’”&cboItem(0)&”’”
 Set mrc=ExecuteSQL(txtSQL,MsgText)
 If mrc.EOF=False Then
 With mrc
 For intCount=1 To 3
 cboItem(intCount).AddItem.Fields(intCount)
 cboItem(intCount).ListIndex=0
 Next intCount
 End With
 End If
 mrc.Close
 For intCount =0 To 3
 txtItem(intCount).Enabled=False
 Next intCount
 Me.Caption=Me.Caption&“修改”
 End If
 mblChange=False
End Sub
Private Sub cboItem_Click(Index As Integer)‘选择不同客房，触发cboItem下拉式文本框的click事件，显示相应的顾客信息
 Dim sSql As String
 Dim MsgText String
 Dim mrcc As ADODB.Recordset
 Dim intCount As Integer
 If gintCmode =1 Then ‘判断是否处于添加状态，否则将退出
 If Index=0 Then
 cboItem(1).Enabled=True
 cboItem(2).Enabled=True
 cboItem(3).Enabled=True
 cboItem(1).Clear‘清除原有内容
 cboItem(2).Clear
 cboItem(3).Clear
 txtSQL=”select roomNO,roomtype,roomposition,roomprice from where roomNo =’”&Trim(cboItem(0))&”’” ‘显示有关客房的具体信息
 Set mrcc=ExecuteSQL(txtSQL,MsgText)
 If Not mrcc.EOF Then
 cboItem(1).AddItem mrcc!roomtype
 cboItem(2).AddItem mrcc!roomposition
 cboItem(3).AddItem mrcc!roomprice
 cboItem(1).Enabled=False
 cboItem(2).Enabled=False
 cboItem(3).Enabled=False
 cboItem(1).ListIndex=0
 cboItem(2).ListIndex=0
 cboItem(3).ListIndex=0
 cmdSave.Enabled=True
 Else
 MsgBox “没有订房信息!”,vbOKOnly+vbExclamation, “警告”
 cmdSave.Enabled=False
 Exit Sub
 End If
 mrcc.Close
 txtSQl=”select*from booking where amount=’0’and roomno=’”&Trim(cboItem(0))&”’”‘显示相关顾客信息
 Set mrcc=ExecuteSQL(txtSQL,MsgText)
 If Not mrcc.EOF Then
 txtNO=mrcc!bookno
 txtItem(0)=mrcc!customname
 txtItem(1)=mrcc!customID
 txtItem(2)=mrcc!indate
 txtItem(3)=mrcc!discount
 txtItem(5)=mrcc!inmemo
 For intCount =0 To 3
 txtItem(intCount).Enabled=False
 Next intCount
 End If
 mrcc.Close
 End If
 End If
 Exit Sub
End Sub
Privte Sub cmdSave_Click()
 Dim intCount As Integer
 Dim sMeg As String
 Dim mrcc As ADODB.Recordset
 Dim MsgText As String
 Dim bYear As Integer
 Dim eYear As Integer
 Dim bDays As Integer
 Dim eDays As Integer
 Dim aDays As Integer
 Dim amMount As Double
 If Trim(txtItem(4)&””)=””Then
 MsgBox sMeg,vbOKOnly+vbExclamation,“警告”
 txtItem(4).SetFocus
 Exit Sub
 End If
 If IsDate(txtItem(4)) Then
 txtItem(4)=Format(txtItem(4),”yyyy-mm-dd”)
 Else
 MsgBox “入库时间应输入日期（yyyy-mm-yy）!”,vbOKOnly+vbExclamation,“警告”
 txtItem(4).SetFocus
 Exit Sub
 End If
 txtSQl=”select *from booking where bookno=’”&Trim(txtNo)&”’”‘加入新记录
 Set mrcc=ExecuteSQL(txtSQL,MsgText)
 mrcc.Fields(6)=txtItem(5)
 mrcc.Fields(7)=txtItem(4)
 bYear=DatePart(“yyyy”,txtItem(2))‘获得入住日期和结算日期年代
 eYear=DatePart(“yyyy”,txtItem(4))
 bDays=DatePart(“y”,txtItem(2))‘获得入住日期和结算日期天数
 eDays=DatePart(“y”,txtItem(4))
 If bYear=eYear Then
 aDays=eDays-bDays
 Else
 aDays=(eYear-bYear-1)*365+(365-bDays)+eDays
 End If
 mrcc.Fields=aDays*Trim(cboItem(3))*Trim(txtItem(3))/100‘计算应交房费
 amMount=aDays*Trim(cboItem(3))*Trim(txtItem(3))/100
 mrcc.Update‘更新数据
 mrcc.Close
 txtSQL=”select*from rooms where roomNO=’”&cboItem(0)&”’”
 Set mrcc=ExecuteSQL(txtSQL,MsgText)
 If Not mrcc.EOF Then
 mrcc!putup=””
 End If
 mrcc.Update
 mrcc.Close
 If gintCmode =1 Then
 Unload Me
 mblChange=False
 MsgBox “金额为”amMount&“元，结算完毕！”,vbOKOnly+vbExclamation,“添加结算信息”
 If flagCedit Then
 Unload frmCheckout
 End If
 frmCheckout.txtSQL=”select*from booking where ammount<>’0’”
 frmCheckout.Show
 ElseIf gintCmode=2 Then
 MsgBox “金额为”&amMount&“ 元，结算信息修改完毕！”,vbOKOnly+vbExclamation,“修改结算信息 ”
 Unload Me
 If falgCedit Then
 Unload frmCheckout
 End If
 frmCheckout.txtSQL=”select*from booking where ammount<>’0’”
 frmCheckout.Show
 End If
End Sub

上一页  [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [11] [12]  下一页