📄 frmexpensesadd.frm
字号:
Top = 3345
Width = 1185
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Date :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 840
TabIndex = 17
Top = 4785
Width = 630
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Price :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 840
TabIndex = 16
Top = 5265
Width = 675
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Other charges :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 840
TabIndex = 15
Top = 5745
Width = 1590
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Total Amount :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 840
TabIndex = 14
Top = 6225
Width = 1500
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Employee Number :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 840
TabIndex = 13
Top = 6705
Width = 2055
End
Begin VB.Label Label4
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Adding Record to Expenses Account"
BeginProperty Font
Name = "Monotype Corsiva"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 420
Left = 1215
TabIndex = 2
Top = 840
Width = 5145
End
Begin VB.Image Image2
Height = 240
Left = 7440
Picture = "frmExpensesAdd.frx":0000
Top = 120
Width = 270
End
Begin VB.Image Image1
Height = 360
Left = -4320
Picture = "frmExpensesAdd.frx":03C2
Top = 0
Width = 17595
End
End
Attribute VB_Name = "frmExpensesAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim adoConn As ADODB.Connection
Dim adoExpense As ADODB.Recordset
Dim errmsg As String
Private Sub cmdExit_Click()
If MsgBox("Are you sure you want to exit Hotel Mangement Sytem ?", vbQuestion + vbYesNo, "Confirm Exit !") = vbYes Then
End
End If
End Sub
Private Sub cmdClose_Click()
If adoExpense.EditMode = adEditInProgress Then
If MsgBox("All unsaved changes would be lost.Proceed anyway?") = vbYes Then
adoExpense.CancelUpdate
Else
adoExpense.Update
End If
End If
MsgBox "Now exiting from application", vbInformation
Set adoExpense = Nothing
Set adoExpense = Nothing
frmExpensesAdd.Visible = False
frmexpenses.Show
End Sub
Public Function ValidateExpenses() As Boolean
Dim ret As Boolean
ret = True
errmsg = "Following errors are encountered in your data" + Chr(13) + Chr(13)
If Len(Trim(txtExpNo.Text)) = 0 Then
errmsg = errmsg + "* Expense Number cannot be left Blank" + Chr(13)
ret = False
End If
If Len(Trim(txtExpType.Text)) = 0 Then
errmsg = errmsg + "* Expense Type cannot be left blank " + Chr(13)
ret = False
End If
If Len(Trim(txtQty.Text)) = 0 Then
errmsg = errmsg + "* Quantity cannot be left blank " + Chr(13)
ret = False
End If
If Len(Trim(txtDesc.Text)) = 0 Then
errmsg = errmsg + "* Description cannot be left blank " + Chr(13)
ret = False
End If
If Len(Trim(txtDate.Text)) = 0 Then
errmsg = errmsg + "* Date cannot be left blank " + Chr(13)
ret = False
End If
If Len(Trim(txtPrice.Text)) = 0 Then
errmsg = errmsg + "* Price cannot be left blank " + Chr(13)
ret = False
End If
If Len(Trim(txtOthCha.Text)) = 0 Then
errmsg = errmsg + "* Other charges cannot be left blank " + Chr(13)
ret = False
End If
If Len(Trim(txtTotAmt.Text)) = 0 Then
errmsg = errmsg + "* Total Amount cannot be left blank " + Chr(13)
ret = False
End If
If Len(Trim(txtEmpNo.Text)) = 0 Then
errmsg = errmsg + "* Employee Number cannot be left blank " + Chr(13)
ret = False
End If
ValidateExpenses = ret
End Function
Public Sub ClearcontrolsExp()
txtExpNo.Text = ""
txtExpType.Text = ""
txtQty.Text = ""
txtDesc.Text = ""
txtDate.Text = ""
txtPrice.Text = ""
txtOthCha.Text = ""
txtTotAmt.Text = ""
txtEmpNo.Text = ""
End Sub
Private Sub cmdSave_Click()
If ValidateExpenses() = True Then
adoExpense.Update
adoExpense.MoveLast
adoExpense.AddNew
ClearcontrolsExp
Else
MsgBox errmsg, vbCritical, "Data entry Errors!!!"
End If
End Sub
Private Sub Timer1_Timer()
txtDate.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 adoExpense = New ADODB.Recordset
adoExpense.CursorType = adOpenDynamic
adoExpense.LockType = adLockOptimistic
adoExpense.Open "Expense", adoConn, , , adCmdTable
Set txtExpNo.DataSource = adoExpense
txtExpNo.DataField = "Exp_No"
Set txtExpType.DataSource = adoExpense
txtExpType.DataField = "Purpose"
Set txtQty.DataSource = adoExpense
txtQty.DataField = "Qty"
Set txtDesc.DataSource = adoExpense
txtDesc.DataField = "Description"
Set txtDate.DataSource = adoExpense
txtDate.DataField = "Exp_date"
Set txtPrice.DataSource = adoExpense
txtPrice.DataField = "Price"
Set txtOthCha.DataSource = adoExpense
txtOthCha.DataField = "Other_charges"
Set txtTotAmt.DataSource = adoExpense
txtTotAmt.DataField = "Tot_Amount"
Set txtEmpNo.DataSource = adoExpense
txtEmpNo.DataField = "Emp_no"
adoExpense.AddNew
End Sub
Private Sub Image2_Click()
If adoAsset.EditMode = adEditInProgress Then
If MsgBox("All unsaved changes would be lost.Proceed anyway?") = vbYes Then
adoAsset.CancelUpdate
Else
adoAsset.Update
End If
End If
MsgBox "Now exiting from application", vbInformation
Set adoAsset = Nothing
Set adoAsset = Nothing
frmExpensesAdd.Visible = False
frmExpense.Show
End Sub
Private Sub txtTotAmt_Click()
Dim Pr As Single, Oc As Single, TA As Single
Dim Qt As Integer
Pr = Val(txtPrice.Text)
Oc = Val(txtOthCha.Text)
Qt = Val(txtQty.Text)
TA = (Pr * Qt) + Oc
txtTotAmt.Text = Str$(TA)
End Sub
Private Sub txtExpType_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtDesc_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtDate_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -