📄 frmassetsadd.frm
字号:
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
ForeColor = &H00000000&
Height = 240
Left = 720
TabIndex = 20
Top = 6105
Width = 675
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
ForeColor = &H00000000&
Height = 240
Left = 720
TabIndex = 19
Top = 5505
Width = 630
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Descrition :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 240
Left = 720
TabIndex = 18
Top = 3945
Width = 1185
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Object :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 240
Left = 720
TabIndex = 17
Top = 3345
Width = 810
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Quantity :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 240
Left = 720
TabIndex = 16
Top = 2865
Width = 975
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Income Type :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 240
Left = 720
TabIndex = 15
Top = 2265
Width = 1485
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Income Number :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 240
Left = 720
TabIndex = 14
Top = 1665
Width = 1755
End
Begin VB.Image Image3
Height = 240
Left = 7440
Picture = "frmAssetsAdd.frx":001E
Top = 120
Width = 270
End
Begin VB.Label Label11
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Adding Record to Income Account"
BeginProperty Font
Name = "Monotype Corsiva"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Left = 1080
TabIndex = 2
Top = 600
Width = 5895
End
Begin VB.Image Image2
Height = 240
Left = 7800
Picture = "frmAssetsAdd.frx":03E0
Top = 120
Width = 270
End
Begin VB.Image Image1
Height = 360
Left = -5040
Picture = "frmAssetsAdd.frx":07A2
Top = 0
Width = 17595
End
End
Attribute VB_Name = "frmIncomeAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim adoConn As ADODB.Connection
Dim adoAsset 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 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
frmIncomeAdd.Visible = False
End Sub
Public Function ValidateIncome() As Boolean
Dim ret As Boolean
ret = True
errmsg = "Following errors are encountered in your data" + Chr(13) + Chr(13)
If Len(Trim(txtAsstNo.Text)) = 0 Then
errmsg = errmsg + "* Asset Number cannot be left Blank" + Chr(13)
ret = False
End If
If Len(Trim(txtAsstType.Text)) = 0 Then
errmsg = errmsg + "* Asset 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(comObject.Text)) = 0 Then
errmsg = errmsg + "* Object 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
ValidateIncome = ret
End Function
Private Sub cmdSave_Click()
If ValidateIncome() = True Then
adoAsset.Update
adoAsset.MoveLast
adoAsset.AddNew
Clearcontrols
Else
MsgBox errmsg, vbCritical, "Data entry Errors!!!"
End If
End Sub
Private Sub Clearcontrols()
txtAsstNo.Text = ""
txtAsstType.Text = ""
txtQty.Text = ""
comObject.Text = ""
txtDesc.Text = ""
txtDate.Text = ""
txtPrice.Text = ""
txtOthCha.Text = ""
txtTotAmt.Text = ""
txtEmpNo.Text = ""
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 adoAsset = New ADODB.Recordset
adoAsset.CursorType = adOpenDynamic
adoAsset.LockType = adLockOptimistic
adoAsset.Open "Assets", adoConn, , , adCmdTable
Set txtAsstNo.DataSource = adoAsset
txtAsstNo.DataField = "Asst_No"
Set txtAsstType.DataSource = adoAsset
txtAsstType.DataField = "Asst_Type"
Set txtQty.DataSource = adoAsset
txtQty.DataField = "Qty"
Set comObject.DataSource = adoAsset
comObject.DataField = "Object"
Set txtDesc.DataSource = adoAsset
txtDesc.DataField = "Description"
Set txtDate.DataSource = adoAsset
txtDate.DataField = "Asst_date"
Set txtPrice.DataSource = adoAsset
txtPrice.DataField = "Price"
Set txtOthCha.DataSource = adoAsset
txtOthCha.DataField = "Other_charges"
Set txtTotAmt.DataSource = adoAsset
txtTotAmt.DataField = "Tot_Amount"
Set txtEmpNo.DataSource = adoAsset
txtEmpNo.DataField = "Emp_no"
adoAsset.AddNew
End Sub
Private Sub Image3_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
frmAssetsAdd.Visible = False
frmAssets.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 txtAsstType_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 + -