📄 main_kfdj.frm
字号:
End
Begin VB.Label Lab4
BackStyle = 0 'Transparent
Caption = "房间号码 客房标准 客房价格"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 180
TabIndex = 11
Top = 2310
Width = 7425
End
Begin VB.Label Lab9
BackStyle = 0 'Transparent
Caption = "备 注"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 180
TabIndex = 7
Top = 4185
Width = 1110
End
Begin VB.Label Lab2
BackStyle = 0 'Transparent
Caption = "联系地址"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 180
TabIndex = 4
Top = 1290
Width = 1080
End
Begin VB.Label Lab1
BackStyle = 0 'Transparent
Caption = "姓 名"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 180
TabIndex = 3
Top = 780
Width = 1110
End
Begin VB.Label Lab6
BackStyle = 0 'Transparent
Caption = "折前宿费 实际宿费 预收押金"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 180
TabIndex = 29
Top = 3255
Width = 8295
End
End
Attribute VB_Name = "main_kfdj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Integer '定义一个整型变量
Dim ssu As Integer
Private Sub Form_Load()
'自动识别数据库路径
End Sub
Private Sub Form_Activate()
'初始化日期及时间
DTP1.Value = Date: TIM1.Value = Time
tim2.Value = #12:00:00 PM#: DTP2.Value = Date: DTP3.Value = Date
'czy.Text = Main.StatusBar1.Panels(4).Text '赋值给czy
Comdj.SetFocus 'Comdj获得焦点
End Sub
Private Sub Form_Unload(Cancel As Integer)
Main.Enabled = True '设置主窗体有效
End Sub
Private Sub Combo2_Click()
If Combo2.Text = "折扣" Then
ZSDJ(8).Enabled = True '设置ZSDJ(8)有效
ZSDJ(8).SetFocus 'ZSDJ(8)获得焦点
End If
If Combo2.Text = "招待" Then
ZSDJ(8).Enabled = True '设置ZSDJ(8)有效
ZSDJ(8).Text = 0 '赋值给ZSDJ(8)
End If
End Sub
Private Sub ZSDJ_Change(Index As Integer)
Select Case Index
Case 5
ZSDJ(7).Text = Format(Val(ZSDJ(6).Text) * ssu, "0.00") '计算折前宿费
ZSDJ(9).Text = ZSDJ(5).Text '赋值给ZSDJ(9)
ZSDJ(8).Text = 100
DTP3.Value = DTP1.Value + Val(ZSDJ(6).Text) '计算退宿
Case 6
ZSDJ(7).Text = Format(Val(ZSDJ(6).Text) * ssu, "0.00") '计算折前宿费
ZSDJ(9).Text = ZSDJ(7).Text '赋值给ZSDJ(9)
ZSDJ(8).Text = 100
DTP3.Value = DTP1.Value + Val(ZSDJ(6).Text) '计算退宿日期
Case 8
ZSDJ(9).Text = Round(Format(Val(ZSDJ(7).Text) * Val(ZSDJ(8).Text) / 100, "0.00")) '计算实际宿费
Case 10
If ZSDJ(10).Text <> "" Then
ZSDJ(10).Text = Val(ZSDJ(10).Text) '用val函数将字符串转换为数字
DTP2.Value = DTP1.Value + Int(Val(ZSDJ(10).Text) / Val(ZSDJ(5).Text)) '计算提醒日期
If (Val(ZSDJ(10).Text) - Int(Val(ZSDJ(10).Text) / Val(ZSDJ(5).Text))) > 0.5 * Val(ZSDJ(5).Text) Then
tim2.Value = #6:00:00 PM#
Else
tim2.Value = #12:00:00 AM#
End If
End If
End Select
End Sub
Private Sub ZSDJ_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case Index
Case 0
If KeyCode = vbKeyReturn Then Combo1.SetFocus '按回车键Combo1获得焦点
Case 1
If KeyCode = vbKeyReturn Then ZSDJ(2).SetFocus '按回车键ZSDJ(2)获得焦点
Case 2
If KeyCode = vbKeyReturn Then ZSDJ(3).SetFocus '按回车键ZSDJ(3)获得焦点
Case 3
If KeyCode = vbKeyReturn Then DBCombo1.SetFocus '按回车键ZSDJ(2)获得焦点
Case 4
If KeyCode = vbKeyReturn Then ZSDJ(5).SetFocus '按回车键ZSDJ(5)获得焦点
Case 5
If KeyCode = vbKeyReturn Then ZSDJ(6).SetFocus '按回车键ZSDJ(6)获得焦点
Case 6
If KeyCode = vbKeyReturn Then ZSDJ(10).SetFocus
Case 8
If KeyCode = vbKeyReturn Then ZSDJ(10).SetFocus '按回车键ZSDJ(10)获得焦点
Case 10
If KeyCode = vbKeyReturn Then ZSDJ(11).SetFocus 'ZSDJ(11)获得焦点
Case 11
If KeyCode = vbKeyReturn Then Comok.SetFocus '按回车键Comok获得焦点
End Select
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then ZSDJ(1).SetFocus '按回车键ZSDJ(1)获得焦点
End Sub
Private Sub DTP2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then tim3.SetFocus '按回车键tim3获得焦点
End Sub
Private Sub DTP3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then tim4.SetFocus '按回车键tim4获得焦点
End Sub
Private Sub tim3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then DTP3.SetFocus '按回车键DTP3获得焦点
End Sub
Private Sub tim4_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text10.SetFocus '按回车键Text10获得焦点
End Sub
Private Sub DBCombo1_Change()
'查询空闲房间信息
If Data2.Recordset.RecordCount > 0 Then
If Data1.Recordset.RecordCount = 0 Then
ZSDJ(4).Text = Data2.Recordset.Fields("房间类型") '赋值给ZSDJ(4)
ZSDJ(5).Text = Data2.Recordset.Fields("价格") '赋值给ZSDJ(5)
ssu = Data2.Recordset.Fields("价格")
Else
MsgBox ("此房间已占用或停止使用!!")
End If
End If
'---------------------------------------
ZSDJ(6).Text = 1
ZSDJ(7).Text = Format(Val(ZSDJ(6).Text) * Val(ZSDJ(5).Text), "0.00") '计算折前宿费
ZSDJ(9).Text = ZSDJ(7).Text '赋值给ZSDJ(9)
ZSDJ(8).Text = 100
DTP3.Value = DTP1.Value + Val(ZSDJ(6).Text) '计算退宿日期
End Sub
Private Sub DBCombo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then ZSDJ(5).SetFocus 'ZSDJ(5)获得焦点
End Sub
Private Sub comdj_Click()
'查询空闲房间信息
Data1.RecordSource = "select * from djb order by 凭证号码"
Data1.Refresh
If Not Data1.Recordset.EOF Then Data1.Recordset.MoveLast
If lsph.Text = "" Then bh.Text = Date & "d" & Format(1, "###000")
If lsph.Text <> "" Then
y1.Text = Month(Date)
y2.Text = Month(Left(lsph.Text, 10))
If y1.Text = y2.Text Then
bh.Text = Date & "d" & Format(Val(Right(lsph.Text, 3)) + 1, "###000")
End If
If y1.Text <> y2.Text Then
bh.Text = Date & "d" & Format(1, "###000")
End If
End If
'清空数据
For i = 0 To 6
ZSDJ(i).Text = ""
ZSDJ(i).Enabled = True
Next i
ZSDJ(8).Text = "": ZSDJ(10).Text = "": ZSDJ(11).Text = "": DBCombo1.Text = "": DBCombo1.Text = ""
'设置控件有效或无效
Comok.Enabled = True: Comdj.Enabled = False: Comprint.Enabled = False: ZSDJ(8).Enabled = True
ZSDJ(10).Enabled = True: ZSDJ(11).Enabled = True: DBCombo1.Enabled = True: Combo1.Enabled = True
Combo2.Enabled = True: ZSDJ(0).SetFocus 'ZSDJ(0)获得焦点
'----------------------------------------------------------------
End Sub
Private Sub comok_Click()
Dim mydb1 As Database
Dim myrs1 As Recordset
Set mydb1 = Workspaces(0).OpenDatabase(ConData)
Set myrs1 = mydb1.OpenRecordset("djys", dbOpenTable)
Data1.Recordset.FindFirst "房间号 like" + Chr(34) + DBCombo1.Text + Chr(34) + "and 标志 like" + Chr(34) + "1" + Chr(34) + ""
If DBCombo1.Text = "" Then
MsgBox "对不起，房间号必须选择！"
Else
If Data1.Recordset.NoMatch Then
'添加住宿信息
Data1.Recordset.AddNew
If bh.Text <> "" Then Data1.Recordset.Fields("凭证号码") = bh.Text
If ZSDJ(0).Text <> "" Then Data1.Recordset.Fields("姓名") = ZSDJ(0).Text
If Combo1.Text <> "" Then Data1.Recordset.Fields("证件名称") = Combo1.Text
If ZSDJ(1).Text <> "" Then Data1.Recordset.Fields("证件号码") = ZSDJ(1).Text
If ZSDJ(2).Text <> "" Then Data1.Recordset.Fields("详细地址") = ZSDJ(2).Text
If ZSDJ(3).Text <> "" Then Data1.Recordset.Fields("出差事由") = ZSDJ(3).Text
If DBCombo1.Text <> "" Then Data1.Recordset.Fields("房间号") = Val(DBCombo1.Text)
If ZSDJ(4).Text <> "" Then Data1.Recordset.Fields("客房类型") = ZSDJ(4).Text
If DTP1.Value <> "" Then Data1.Recordset.Fields("住宿日期") = DTP1.Value
If TIM1.Value <> "" Then Data1.Recordset.Fields("住宿时间") = TIM1.Value
If ZSDJ(5).Text <> "" Then Data1.Recordset.Fields("客房价格") = Val(ZSDJ(5).Text)
If ZSDJ(6).Text <> "" Then Data1.Recordset.Fields("住宿天数") = ZSDJ(6).Text
If ZSDJ(8).Text <> "" Then Data1.Recordset.Fields("折扣") = ZSDJ(8).Text
If ZSDJ(7).Text <> "" Then Data1.Recordset.Fields("宿费") = ZSDJ(7).Text
If Combo2.Text <> "" Then Data1.Recordset.Fields("结款方式") = Combo2.Text
If ZSDJ(9).Text <> "" Then Data1.Recordset.Fields("应收宿费") = ZSDJ(9).Text
If ZSDJ(10).Text <> "" Then
Data1.Recordset.Fields("预收金额") = Val(ZSDJ(10).Text)
Else
Data1.Recordset.Fields("预收金额") = 0
End If
If DTP2.Value <> "" Then Data1.Recordset.Fields("提醒日期") = DTP2.Value
If tim2.Value <> "" Then Data1.Recordset.Fields("提醒时间") = tim2.Value
If DTP3.Value <> "" Then Data1.Recordset.Fields("退宿日期") = DTP3.Value
If tim3.Value <> "" Then Data1.Recordset.Fields("退宿时间") = tim3.Value
If ZSDJ(11).Text <> "" Then Data1.Recordset.Fields("备注") = ZSDJ(11).Text
Data1.Recordset.Fields("日期") = Date
Data1.Recordset.Fields("时间") = Time
Data1.Recordset.Fields("BZ") = Left(Date, 4) & Right(Left(Date, 7), 2) & Right(Date, 2) & Left(Time, 2) & Left(Right(Time, 5), 2)
Data1.Recordset.Fields("标志") = "1"
'更新记录
Data1.Recordset.Update
'添加住宿预收信息
myrs1.AddNew
If bh.Text <> "" Then myrs1.Fields("凭证号码") = bh.Text
If ZSDJ(0).Text <> "" Then myrs1.Fields("姓名") = ZSDJ(0).Text
If Combo1.Text <> "" Then myrs1.Fields("证件名称") = Combo1.Text
If ZSDJ(1).Text <> "" Then myrs1.Fields("证件号码") = ZSDJ(1).Text
If ZSDJ(2).Text <> "" Then myrs1.Fields("详细地址") = ZSDJ(2).Text
If ZSDJ(3).Text <> "" Then myrs1.Fields("出差事由") = ZSDJ(3).Text
If DBCombo1.Text <> "" Then myrs1.Fields("房间号") = Val(DBCombo1.Text)
If ZSDJ(5).Text <> "" Then myrs1.Fields("客房价格") = Val(ZSDJ(5).Text)
If DTP1.Value <> "" Then myrs1.Fields("住宿日期") = DTP1.Value
If TIM1.Value <> "" Then myrs1.Fields("住宿时间") = TIM1.Value
If ZSDJ(6).Text <> "" Then myrs1.Fields("住宿天数") = ZSDJ(6).Text
If Combo2.Text <> "" Then myrs1.Fields("结款方式") = Combo2.Text
If ZSDJ(8).Text <> "" Then myrs1.Fields("折扣") = ZSDJ(8).Text
If ZSDJ(7).Text <> "" Then myrs1.Fields("宿费") = ZSDJ(7).Text
If ZSDJ(9).Text <> "" Then myrs1.Fields("应收宿费") = ZSDJ(9).Text
If ZSDJ(10).Text <> "" Then
myrs1.Fields("预收金额") = Val(ZSDJ(10).Text)
Else
myrs1.Fields("预收金额") = 0
End If
If DTP2.Value <> "" Then myrs1.Fields("提醒日期") = DTP2.Value
If tim2.Value <> "" Then myrs1.Fields("提醒时间") = tim2.Value
If DTP3.Value <> "" Then myrs1.Fields("退宿日期") = DTP3.Value
If tim3.Value <> "" Then myrs1.Fields("退宿时间") = tim3.Value
If ZSDJ(11).Text <> "" Then myrs1.Fields("备注") = ZSDJ(11).Text
myrs1.Fields("日期") = Date
myrs1.Fields("时间") = Time
myrs1.Fields("BZ") = Left(Date, 4) & Right(Left(Date, 7), 2) & Right(Date, 2) & Left(Time, 2) & Left(Right(Time, 5), 2)
myrs1.Fields("标志") = "1"
'更新记录
myrs1.Update
'更新房间状态
Data2.Recordset.FindFirst "房间号 like " + Chr(34) + DBCombo1.Text + Chr(34) + ""
Data2.Recordset.Edit
Data2.Recordset.Fields("房态") = "入住"
Data2.Recordset.Update
'设置控件有效或无效
For i = 0 To 6
ZSDJ(i).Enabled = False
Next i
ZSDJ(8).Enabled = False: ZSDJ(10).Enabled = False: ZSDJ(11).Enabled = False
DBCombo1.Enabled = False: Combo1.Enabled = False
End If
End If
Comok.Enabled = False: Comprint.Enabled = True: Comdj.Enabled = True
Comprint.SetFocus
End Sub
Private Sub comcancel_Click() '取消操作
For i = 0 To 11
ZSDJ(i).Enabled = False
Next i
Comprint.Enabled = False: Comok.Enabled = False: DBCombo1.Enabled = False
Combo1.Enabled = False: Combo2.Enabled = False: DTP2.Enabled = False: DTP3.Enabled = False
tim2.Enabled = False: tim3.Enabled = False: Comdj.Enabled = True
End Sub
Private Sub comprint_Click() '打印住宿登记单据
Printer.Height = 8000: Printer.Width = 8000
Printer.CurrentX = 1100: Printer.CurrentY = 300
Printer.FontSize = 12
Printer.Print "宾馆 住宿证"
Dim a, b, C, D As Integer
a = 100: b = 500: C = 4800: D = 400
Printer.FontSize = 10
Printer.CurrentX = 100 + a
Printer.CurrentY = b + 200
Printer.Print Date & " " & Time & " NO." & bh.Text
b = b + D
Printer.Line (a, b + 100)-(C, b + 100)
Printer.CurrentX = 100 + a
Printer.CurrentY = b + 200
Printer.Print "姓名：" & ZSDJ(0).Text
b = b + D
Printer.CurrentX = 100 + a
Printer.CurrentY = b + 200
Printer.Print "房间号:" & DBCombo1.Text
b = b + D
Printer.CurrentX = 100 + a
Printer.CurrentY = b + 200
Printer.Print "押金:" & Format(ZSDJ(10).Text, "0.00")
b = b + D
Printer.CurrentX = 100 + a
Printer.CurrentY = b + 200
Printer.Print Combo2.Text & ":" & ZSDJ(8).Text & "%"
b = b + D
Printer.CurrentX = 100 + a
Printer.CurrentY = b + 200
Printer.Print "补交日期: " & DTP2.Value
b = b + D
Printer.Line (a, b + 100)-(C, b + 100)
Printer.CurrentX = 100 + a
Printer.CurrentY = b + 200
Printer.Print "操作员: " & czy.Text & " 欢迎光临"
Printer.EndDoc
End Sub
Private Sub comend_Click()
Unload Me
Main.Enabled = True
End Sub
Private Sub SearchIt()
'检索数据
Dim db As Database
Dim EF As Recordset
Set db = OpenDatabase(ConData, 0, 0, Constr)
Set EF = db.OpenRecordset("select * from kf", dbOpenDynaset)
'列出记录
If Not (EF.BOF And EF.EOF) Then
Do While Not EF.EOF
Combo1.AddItem EF("房间状态")
EF.MoveNext
Loop
End If
'
EF.Close
db.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -