⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmreservation.frm

📁 hotel mnagement system
💻 FRM
📖 第 1 页 / 共 4 页
字号:
        
        .strWhere = "{qry_rpt_Reservation.ReservationNo} = '" & txtReservationNo.Text & "'"
        
        frmReports.Show vbModal
    End With
End Sub

Private Sub Save_Record()
On Error GoTo err
    
    Dim rsCustomers As New Recordset
    Dim CustomerID As Integer
    Dim CompanyID As Integer

    If Trim(txtLastName.Text) = "" Or Trim(txtFirstName.Text) = "" Then
        MsgBox "Please complete the name of a guest.", vbInformation
        
        Exit Sub
    End If
        
    CN.BeginTrans

    With rsCustomers
        .Open "SELECT * FROM Customers WHERE LastName = '" & txtLastName.Text & "' AND FirstName = '" & txtFirstName.Text & "'", CN, adOpenStatic, adLockOptimistic
    
        If .RecordCount > 0 Then
            txtLastName.Tag = .Fields("CustomerID")
        Else
            .AddNew
            
            CustomerID = getIndex("Customers")
            txtLastName.Tag = CustomerID
            
            .Fields("CustomerID") = CustomerID
            .Fields("LastName") = txtLastName.Text
            .Fields("FirstName") = txtFirstName.Text
            
            .Update
        End If
        
        .Close
        
        If txtCompany.Text = "" Then GoSub ContinueSave
        
        .Open "SELECT * FROM Company WHERE Company = '" & txtCompany.Text & "'", CN, adOpenStatic, adLockOptimistic
        
        If .RecordCount > 0 Then
            txtCompany.Tag = .Fields("CompanyID")
        Else
            .AddNew

            CompanyID = getIndex("Company")
            txtCompany.Tag = CompanyID
            
            .Fields("CompanyID") = CompanyID
            .Fields("Company") = txtCompany.Text
            
            .Update
        End If
        
        .Close
    End With
    
ContinueSave:

    If State = adStateAddMode Then
        RS.AddNew
        
        RS.Fields("ReservationNo") = txtReservationNo.Text
        RS.Fields("ReservedBy") = CurrUser.USER_PK
        RS.Fields("AddedByFK") = CurrUser.USER_PK
    Else
        RS.Fields("DateModified") = Now
        RS.Fields("LastUserFK") = CurrUser.USER_PK
    End If
    
    With RS
        .Fields("CustomerID") = txtLastName.Tag
        .Fields("Address") = txtAddress.Text
        .Fields("CountryID") = dcCountry.BoundText
        .Fields("CompanyID") = IIf(txtCompany.Tag = "", Null, txtCompany.Tag)
        .Fields("IDTypeID") = dcIDType.BoundText
        .Fields("IDNumber") = txtIDNumber.Text
        .Fields("RoomNumber") = dcRoomNumber.BoundText
        .Fields("DateIn") = dtpDateIn.Value
        .Fields("DateOut") = dtpDateOut.Value
        .Fields("RateType") = dcRateType.BoundText
        .Fields("Rate") = txtRate.Text
        .Fields("OtherCharges") = txtOtherCharges.Text
        .Fields("Discount") = txtDiscount.Text
        .Fields("AmountPaid") = txtAmountPaid.Text
        .Fields("Days") = txtDays.Text
        .Fields("Adults") = txtAdults.Text
        .Fields("Childrens") = txtChildrens.Text
        .Fields("Total") = txtTotal.Text
        .Fields("BusinessSourceID") = dcBusSource.BoundText
        .Fields("VehicleID") = IIf(dcVehicle.BoundText = "", Null, dcVehicle.BoundText)
        .Fields("VehicleModel") = txtVehicleModel.Text
        .Fields("PlateNo") = txtPlateNo.Text
        .Fields("Notes") = txtNotes.Text

        .Update
    End With

    '----------------------------
    'Delete record from Inventory and add a new check in/out date
    CN.Execute "DELETE ID, Status " & _
                "From [Inventory] " & _
                "WHERE ID='" & txtReservationNo.Text & "' AND Status='Reservation'"
                
    Dim dtpStartDate As Date
    
    dtpStartDate = dtpDateIn.Value
    
    Do Until dtpStartDate = dtpDateOut.Value
        CN.Execute "INSERT INTO [Inventory] ( ID, RoomNumber, [Date], CustomerID, Status ) " & _
                "VALUES ('" & txtReservationNo.Text & "', " & dcRoomNumber.BoundText & ", #" & dtpStartDate & "#, " & txtLastName.Tag & ", 'Reservation')"

        dtpStartDate = dtpStartDate + 1
    Loop
    '----------------------------

    CN.CommitTrans

    HaveAction = True
    
    Exit Sub

err:
    CN.RollbackTrans
    prompt_err err, Name, "cmdSave_Click"
    Screen.MousePointer = vbDefault
End Sub

Private Sub cmdSave_Click()
    Call Save_Record
    
    If State = adStateAddMode And HaveAction = True Then
        MsgBox "New record has been successfully saved.", vbInformation

'        Unload frmReservation
    ElseIf State = adStateEditMode And HaveAction = True Then
        MsgBox "Changes in  record has been successfully saved.", vbInformation
        
'        Unload frmReservation
    End If
End Sub

Private Sub cmdUsrHistory_Click()
    On Error Resume Next
    Dim tDate1 As String
    Dim tDate2 As String
    Dim tUser1 As String
    Dim tUser2 As String
    
    tDate1 = Format$(RS.Fields("DateAdded"), "MMM-dd-yyyy HH:MM AMPM")
    tDate2 = Format$(RS.Fields("DateModified"), "MMM-dd-yyyy HH:MM AMPM")
    
    tUser1 = getValueAt("SELECT PK,CompleteName FROM Users WHERE PK = " & RS.Fields("AddedByFK"), "CompleteName")
    tUser2 = getValueAt("SELECT PK,CompleteName FROM Users WHERE PK = " & RS.Fields("LastUserFK"), "CompleteName")
    
    MsgBox "Date Added: " & tDate1 & vbCrLf & _
           "Added By: " & tUser1 & vbCrLf & _
           "" & vbCrLf & _
           "Last Modified: " & tDate2 & vbCrLf & _
           "Modified By: " & tUser2, vbInformation, "Modification History"
           
    tDate1 = vbNullString
    tDate2 = vbNullString
    tUser1 = vbNullString
    tUser2 = vbNullString
End Sub

Private Sub dcRateType_Click(Area As Integer)
On Error GoTo err

    Dim rsRoomRates As New ADODB.Recordset
    
    With rsRoomRates
        .Open "SELECT * FROM [Room Rates] WHERE RoomNumber = " & dcRoomNumber.BoundText & " AND RateTypeID = " & dcRateType.BoundText, CN, adOpenStatic, adLockOptimistic
    
        If .RecordCount > 0 Then
            txtRate.Text = toMoney(!RoomRate)
            txtAdults.Text = !NoofPerson
            hsAdults.Min = !NoofPerson
            hsAdults.Value = !NoofPerson
            txtAdults.Tag = !ExtraAdultRate
            txtChildrens.Tag = !ExtraChildRate
        End If
    End With
    
    rsRoomRates.Close
    
    Call ComputeRate
    
    Exit Sub
    
err:
    CN.RollbackTrans
    prompt_err err, Name, "dcRateType_Click"
    Screen.MousePointer = vbDefault
End Sub

Private Sub dcRoomNumber_Click(Area As Integer)
    dcRateType_Click 0
End Sub

Public Sub dtpDateOut_Change()
    If dtpDateOut.Value < dtpDateIn.Value Then Exit Sub
    
    txtDays.Text = dtpDateOut.Value - dtpDateIn.Value
    hsDays.Value = txtDays.Text
    
    Call ComputeRate
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub Form_Load()
On Error GoTo err

    RS.CursorLocation = adUseClient

    bind_dc "SELECT * FROM qry_Available_Rooms", "AvailableRoom", dcRoomNumber, "RoomNumber", True
    bind_dc "SELECT * FROM Countries", "Country", dcCountry, "CountryID", True
    bind_dc "SELECT * FROM [ID Type]", "IDType", dcIDType, "IDTypeID", True
    bind_dc "SELECT * FROM [Rate Type]", "RateType", dcRateType, "RateTypeID", True
    bind_dc "SELECT * FROM [Business Source]", "BusinessSource", dcBusSource, "BusinessSourceID", True
    bind_dc "SELECT * FROM [Vehicles]", "Vehicle", dcVehicle, "VehicleID", False
    
    dcCountry.Text = "Philippines"

    Dim rsRoomRates As New ADODB.Recordset

    'Check the form state
    If State = adStateAddMode Then
        RS.Open "SELECT * FROM Reservation WHERE ReservationNo = '" & PK & "'", CN, adOpenStatic, adLockOptimistic

        cmdUsrHistory.Enabled = False

        dtpDateIn.Value = Date
        dtpDateOut.Value = dtpDateIn.Value + 1

        GeneratePK

        rsRoomRates.Open "SELECT * FROM [Room Rates] WHERE RoomNumber = " & dcRoomNumber.BoundText & " AND RateTypeID = " & dcRateType.BoundText, CN, adOpenStatic, adLockOptimistic

        With rsRoomRates
            If .RecordCount > 0 Then
                txtRate.Text = toMoney(!RoomRate)
                txtAdults.Text = !NoofPerson
                hsAdults.Min = !NoofPerson
                hsAdults.Value = !NoofPerson
                txtAdults.Tag = !ExtraAdultRate
                txtChildrens.Tag = !ExtraChildRate
            End If
        End With

        dcBusSource.BoundText = 2

'        Call txtDays_Change

        Call ComputeRate
    Else
        RS.Open "SELECT * FROM Reservation WHERE ReservationNo = '" & PK & "'", CN, adOpenStatic, adLockOptimistic

        rsRoomRates.Open "SELECT * FROM [Room Rates] WHERE RoomNumber = " & RightSplitUF(dcRoomNumber.Tag) & " AND RateTypeID = " & dcRateType.BoundText, CN, adOpenStatic, adLockOptimistic

        With rsRoomRates
            If .RecordCount > 0 Then
                txtRate.Text = toMoney(!RoomRate)
                hsAdults.Min = !NoofPerson
                txtAdults.Tag = !ExtraAdultRate
                txtChildrens.Tag = !ExtraChildRate
            End If
        End With

        DisplayForEditing
        
        CmdCheckIn.Visible = True
        CmdPrint.Visible = True
        CmdCancel.Visible = True
        
        Call ComputeRate
    End If

    rsRoomRates.Close

    Exit Sub
                
err:
    prompt_err err, Name, "Form_Load"
    Screen.MousePointer = vbDefault
End Sub

'Procedure used to generate PK
Private Sub GeneratePK()
    PK = getIndex("Reservation")
    txtReservationNo.Text = GenerateID(PK, Format$(Date, "yy") & "-", "00000")
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If HaveAction = True And Shortcut = False Then
        frmReservationList.RefreshRecords
    End If
    
    Set frmReservation = Nothing
End Sub

Private Sub hsAdults_Change()
    txtAdults.Text = hsAdults.Value
    
'    Call ComputeAdultsRate
    Call ComputeRate
End Sub

Private Sub hsChildrens_Change()
    txtChildrens.Text = hsChildrens.Value
    
'    Call ComputeChildrensRate
    Call ComputeRate
End Sub

Private Sub hsDays_Change()
    dtpDateOut.Value = dtpDateIn.Value + hsDays.Value
    
    txtDays.Text = hsDays.Value
    
    Call ComputeRate
End Sub

Private Sub ComputeRate()
    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
    
    txtTotalCharges.Text = (toMoney(txtRate.Text) * toNumber(txtDays.Text)) + (toMoney(txtAdults.Tag) * intAdults) + (toMoney(txtChildrens.Tag) * toNumber(txtChildrens.Text))
    txtTotalCharges.Text = toMoney(txtTotalCharges.Text)
    txtSubTotal.Text = toMoney(toNumber(txtTotalCharges.Text) + toNumber(txtOtherCharges.Text))
    txtTotal.Text = toMoney(toNumber(txtSubTotal.Text) - (toNumber(txtSubTotal.Text) * toNumber(txtDiscount.Text) / 100))
    txtBalance.Text = toMoney(toNumber(txtTotal.Text) - toNumber(txtAmountPaid.Text))
End Sub

Private Sub txtAmountPaid_Change()
    txtBalance.Text = toMoney(toNumber(txtTotal.Text) - toNumber(txtAmountPaid.Text))
End Sub

Private Sub txtDiscount_Change()
    Call ComputeRate
End Sub

Private Sub txtDiscount_GotFocus()
    HLText txtDiscount
End Sub

Private Sub txtDiscount_KeyPress(KeyAscii As Integer)
    KeyAscii = isNumber(KeyAscii)
End Sub

Private Sub txtDiscount_Validate(Cancel As Boolean)
    txtDiscount.Text = toMoney(txtDiscount.Text)
End Sub

Private Sub txtRate_GotFocus()
    HLText txtRate
End Sub

Private Sub txtRate_KeyPress(KeyAscii As Integer)
    KeyAscii = isNumber(KeyAscii)
End Sub

Private Sub txtRate_Validate(Cancel As Boolean)
    txtRate.Text = toMoney(txtRate.Text)
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -