📄 frmcheckout.frm
字号:
BackStyle = 0 'Transparent
Caption = "Check Out Date"
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 19
Top = 3360
Width = 1815
End
Begin VB.Label Label16
BackStyle = 0 'Transparent
Caption = "Check Out Time"
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2160
TabIndex = 18
Top = 3360
Width = 1815
End
End
Begin VB.Timer Timer1
Interval = 500
Left = 5040
Top = 7200
End
Begin VB.CommandButton Command4
BackColor = &H00808080&
Caption = "Quit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 9240
Style = 1 'Graphical
TabIndex = 1
Top = 7440
Width = 2535
End
Begin VB.CommandButton Command1
BackColor = &H00808080&
Caption = "Done"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 9240
Style = 1 'Graphical
TabIndex = 0
Top = 6240
Width = 2535
End
Begin VB.Label Label17
BackStyle = 0 'Transparent
Caption = "Customer No. List"
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 12120
TabIndex = 3
Top = 240
Visible = 0 'False
Width = 2055
End
Begin VB.Label Label10
BackStyle = 0 'Transparent
Caption = "Check Out Customers"
BeginProperty Font
Name = "Times New Roman"
Size = 24
Charset = 0
Weight = 700
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 735
Left = 480
TabIndex = 2
Top = 0
Width = 4815
End
End
Attribute VB_Name = "FrmCheckOut"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim MyDb As Database, MyRs As Recordset
Dim MyDb1 As Database, MyRs1 As Recordset
Dim Adv As Single, TOT As Single
Dim Db As Database, Rs As Recordset
Private Sub Combo1_Click()
If Combo1.Text = "CHEQUE" Then
Text18.Visible = True
Label24.Caption = "Cheque No."
Label24.Visible = True
ElseIf Combo1.Text = "D.D." Then
Text18.Visible = True
Label24.Caption = "DD No."
Label24.Visible = True
Else
Text18.Visible = False
Label24.Visible = False
End If
End Sub
Private Sub Command1_Click()
On Error Resume Next
If Combo1.Text = "" Then
MsgBox "Please select the Payment By"
Exit Sub
End If
If Text11.Text = "" Then
Text11.Text = 0
End If
If Text17.Text = "" Then
Text17.Text = 0
End If
Set MyDb1 = DBEngine.Workspaces(0).OpenDatabase("D:\HOTEL\PRINT\PRINT.MDB")
Set MyRs1 = MyDb1.OpenRecordset("PRINTDB", dbOpenDynaset)
MyRs1.AddNew
MyRs1!ID = Text1.Text
MyRs1!Name = Text2.Text
MyRs1!ADDRESS = Text3.Text
MyRs1!lodging = Text13.Text
MyRs1!FOODING = Text11.Text
MyRs1!ADVANCE = Text17.Text
MyRs1!ROOMNO = Text10.Text
MyRs1!TYPEOFROOM = Text8.Text
MyRs1!checkindate = Text7.Text
MyRs1!checkoutdate = Text14.Text
MyRs1!CHECKOUTTIME = Text15.Text
MyRs1!NETAMOUNT = Text16.Text
MyRs1!printstatus = "NOTDONE"
MyRs1!ROOMCHARGES = Text12.Text
MyRs1!NOOFDAYS = Text9.Text
MyRs1.Update
SQL = "select * from CUSTOMER where SL='" & List2.Text & "'"
Set MyDb = DBEngine.Workspaces(0).OpenDatabase("D:\HOTEL\CUSTOMER\CUSTOMER.MDB")
Set MyRs = MyDb.OpenRecordset(SQL, dbOpenDynaset)
'MyRs.MoveFirst
Do While Not MyRs.EOF
MyRs.Edit
MyRs!BILLINGTIME = Format(Now, "HH:MM AM/PM")
MyRs!BILLAMOUNT = TOT
MyRs!CHECKOUTSTATUS = "DONE"
MyRs!BILLBALANCE = Text16.Text
MyRs!BILLPAYMENTBY = Combo1.Text
MyRs!CH_DD_NO = Text18.Text
MyRs.Update
MyRs.MoveNext
Loop
SQL = "select * from ROOMS where ROOMNO='" & Text10.Text & "'"
Set Db = DBEngine.Workspaces(0).OpenDatabase("D:\HOTEL\ROOMS\ROOMS.MDB")
Set Rs = Db.OpenRecordset(SQL, dbOpenDynaset)
Rs.Edit
Rs!Status = "EMPTY"
Rs.Update
Rs.Close
Db.Close
MsgBox "Check Out Bill Has been Created"
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text7.Text = ""
Text7.Text = ""
Text6.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
Text14.Text = ""
Text15.Text = ""
Text16.Text = ""
Text17.Text = ""
List2.Clear
Form_Load
End Sub
Private Sub Command2_Click()
FrmPrintBill.Show
Unload Me
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Left = MDIForm1.Left + 1000
Me.Top = MDIForm1.Top + 1000
SQL = "select distinct sl from CUSTOMER where CHECKOUTSTATUS='" & "NOTDONE" & "'"
Set MyDb = DBEngine.Workspaces(0).OpenDatabase("D:\HOTEL\CUSTOMER\CUSTOMER.MDB")
Set MyRs = MyDb.OpenRecordset(SQL, dbOpenDynaset)
If MyRs.RecordCount <= 0 Then
Exit Sub
Else
Do While Not MyRs.EOF
List2.AddItem MyRs!SL
MyRs.MoveNext
Loop
End If
'MyDb.Close
Text14.Text = Format(Now, "DD/MM/yyyy")
Text15.Text = Format(Now, "hh:mm:ss AM/PM")
End Sub
Private Sub List2_Click()
On Error Resume Next
Dim RC
List1.Clear
List3.Clear
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text7.Text = ""
Text7.Text = ""
Text6.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
Text14.Text = ""
Text15.Text = ""
SQL = "select * from CUSTOMER where SL='" & List2.Text & "'"
Set MyDb = DBEngine.Workspaces(0).OpenDatabase("D:\HOTEL\CUSTOMER\CUSTOMER.MDB")
Set MyRs = MyDb.OpenRecordset(SQL, dbOpenDynaset)
Text1.Text = MyRs!SL
Text3.Text = MyRs!ADDRESS
Text2.Text = MyRs!Name
Text4.Text = MyRs!TEL
Text5.Text = MyRs!EMAIL
Text6.Text = MyRs!REGDATE
Text7.Text = MyRs!ARRIVAL
Text8.Text = MyRs!TYPEOFROOM
Text9.Text = MyRs!NOOFDAYS
Text7.Text = MyRs!checkindate
Text10.Text = MyRs!ROOMNO
Text14.Text = MyRs!checkoutdate
Text12.Text = MyRs!ROOMCHARGES
Text17.Text = MyRs!ADVANCE
Text15.Text = MyRs!CHECKOUTTIME
MyRs.MoveFirst
Do While Not MyRs.EOF
List1.AddItem MyRs!restitem
RC = MyRs!itemprice
List3.AddItem RC
Text11.Text = Val(Text11.Text) + RC
MyRs.MoveNext
Loop
Text13.Text = Val(Text9.Text) * Val(Text12.Text)
Adv = Val(Text13.Text) - Val(Text17.Text)
Text16.Text = Adv + Val(Text11.Text)
TOT = Val(Text13.Text) + Val(Text11.Text)
Command1.Enabled = True
Command2.Enabled = True
End Sub
Private Sub Text11_Change()
Dim Adv As Single
Adv = Val(Text13.Text) - Val(Text17.Text)
Text16.Text = Adv + Val(Text11.Text)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -