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

📄 form2.frm

📁 a hotel system in PHP will help a lot
💻 FRM
📖 第 1 页 / 共 4 页
字号:
Text2.Text = rs.Fields(2)
Combo1.Text = rs.Fields(3)
Text3.Text = rs.Fields(4)
Text4.Text = rs.Fields(5)
Text5.Text = rs.Fields(6)
Text6.Text = rs.Fields(7)
Text7.Text = rs.Fields(8)
Combo2.Text = rs.Fields(9)
MsgBox "Match Found.Edit the record", vbInformation, "HMS"
Command1.Enabled = False
Command2.Enabled = False
Command14.Enabled = False
Command22.Enabled = True
Command4.Enabled = True

Exit Sub
Else
rs.MoveNext
End If
Loop
MsgBox ("No matches found.Please try again.."), vbCritical, "HMS"
End Sub

Private Sub Command20_Click()
List4(0).Clear
List4(1).Clear
Call roomstatus
End Sub

Private Sub Command21_Click()
Text16 = ""
Text17 = ""
Text18 = ""
Text19 = ""
Text21 = ""
Text22 = ""
Text23 = ""
Text24 = ""
Text25 = ""
Text28 = ""
Text26 = ""
Text26.SetFocus
End Sub

Private Sub Command22_Click()
Text2.SetFocus
Text2.Text = ""
Combo1.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8 = ""
Combo2.Text = ""
Command1.Enabled = True
Command2.Enabled = True
Command14.Enabled = False

End Sub

Private Sub Command23_Click()
Call expireconfirmation
End Sub

Private Sub Command3_Click()
rs.MoveFirst
Do Until rs.EOF
If rs.Fields("name") = Text8.Text Then
Text1.Text = rs.Fields(0)
Text2.Text = rs.Fields(2)
Combo1.Text = rs.Fields(3)
Text3.Text = rs.Fields(4)
Text4.Text = rs.Fields(5)
Text5.Text = rs.Fields(6)
Text6.Text = rs.Fields(7)
Text7.Text = rs.Fields(8)
Combo2.Text = rs.Fields(9)
Command1.Enabled = False
Exit Sub
Else
rs.MoveNext
End If
Loop
MsgBox "No matches found.Please try again..", vbInformation, "HMS"
Text8.Text = ""

Text8.SetFocus
End Sub

Private Sub Command4_Click()
rs.Edit
rs.Fields(0) = Text1.Text
rs.Fields(1) = Text9.Text
rs.Fields(2) = Text2.Text
rs.Fields(3) = Combo1.Text
rs.Fields(4) = Text3.Text
rs.Fields(5) = Text4.Text
rs.Fields(6) = Text5.Text
rs.Fields(7) = Text6.Text
rs.Fields(8) = Text7.Text
rs.Fields(9) = Combo2.Text
rs.Update
MsgBox "current record is updated", vbInformation, "HMS"
Command1.Enabled = True
Command22.Enabled = True
Command2.Enabled = True
Command4.Enabled = False
Command22.SetFocus
End Sub

Private Sub Command5_Click()
If Text11 = "" Then
MsgBox "Please enter name", vbInformation, "HMS"
Text11.SetFocus
Else
If Text12 = "" Then
MsgBox "Please enter address", vbInformation, "HMS"
Text12.SetFocus
Else
If Text13 = "" Then
MsgBox "Please enter phone", vbInformation, "HMS"
Text13.SetFocus
Else
If Text14 = "" Then
MsgBox "Please enter estimated arrival", vbInformation, "HMS"
Text14.SetFocus
Else
rs1.AddNew
rs1.Fields(0) = Text10.Text
rs1.Fields(1) = Text11.Text
rs1.Fields(2) = Text12.Text
rs1.Fields(3) = Text13.Text
rs1.Fields(4) = Text14.Text
rs1.Fields(5) = Check1.Value
rs1.Update
MsgBox "Reservation for new visitor added", vbOKOnly, "HMS"
End If
End If
End If
End If

End Sub

Private Sub Command6_Click()
resinput = InputBox("Enter the name to be edited", "resinput")
rs1.MoveFirst
Do Until rs1.EOF
If rs1.Fields(1) = resinput And rs1.Fields(5) = True Then
Call rescheck1
Exit Sub
Else
If (rs1.Fields(1) = resinput) And rs1.Fields(5) = False Then
Text11.Text = rs1.Fields(1)
Text12.Text = rs1.Fields(2)
Text13.Text = rs1.Fields(3)
Text14.Text = rs1.Fields(4)
Check1.Value = 0
Command5.Enabled = False
Command7.Enabled = True
Command19.Enabled = True
Command6.Enabled = False
Exit Sub
Else
rs1.MoveNext
End If
End If
Loop
MsgBox "No data found.Try again..", vbOKOnly, "HMS"
End Sub

Private Sub Command7_Click()
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
Text14.Text = ""
Text15 = ""
Command5.Enabled = True
Command6.Enabled = True
Command19.Enabled = False
Check1.Value = 0
End Sub

Private Sub Command8_Click()
List1.Clear
List2.Clear
Call ResList
End Sub

Private Sub Command9_Click()
List1.Clear
List2.Clear
Call Resconfirmed
End Sub

Private Sub exit_Click()
Close Databases
End
End Sub

Private Sub Form_Load()

Set db = OpenDatabase(App.Path + "/hotel2.mdb")
Set rs = db.OpenRecordset("checkin")

Set db1 = OpenDatabase(App.Path + "/hotel2.mdb")
Set rs1 = db1.OpenRecordset("reservation")

Set db2 = OpenDatabase(App.Path + "/hotel2.mdb")
Set rs2 = db2.OpenRecordset("checkout")

Text10.Text = Date
Text20.Text = Date
Text1.Text = Date
Command4.Enabled = False
Command14.Enabled = False
Command19.Enabled = False

Text16.Enabled = False
Text17.Enabled = False
Text18.Enabled = False
Text19.Enabled = False
Text21.Enabled = False
Text22.Enabled = False
Text23.Enabled = False
Text24.Enabled = False
Text25.Enabled = False
Command11.Enabled = False
Command12.Enabled = False
Command21.Enabled = False
Text28.Enabled = False
Label45.Caption = Format(Date, "Long Date")
Label46.Caption = Time
End Sub


Private Sub logoff_Click()
Close Databases
Form2.Hide
Form3.Hide
Form4.Hide
Form4.Hide
Form5.Hide
Form1.Show
End Sub

Private Sub rep_Click()
Form4.Show 1
End Sub

Private Sub rmst_Click()
Form5.Show
End Sub

Private Sub stat_Click()
Form3.Show
End Sub

Private Sub Timer1_Timer()
Text9.Text = Time()
Text27.Text = Time()
Label46.Caption = Time()
End Sub

Private Sub ResList()
Dim strSQL As String

On Error Resume Next
strSQL = "Select * from Reservation"
List1.Clear
List2.Clear

        
With Data2
   .RecordSource = strSQL
   .Refresh
   .Recordset.MoveFirst

    Do Until .Recordset.EOF
    If .Recordset.Fields("confirmed") = 0 Then
        List1.AddItem .Recordset("name")
        List2.AddItem .Recordset("arrivaldate")
        End If
        .Recordset.MoveNext
    Loop
    
End With
End Sub


Private Sub Resconfirmed()
Dim sql As String

On Error Resume Next
sql = "Select * from Reservation"
List1.Clear
List2.Clear
   
With Data2
   .RecordSource = sql
   .Refresh
   .Recordset.MoveFirst

    Do Until .Recordset.EOF
    If .Recordset.Fields(5) = True Then
        List1.AddItem .Recordset("name")
        List2.AddItem .Recordset("arrivaldate")
        End If
        .Recordset.MoveNext
    Loop
    
End With
End Sub

Private Sub roomstatus()
Dim sql As String

sql = "Select * from room"

With Data1
   .RecordSource = sql
   .Refresh
   .Recordset.MoveFirst
    Do Until .Recordset.EOF
    On Error Resume Next
    If .Recordset.Fields(1) = True Then
        List4(1).AddItem .Recordset("roomno")
        'List3.AddItem.Index (1)
        Else: List4(0).AddItem .Recordset("roomno") 'Fill listbox for Rooms Tab
        End If
        
        .Recordset.MoveNext
        Loop
        End With
End Sub
Private Sub chkoutroom()


Data1.Recordset.MoveFirst
Do Until Data1.Recordset.EOF
If Data1.Recordset.Fields(0) = Text21.Text Then
Data1.Recordset.Edit
Data1.Recordset.Fields(1) = False
Data1.Recordset.Update
MsgBox ("Visitor sucessfully checked out..") + Combo2.Text, vbOKOnly, "HMS"
Exit Sub
Else
Data1.Recordset.MoveNext
End If
Loop
End Sub


Private Sub checkinvalidate(checkin_form_error)
Let checkin_form_error = False

