📄 check.frm
字号:
VERSION 5.00
Begin VB.Form check
BorderStyle = 3 'Fixed Dialog
Caption = "结算系统"
ClientHeight = 6900
ClientLeft = 45
ClientTop = 330
ClientWidth = 7440
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 6900
ScaleWidth = 7440
ShowInTaskbar = 0 'False
Begin VB.TextBox Text2
Height = 495
Index = 0
Left = 4800
Locked = -1 'True
TabIndex = 24
Top = 2040
Width = 1575
End
Begin VB.Frame Frame2
Caption = "客房信息"
Height = 5295
Left = 3720
TabIndex = 14
Top = 360
Width = 2895
Begin VB.TextBox Text1
Height = 495
Index = 8
Left = 1080
Locked = -1 'True
TabIndex = 27
Top = 4560
Width = 1575
End
Begin VB.TextBox Text2
Height = 495
Index = 1
Left = 1080
Locked = -1 'True
TabIndex = 25
Top = 960
Width = 1575
End
Begin VB.ComboBox Combo1
Height = 300
Left = 1080
TabIndex = 23
Top = 360
Width = 1575
End
Begin VB.TextBox Text1
Height = 495
Index = 5
Left = 1080
Locked = -1 'True
TabIndex = 22
Top = 3840
Width = 1575
End
Begin VB.TextBox Text1
Height = 495
Index = 4
Left = 1080
Locked = -1 'True
TabIndex = 21
Top = 3120
Width = 1575
End
Begin VB.TextBox Text1
Height = 495
Index = 3
Left = 1080
Locked = -1 'True
TabIndex = 20
Top = 2400
Width = 1575
End
Begin VB.Label Label2
Caption = "余额"
Height = 255
Left = 480
TabIndex = 28
Top = 4680
Width = 375
End
Begin VB.Label Label1
Caption = "客房标准"
Height = 495
Index = 10
Left = 240
TabIndex = 26
Top = 1800
Width = 735
End
Begin VB.Label Label1
Caption = "费用"
Height = 255
Index = 7
Left = 480
TabIndex = 19
Top = 3960
Width = 495
End
Begin VB.Label Label1
Caption = "折扣"
Height = 255
Index = 4
Left = 480
TabIndex = 18
Top = 3240
Width = 495
End
Begin VB.Label Label1
Caption = "客房编号"
Height = 255
Index = 5
Left = 240
TabIndex = 17
Top = 360
Width = 735
End
Begin VB.Label Label1
Caption = "客房单价"
Height = 255
Index = 6
Left = 240
TabIndex = 16
Top = 1080
Width = 735
End
Begin VB.Label Label1
Caption = "当前押金"
Height = 255
Index = 9
Left = 240
TabIndex = 15
Top = 2520
Width = 735
End
End
Begin VB.Frame Frame1
Caption = "顾客信息"
Height = 5295
Left = 480
TabIndex = 3
Top = 360
Width = 2775
Begin VB.TextBox Text1
Height = 495
Index = 7
Left = 960
Locked = -1 'True
TabIndex = 13
Top = 2400
Width = 1575
End
Begin VB.TextBox Text1
Height = 2055
Index = 6
Left = 960
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 12
Top = 3120
Width = 1575
End
Begin VB.TextBox Text1
Height = 495
Index = 2
Left = 960
Locked = -1 'True
TabIndex = 11
Top = 1680
Width = 1575
End
Begin VB.TextBox Text1
Height = 495
Index = 1
Left = 960
Locked = -1 'True
TabIndex = 10
Top = 960
Width = 1575
End
Begin VB.TextBox Text1
Height = 495
Index = 0
Left = 960
Locked = -1 'True
TabIndex = 9
Top = 240
Width = 1575
End
Begin VB.Label Label1
Caption = "顾客姓名"
Height = 375
Index = 0
Left = 120
TabIndex = 8
Top = 360
Width = 735
End
Begin VB.Label Label1
Caption = "身份证号"
Height = 255
Index = 1
Left = 120
TabIndex = 7
Top = 1080
Width = 735
End
Begin VB.Label Label1
Caption = "入住时期"
Height = 255
Index = 2
Left = 120
TabIndex = 6
Top = 1800
Width = 735
End
Begin VB.Label Label1
Caption = "结算时间"
Height = 255
Index = 3
Left = 120
TabIndex = 5
Top = 2520
Width = 735
End
Begin VB.Label Label1
Caption = "备注"
Height = 255
Index = 8
Left = 240
TabIndex = 4
Top = 3240
Width = 375
End
End
Begin VB.CommandButton cancel
Caption = "返回"
Height = 495
Left = 4920
TabIndex = 2
Top = 6120
Width = 1215
End
Begin VB.CommandButton reset
Caption = "清空"
Height = 495
Left = 2880
TabIndex = 1
Top = 6120
Width = 1215
End
Begin VB.CommandButton docheck
Caption = "结算"
Height = 495
Left = 960
TabIndex = 0
Top = 6120
Width = 1215
End
End
Attribute VB_Name = "check"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mydb As Database
Dim mydb1 As Database
Dim myrs As Recordset
Dim myrs1 As Recordset
Dim sql As String
Private Sub cancel_Click()
Unload Me
End Sub
Private Sub Combo1_Change()
Combo1_Click
End Sub
Private Sub Combo1_Click()
Dim a(0 To 3) As Integer
Dim b As Integer
Set mydb1 = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
Set myrs1 = mydb1.OpenRecordset("住房表", dbOpenDynaset)
myrs1.FindFirst "客房编号 = " + Chr(34) + Combo1.Text + Chr(34) + ""
For i = 0 To 6
Text1(i).Text = myrs1.Fields(i + 1)
Next
myrs1.Close
Set myrs1 = mydb1.OpenRecordset("客房表", dbOpenDynaset)
myrs1.FindFirst "客房编号 = " + Chr(34) + Combo1.Text + Chr(34) + ""
Text2(0).Text = myrs1.Fields("客房标准")
myrs1.Close
Set myrs1 = mydb1.OpenRecordset("客房标准", dbOpenDynaset)
myrs1.FindFirst "客房标准 =" + Chr(34) + Text2(0).Text + Chr(34) + ""
Text2(1).Text = myrs1.Fields("单价")
a(0) = DatePart("yyyy", Text1(2).Text)
a(1) = DatePart("yyyy", Now)
a(2) = DatePart("y", Text1(2).Text)
a(3) = DatePart("y", Now)
If a(0) = a(1) Then
b = a(3) - a(2)
Else
b = (a(1) - a(0)) * 365 + (365 - a(2)) + a(3)
End If
b = b * Val(Text2(1).Text) * Val(Text1(4).Text)
Text1(5).Text = str(b + Val(Text1(5).Text))
Text1(8).Text = str(Val(Text1(3).Text) - Val(Text1(5).Text))
myrs1.Close
mydb1.Close
End Sub
Private Sub docheck_Click()
If Combo1.Text <> "" Then
Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb")
Set myrs = mydb.OpenRecordset("客房表", dbOpenDynaset)
myrs.FindFirst "客房编号 = " + Chr(34) + Combo1.Text + Chr(34) + ""
If Not myrs.NoMatch Then
If myrs.Fields("状态") = "入住" Then
myrs.Edit
myrs.Fields("状态") = "无"
myrs.Update
myrs.Close
Set myrs = mydb.OpenRecordset("住房表", dbOpenDynaset)
myrs.FindFirst "客房编号 = " + Chr(34) + Combo1.Text + Chr(34) + ""
If Not myrs.NoMatch Then
myrs.Delete
myrs.MoveNext
End If
myrs.Close
mydb.Close
MsgBox ("客房结算成功！")
切换 (5)
Else
MsgBox ("此住房没有登记入住！"), 48, "警告"
End If
Else
MsgBox ("无此住房！"), 48, "警告"
End If
End If
End Sub
Private Sub Form_Load()
left = 100
Top = 100
Text1(7).Text = Date$
Combo1.Clear
Set mydb = Workspaces(0).OpenDatabase(App.Path & "\data\data.mdb") '设置数据库
sql = "select * from 客房表"
Set myrs = mydb.OpenRecordset(sql)
If myrs.EOF = False Then myrs.MoveLast
If myrs.BOF = False Then myrs.MoveFirst
For i = 0 To myrs.RecordCount - 1
If myrs.Fields(0) <> "" Then
If myrs.Fields("状态") = "入住" Then
Combo1.AddItem (myrs.Fields(0)) '添加到列表框
End If
End If
myrs.MoveNext
Next i
If Combo1.ListCount > 0 Then Combo1.ListIndex = 0
myrs.Close
mydb.Close
End Sub
Private Sub reset_Click()
切换 (5)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -