📄 frmcheckoutadd.frm
字号:
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 + -