📄 frmreservation.frm
字号:
End
Begin VB.Label lblAmountPaid
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Amount Paid"
ForeColor = &H00000000&
Height = 300
Left = 7650
TabIndex = 53
Top = 4080
Width = 1395
End
Begin VB.Label Label24
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Balance"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 7650
TabIndex = 52
Top = 4470
Width = 1395
End
Begin VB.Label Label9
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Total"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 7650
TabIndex = 51
Top = 3630
Width = 1395
End
Begin VB.Label Label23
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Model"
Height = 300
Left = 210
TabIndex = 50
Top = 5340
Width = 1395
End
Begin VB.Label Label28
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Vehicle Make"
Height = 300
Left = 210
TabIndex = 49
Top = 4920
Width = 1395
End
Begin VB.Label Label29
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Plate No."
Height = 300
Left = 210
TabIndex = 48
Top = 5760
Width = 1395
End
Begin VB.Label Label16
BackStyle = 0 'Transparent
Caption = "Notes"
Height = 285
Left = 4530
TabIndex = 47
Top = 4230
Width = 585
End
End
Begin VB.PictureBox bgHeader
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 555
Left = 30
ScaleHeight = 37
ScaleMode = 3 'Pixel
ScaleWidth = 687
TabIndex = 1
Top = 0
Width = 10305
Begin VB.Image Image1
Height = 480
Left = 30
Picture = "frmReservation.frx":0000
Top = 30
Width = 480
End
Begin VB.Label Label26
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Reservation"
BeginProperty Font
Name = "Tahoma"
Size = 14.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00926747&
Height = 345
Left = 600
TabIndex = 3
Top = 30
Width = 1710
End
Begin VB.Label Label27
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Fill all fields or fields with '*' then click 'Save' button to update."
BeginProperty Font
Name = "Arial"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H00926747&
Height = 180
Left = 600
TabIndex = 2
Top = 360
Width = 3900
End
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 0
Top = 7470
Width = 11265
_ExtentX = 19870
_ExtentY = 661
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 6588
Text = "Reserved By:"
TextSave = "Reserved By:"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 6588
Text = "Cancelled By:"
TextSave = "Cancelled By:"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 6588
Text = "Business Source:"
TextSave = "Business Source:"
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmReservation"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public State As FormState 'Variable used to determine on how the form used
Public PK As String 'Variable used to get what record is going to edit
Public Shortcut As Boolean 'Determine if this form is open from the shortcut link or in the list
Dim HaveAction As Boolean 'Variable used to detect if the user perform some action
Dim RS As New Recordset
Private Sub DisplayForEditing()
On Error GoTo err
With RS
txtReservationNo.Text = .Fields("ReservationNo")
txtLastName.Text = getValueAt("SELECT LastName FROM Customers WHERE CustomerID = " & RS.Fields("CustomerID"), "LastName")
txtFirstName.Text = getValueAt("SELECT FirstName FROM Customers WHERE CustomerID = " & RS.Fields("CustomerID"), "FirstName")
txtAddress.Text = .Fields("Address")
dcCountry.BoundText = .Fields("CountryID")
If RS.Fields("CompanyID") <> "" Then _
txtCompany.Text = getValueAt("SELECT Company FROM Company WHERE CompanyID = " & RS.Fields("CompanyID"), "Company")
dcIDType.BoundText = .Fields("IDTypeID")
txtIDNumber.Text = .Fields("IDNumber")
dcRoomNumber.BoundText = .Fields("RoomNumber")
dtpDateIn.Value = .Fields("DateIn")
If .Fields("DateOut") >= Date Then
dtpDateOut.Value = .Fields("DateOut")
ElseIf .Fields("DateIn") = Date Then
dtpDateOut.Value = dtpDateIn.Value + 1
Else
dtpDateOut.Value = Date
End If
dcRateType.BoundText = .Fields("RateType")
txtRate.Text = toMoney(.Fields("Rate"))
txtOtherCharges.Text = toMoney(.Fields("OtherCharges"))
txtDiscount.Text = .Fields("Discount")
txtAmountPaid.Text = toMoney(.Fields("AmountPaid"))
txtDays.Text = dtpDateOut.Value - dtpDateIn.Value '.Fields("Days")
txtAdults.Text = .Fields("Adults")
txtChildrens.Text = .Fields("Childrens")
dcBusSource.BoundText = .Fields("BusinessSourceID")
dcVehicle.BoundText = .Fields("VehicleID")
txtVehicleModel.Text = .Fields("VehicleModel")
txtPlateNo.Text = .Fields("PlateNo")
txtNotes.Text = .Fields("Notes")
End With
hsDays.Value = txtDays.Text
hsAdults.Value = txtAdults.Text
hsChildrens.Value = txtChildrens.Text
StatusBar1.Panels(1).Text = "Reserved By: " & getValueAt("SELECT UserID FROM Users WHERE PK = " & RS.Fields("ReservedBy"), "UserID")
StatusBar1.Panels(2).Text = "Cancelled By: " & getValueAt("SELECT UserID FROM Users WHERE PK = " & RS.Fields("CancelledBy"), "UserID")
StatusBar1.Panels(3).Text = "Business Source: " & dcBusSource.Text
Exit Sub
err:
If err.Number = 94 Then Resume Next
prompt_err err, Name, "DisplayForEditing"
Screen.MousePointer = vbDefault
End Sub
Private Sub cmdCancel_Click()
If MsgBox("Are you sure you want to cancel this reservation?", vbYesNo + vbExclamation) = vbYes Then
ChangeValue CN, "Reservation", "CancelledBy", CurrUser.USER_PK, True, "WHERE ReservationNo = '" & txtReservationNo.Text & "'"
Unload Me
End If
End Sub
Private Sub CmdCheckIn_Click()
On Error GoTo err
Dim intCount As Integer
If dcRoomNumber.BoundText = "" Then
MsgBox "Please select Room number.", vbCritical
Exit Sub
End If
Call Save_Record
If HaveAction = False Then Exit Sub
If MsgBox("Are you sure?", vbYesNo + vbInformation) = vbYes Then
Dim FolioNumber As String
FolioNumber = getIndex("Transactions")
FolioNumber = GenerateID(FolioNumber, Format$(Date, "yy") & "-", "00000")
CN.BeginTrans
CN.Execute "INSERT INTO Transactions ( FolioNumber, CustomerID, Address, CountryID, CompanyID, IDTypeID, IDNumber, RoomNumber, DateIn, DateOut, RateType, Rate, Days, Adults, Childrens, BusinessSourceID, VehicleID, VehicleModel, PlateNo, Status, Notes, ReservedBy, CheckInBy, AddedByFK ) " & _
"SELECT '" & FolioNumber & "' AS Folio, CustomerID, Address, CountryID, CompanyID, IDTypeID, IDNumber, " & dcRoomNumber.BoundText & ", DateIn, DateOut, RateType, Rate, Days, Adults, Childrens, BusinessSourceID, VehicleID, VehicleModel, PlateNo, 'Check In' AS CheckIn, Notes, ReservedBy, " & CurrUser.USER_PK & ", " & CurrUser.USER_PK & " " & _
"FROM Reservation " & _
"WHERE ReservationNo='" & txtReservationNo.Text & "'"
Call AddRatePerPeriod(FolioNumber)
ChangeValue CN, "Rooms", "RoomStatusID", 2, True, "WHERE RoomNumber = " & dcRoomNumber.BoundText
ChangeValue CN, "Reservation", "Status", "Check In", False, "WHERE ReservationNo = '" & txtReservationNo.Text & "'"
CN.Execute "UPDATE [Inventory] SET Status = 'Check In', ID = '" & FolioNumber & "' " & _
"WHERE ID= '" & txtReservationNo.Text & "' AND RoomNumber= " & dcRoomNumber.BoundText & " AND Status='Reservation'"
CN.CommitTrans
Unload Me
End If
Exit Sub
err:
CN.RollbackTrans
prompt_err err, Name, "CmdCheckIn_Click"
Screen.MousePointer = vbDefault
End Sub
Private Sub AddRatePerPeriod(FolioNumber As String)
On Error GoTo err
Dim rsRatePerPeriod As New ADODB.Recordset
Dim tmpDate As Date
tmpDate = dtpDateIn.Value
If txtAdults.Tag = "" Then Exit Sub
Dim intAdults As Integer
If txtAdults.Text = hsAdults.Min Then
intAdults = 0
Else
intAdults = CInt(txtAdults.Text) - hsAdults.Min
End If
With rsRatePerPeriod
.Open "SELECT * FROM [Rate Per Period] WHERE FolioNumber = '" & FolioNumber & "' ORDER BY [Date]", CN, adOpenStatic, adLockOptimistic
Do Until tmpDate > dtpDateOut.Value - 1
' .Filter = "[Date] = #" & tmpDate & "#"
' If .RecordCount = 0 Then
.AddNew
.Fields("FolioNumber") = FolioNumber
.Fields("Date") = tmpDate
.Fields("RoomNumber") = dcRoomNumber.BoundText
.Fields("RateTypeID") = dcRateType.BoundText
.Fields("Rate") = txtRate.Text
.Fields("Adults") = txtAdults.Tag * intAdults
.Fields("Childrens") = toMoney(txtChildrens.Tag) * toNumber(txtChildrens.Text)
.Update
' End If
tmpDate = tmpDate + 1
Loop
End With
rsRatePerPeriod.Close
Exit Sub
err:
prompt_err err, Name, "AddRatePerPeriod"
Screen.MousePointer = vbDefault
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub ResetFields()
' clearText Me
'
' txtEntry(15).Text = "0.00"
' txtEntry(1).SetFocus
End Sub
Private Sub cmdLookupComp_Click()
With frmCompanyLookup
Set .RefForm = Me
.Show vbModal
End With
End Sub
Private Sub cmdLookupCust_Click()
With frmCustomerLookup
Set .RefForm = Me
.Show vbModal
End With
End Sub
Private Sub CmdPrint_Click()
With frmReports
.strReport = "Reservation"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -