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

📄 frmcheckoutadd.frm

📁 Complete Hotel Management System BackEnd Oracle
💻 FRM
📖 第 1 页 / 共 2 页
字号:
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   11040
      TabIndex        =   31
      Top             =   2280
      Width           =   3105
   End
   Begin VB.Label Label44 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Duration"
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1920
      TabIndex        =   21
      Top             =   6360
      Width           =   885
   End
   Begin VB.Label Label38 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Checkout time"
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1920
      TabIndex        =   20
      Top             =   5640
      Width           =   1470
   End
   Begin VB.Label Label35 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Total Amount"
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1920
      TabIndex        =   19
      Top             =   8520
      Width           =   1380
   End
   Begin VB.Label Label34 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Visitor's Number"
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1920
      TabIndex        =   18
      Top             =   9240
      Width           =   1725
   End
   Begin VB.Label Label33 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Taxes"
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1920
      TabIndex        =   17
      Top             =   7800
      Width           =   660
   End
   Begin VB.Label Label32 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Amount"
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1920
      TabIndex        =   16
      Top             =   7080
      Width           =   780
   End
   Begin VB.Label Label31 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Room Number"
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1920
      TabIndex        =   15
      Top             =   1320
      Width           =   1500
   End
   Begin VB.Label Label30 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Checkout date"
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1920
      TabIndex        =   14
      Top             =   4920
      Width           =   1500
   End
   Begin VB.Label Label29 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Checkin Date "
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1920
      TabIndex        =   13
      Top             =   4200
      Width           =   1455
   End
   Begin VB.Label Label28 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Phone"
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1920
      TabIndex        =   12
      Top             =   3480
      Width           =   675
   End
   Begin VB.Label Label27 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Address"
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1920
      TabIndex        =   11
      Top             =   2760
      Width           =   885
   End
   Begin VB.Label Label26 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Name"
      ForeColor       =   &H00000000&
      Height          =   240
      Left            =   1920
      TabIndex        =   10
      Top             =   2040
      Width           =   630
   End
End
Attribute VB_Name = "frmCheckOutAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim adoConn As ADODB.Connection
Dim adoChOut As ADODB.Recordset
Public txt As String
Public txt1 As String
Dim errmsg As String

Private Sub cmdOutClose_Click()
If adoChOut.EditMode = adEditInProgress Then
  If MsgBox("All unsaved changes would be lost.Proceed anyway?") = vbYes Then
    adoChOut.CancelUpdate
  Else
    adoChOut.Update
 End If
End If
MsgBox "Now exiting from application", vbInformation
Set adoChOut = Nothing
Set adoConn = Nothing
frmCheckOutAdd.Visible = False
frmMain.Show
End Sub

Private Sub cmdOutBillAmount_Click()
Dim Dut!, Amt!, Tax!, Sev!, BA!
Dut = Val(txtOutDuration.Text)
Amt = Dut * 2400
Tax = Amt * 0.2
BA = Amt + Tax
txtOutAmount.Text = "QR." & Str$(Amt)
txtOutTaxes.Text = "QR." & Str$(Tax)
txtOutTotAmount.Text = "QR." & Str$(BA)
End Sub

Public Function ValidateChOut() As Boolean
Dim ret As Boolean
ret = True
errmsg = "Following errors are encountered in your data" + Chr(13) + Chr(13)
If Len(Trim(txtOutName.Text)) = 0 Then
    errmsg = errmsg + "* Name cannot be left Blank" + Chr(13)
    ret = False
End If
If Len(Trim(txtOutAddress.Text)) = 0 Then
    errmsg = errmsg + "* Address cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtOutPhone.Text)) = 0 Then
    errmsg = errmsg + "* Phone cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtOutCheckinDate.Text)) = 0 Then
    errmsg = errmsg + "* CheckIn Date cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtOutCheckOutDate.Text)) = 0 Then
    errmsg = errmsg + "* CheckOut Date cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtOutDuration.Text)) = 0 Then
    errmsg = errmsg + "* Duration cannot be left blank " + Chr(13)
    ret = False
End If
ValidateChOut = ret
End Function

Public Sub ClearcontrolsChOut()
txtRoomNumber = ""
txtOutName.Text = ""
txtOutPhone.Text = ""
txtOutAddress.Text = ""
txtOutCheckinDate.Text = ""
txtOutCheckOutDate.Text = ""
txtOutCheckOutTime.Text = ""
txtOutDuration.Text = ""
txtOutAmount.Text = ""
txtOutTaxes.Text = ""
txtOutvstNo.Text = ""
txtOutTotAmount.Text = ""
End Sub

