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

📄 frmexpensesadd.frm

📁 Complete Hotel Management System BackEnd Oracle
💻 FRM
📖 第 1 页 / 共 2 页
字号:
      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 + -