If Text2 = "" Then
Text2.SetFocus
MsgBox "Please enter the name", vbExclamation, Error
Let checkin_form_error = True
Exit Sub
ElseIf Text3.Text = "" Then
Text3.SetFocus
MsgBox "Please enter the age", vbExclamation, Error
Let checkin_form_error = True
ElseIf Text4.Text = "" Then
Text4.SetFocus
MsgBox "Please enter the address", vbExclamation, Error
Let checkin_form_error = True
ElseIf Text5.Text = "" Then
Text5.SetFocus
MsgBox "Please enter the city", vbExclamation, Error
Let checkin_form_error = True
ElseIf Text6.Text = "" Then
Text6.SetFocus
MsgBox "Please enter the pincode", vbExclamation, Error
Let checkin_form_error = True
ElseIf Text7.Text = "" Then
Text7.SetFocus
MsgBox "Please enter the phone", vbExclamation, Error
Let checkin_form_error = True
ElseIf Combo1.Text = "" Then
Combo1.SetFocus
MsgBox "Please enter the Sex", vbExclamation, Error
Let checkin_form_error = True
ElseIf Combo2.Text = "" Then
Combo2.SetFocus
MsgBox "Please enter the Room Number", vbExclamation, Error
Let checkin_form_error = True
End If
End Sub
Private Sub expireconfirmation()
With Data2
   .RecordSource = "select * from reservation"
   .Refresh
   .Recordset.MoveFirst
    Do Until .Recordset.EOF
    On Error Resume Next
    If .Recordset.Fields(4) < Date Then
        .Recordset.Delete
        End If
        .Recordset.MoveNext
        Loop
        End With
        MsgBox "Expired reservation deleted sucessfuly...", vbInformation, "HMS"
        List1.Text = ""
        List2.Text = ""
        Call ResList
       End Sub
Private Sub optionsearch()
Do Until rs.EOF
If rs.Fields(9) = Text26.Text Then
Text16.Text = rs.Fields(2)
Text17.Text = rs.Fields(5)
Text18.Text = rs.Fields(8)
Text21.Text = rs.Fields(9)
Text19.Text = rs.Fields(0)
val = DateValue(Format(Now, "Short Date")) - rs.Fields(0)
Text28.Text = DateValue(Format(Now, "Short Date")) - rs.Fields(0)
Text22.Text = val * 300
Text23.Text = (10 / 100) * Text22.Text
Text24.Text = (20 / 100) * Text23.Text
val1 = Int(Text22.Text)
val2 = Int(Text23.Text)
val3 = Int(Text24.Text)

Text25.Text = val1 + val2 + val3
Text16.Enabled = True
Text17.Enabled = True
Text18.Enabled = True
Text19.Enabled = True
Text21.Enabled = True
Text22.Enabled = True
Text23.Enabled = True
Text24.Enabled = True
Text25.Enabled = True
Command11.Enabled = True
Command12.Enabled = True
Command21.Enabled = True
Exit Sub
Else
rs.MoveNext
End If
Loop
MsgBox "no datas found.", vbInformation, "HMS"
Text26.Text = ""
Text26.SetFocus
End Sub
Private Sub rescheck()
Text11 = ""
Text12 = ""
Text13 = ""
Text14 = ""
Check1.Value = 0
rs1.MoveFirst
Do Until rs1.EOF
If rs1.Fields(1) = Text15.Text And rs1.Fields(5) = True Then
Text11.Text = rs1.Fields(1)
Text12.Text = rs1.Fields(2)
Text13.Text = rs1.Fields(3)
Text14.Text = rs1.Fields(4)
Check1.Value = 1
Exit Sub
Else
rs1.MoveNext
End If
Loop
MsgBox "No data found.Try again..", vbInformation, "HMS"
End Sub
Private Sub rescheck1()
rs1.MoveFirst
Do Until rs1.EOF
'If (rs1.Fields(1) = resinput) And rs1.Fields(5) = True Then
If rs1.Fields(5) = True Then
Text11.Text = rs1.Fields(1)
Text12.Text = rs1.Fields(2)
Text13.Text = rs1.Fields(3)
Text14.Text = rs1.Fields(4)
Check1.Value = 1
Command5.Enabled = False
Command7.Enabled = True
Command19.Enabled = True
Command6.Enabled = False
Exit Sub
Else
rs1.MoveNext
End If
Loop
MsgBox "No data found.Try again..", vbOKOnly, "HMS"
End Sub

⌨️ 快捷键说明

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