Private Sub cmdOutSave_Click()
If ValidateChOut() = True Then
   adoChOut.Update
   adoChOut.MoveLast
   adoChOut.AddNew
   ClearcontrolsChOut
Else
  MsgBox errmsg, vbCritical, "Data entry Errors!!!"
End If
End Sub

Private Sub Image2_Click()
MsgBox "Now exiting from application", vbInformation
Set adoChOut = Nothing
Set adoConn = Nothing
frmCheckOutAdd.Visible = False
frmMain.Show
End Sub

Private Sub Timer1_Timer()
txtOutCheckOutTime.Text = Time()
txtOutCheckOutDate.Text = Date
End Sub

Private Sub Form_Load()
MsgBox "Connecting Oracle.Please wait...", vbInformation, "Wait"
Set adoConn = New ADODB.Connection
adoConn.ConnectionString = "Provider=MSDAORA;user id=scott;password=tiger;"
adoConn.CursorLocation = adUseClient
adoConn.Open
Set adoChOut = New ADODB.Recordset
adoChOut.CursorType = adOpenDynamic
adoChOut.LockType = adLockOptimistic
adoChOut.Open "Check_out", adoConn, , , adCmdTable
Set txtRoomNumber.DataSource = adoChOut
txtRoomNumber.DataField = "Room_no"
Set txtOutName.DataSource = adoChOut
txtOutName.DataField = "Name"
Set txtOutAddress.DataSource = adoChOut
txtOutAddress.DataField = "Address"
Set txtOutPhone.DataSource = adoChOut
txtOutPhone.DataField = "Phone"
Set txtOutCheckinDate.DataSource = adoChOut
txtOutCheckinDate.DataField = "Check_In_Date"
Set txtOutCheckOutDate.DataSource = adoChOut
txtOutCheckOutDate.DataField = "Check_Out_Date"
Set txtOutCheckOutTime.DataSource = adoChOut
txtOutCheckOutTime.DataField = "Check_out_time"
Set txtOutDuration.DataSource = adoChOut
txtOutDuration.DataField = "Duration"
Set txtOutAmount.DataSource = adoChOut
txtOutAmount.DataField = "Amount"
Set txtOutTaxes.DataSource = adoChOut
txtOutTaxes.DataField = "Taxes"
Set txtOutvstNo.DataSource = adoChOut
txtOutvstNo.DataField = "Visitor_No"
Set txtOutTotAmount.DataSource = adoChOut
txtOutTotAmount.DataField = "Total_Amount"
adoChOut.AddNew
End Sub

Private Sub txtOutCheckInDate_Change()
txt = txtOutCheckinDate.Text
End Sub

Private Sub txtOutCheckOutDate_Change()
txt1 = txtOutCheckOutDate.Text
End Sub

Private Sub cmdOutSearch_Click()
Dim intVstNo As Single
Dim strCriteria As String
Dim varMark As Variant
Dim Found As Boolean
adoCheckOut.Recordset.MoveFirst
Found = False
If txtOutSearch.Text <> adoCheckOut.Recordset.Fields("Visitor_No").Value Then
   intVstNo = Val(txtOutSearch)
   strCriteria = "Visitor_No =" & intVstNo
   adoCheckOut.Recordset.Find strCriteria, 0, adSearchForward, adBookmarkCurrent
   Do While Not adoCheckOut.Recordset.EOF
       txtOutName.Text = adoCheckOut.Recordset.Fields("Name").Value
       txtOutAddress.Text = adoCheckOut.Recordset.Fields("Address").Value
       txtOutPhone.Text = adoCheckOut.Recordset.Fields("Phone").Value
       txtOutCheckinDate.Text = adoCheckOut.Recordset.Fields("DATE_OF_ARRIVAL").Value
       varMark = adoCheckOut.Recordset.Bookmark
       Found = True
       adoCheckOut.Recordset.Find strCriteria, 1, adSearchForward, varMark
   Loop
Else
   MsgBox "This Visitor's ID does not exist", vbCritical, "Wrong Entry"
   txtOutSearch.Text = ""
   txtOutName.Text = ""
   txtOutAddress.Text = ""
   txtOutPhone.Text = ""
   txtOutCheckinDate.Text = ""
End If
End Sub

Private Sub txtOutName_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtOutAddress_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtOutCheckinDate_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtOutCheckOutDate_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtOutCheckOutTime_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub

⌨️ 快捷键说明

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