frmhrdpadd.frm

Complete Hotel Management System BackEnd Oracle

      Height          =   240
      Left            =   7440
      TabIndex        =   24
      Top             =   4680
      Width           =   2895
   End
   Begin VB.Label Label17 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Gross Pay"
      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            =   7440
      TabIndex        =   23
      Top             =   5400
      Width           =   1095
   End
   Begin VB.Label Label18 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Tax"
      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            =   7440
      TabIndex        =   22
      Top             =   6120
      Width           =   405
   End
   Begin VB.Label Label19 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Life Insurance Policy"
      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            =   7440
      TabIndex        =   21
      Top             =   6840
      Width           =   2160
   End
   Begin VB.Label Label20 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Gross Deduction"
      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            =   7440
      TabIndex        =   20
      Top             =   7560
      Width           =   1740
   End
   Begin VB.Label Label21 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Net Pay"
      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            =   7680
      TabIndex        =   19
      Top             =   8520
      Width           =   840
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00FF0000&
      BorderWidth     =   2
      X1              =   0
      X2              =   15480
      Y1              =   9000
      Y2              =   9000
   End
End
Attribute VB_Name = "frmHRDPayAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim adoConn As ADODB.Connection
Dim adoRSPR As ADODB.Recordset
Dim errmsg As String

Public Function Calculate(BP As Single) As Single
Dim HRA!, DA!, CCA!, GP!, Tax!, LIC!, GD!
HRA = BP * 0.25
DA = BP * 0.35
CCA = BP * 0.4
GP = BP + HRA + DA + CCA
Tax = BP * 0.8
LIC = BP * 0.12
GD = Tax + LIC
Calculate = GP - GD
txtHRA.Text = Str$(HRA)
txtDA.Text = Str$(DA)
txtCCA.Text = Str$(CCA)
txtGP.Text = Str$(GP)
txtTAX.Text = Str$(Tax)
txtLIC.Text = Str$(LIC)
txtGD.Text = Str$(GD)
End Function

Private Sub Salary()
Dim s As Single
s = Calculate(Val(txtBSal))
txtNP = Str$(s)
End Sub

Private Sub cmdCompute_Click()
Dim i%
Call Salary
End Sub
Private Sub cmdSave_Click()
If ValidatePayAdd() = True Then
   adoRSPR.Update
   adoRSPR.MoveLast
   adoRSPR.AddNew
   ClearcontrolsPayAdd
Else
  MsgBox errmsg, vbCritical, "Data entry Errors!!!"
End If
End Sub

Private Sub cmdClose_Click()
If adoRSPR.EditMode = adEditInProgress Then
  If MsgBox("All unsaved changes would be lost.Proceed anyway?") = vbYes Then
    adoRSPR.CancelUpdate
  Else
    adoRSPR.Update
 End If
End If
MsgBox "Now exiting from application", vbInformation
Set adoRSPR = Nothing
Set adoConn = Nothing
frmHRDPayAdd.Visible = False
frmMain.Visible = True
End Sub
Public Function ValidatePayAdd() As Boolean
Dim ret As Boolean
ret = True
errmsg = "Following errors are encountered in your data" + Chr(13) + Chr(13)
If Len(Trim(txtEno.Text)) = 0 Then
    errmsg = errmsg + "* Employee number must be 3 digits long" + Chr(13)
    ret = False
End If
If Len(Trim(txtName.Text)) = 0 Then
    errmsg = errmsg + "* Name cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(comSex.Text)) = 0 Then
    errmsg = errmsg + "* Sex cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtAddress.Text)) = 0 Then
    errmsg = errmsg + "* Address cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtCity.Text)) = 0 Then
    errmsg = errmsg + "* City cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtDob.Text)) = 0 Then
    errmsg = errmsg + "* Date of birth cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtHiredate.Text)) = 0 Then
    errmsg = errmsg + "* Hiredate cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtPhone.Text)) = 0 Then
    errmsg = errmsg + "* Phone cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtQualifications.Text)) = 0 Then
    errmsg = errmsg + "* Qualifications cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(comDeptNumber.Text)) = 0 Then
    errmsg = errmsg + "* Department cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtDesignation.Text)) = 0 Then
    errmsg = errmsg + "* Designation cannot be left blank " + Chr(13)
    ret = False
End If
If Len(Trim(txtBSal.Text)) = 0 Then
    errmsg = errmsg + "* Basic Salary cannot be left blank " + Chr(13)
    ret = False
End If
ValidatePayAdd = ret
End Function

Public Sub ClearcontrolsPayAdd()
txtEno.Text = ""
txtName.Text = ""
comSex.Text = ""
txtAddress.Text = ""
txtCity.Text = ""
txtDob.Text = ""
txtHiredate.Text = ""
txtPhone.Text = ""
txtDesignation.Text = ""
comDeptNumber.Text = ""
txtBSal.Text = ""
txtQualifications.Text = ""
txtHRA.Text = ""
txtDA.Text = ""
txtCCA.Text = ""
txtGP.Text = ""
txtTAX.Text = ""
txtLIC.Text = ""
txtGD.Text = ""
txtNP.Text = ""
End Sub
Private Sub comDeptNumber_Click()
If comDeptNumber = "10" Then
   txtDeptName.Text = "General Department"
ElseIf comDeptNumber = "20" Then
   txtDeptName.Text = "Front Office Department"
ElseIf comDeptNumber = "30" Then
   txtDeptName.Text = "House keeping Department"
ElseIf comDeptNumber = "40" Then
   txtDeptName.Text = "Food & Beverage Department"
Else
     MsgBox " You have entered a wrong department number", vbInformation, "Wrong Entry"
     comDeptNumber = ""
     txtDeptName.Text = ""
End If
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 adoRSPR = New ADODB.Recordset
adoRSPR.CursorType = adOpenDynamic
adoRSPR.LockType = adLockOptimistic
adoRSPR.Open "EMPLOYEE", adoConn, , , adCmdTable
Set txtEno.DataSource = adoRSPR
txtEno.DataField = "empno"
Set txtName.DataSource = adoRSPR
txtName.DataField = "name"
Set comSex.DataSource = adoRSPR
comSex.DataField = "sex"
Set txtAddress.DataSource = adoRSPR
txtAddress.DataField = "address"
Set txtPhone.DataSource = adoRSPR
txtPhone.DataField = "phone"
Set txtCity.DataSource = adoRSPR
txtCity.DataField = "city"
Set txtDob.DataSource = adoRSPR
txtDob.DataField = "Date_of_birth"
Set txtHiredate.DataSource = adoRSPR
txtHiredate.DataField = "hiredate"
Set txtQualifications.DataSource = adoRSPR
txtQualifications.DataField = "qualifications"
Set txtDesignation.DataSource = adoRSPR
txtDesignation.DataField = "designation"
Set comDeptNumber.DataSource = adoRSPR
comDeptNumber.DataField = "dept_number"
Set txtDeptName.DataSource = adoRSPR
txtDeptName.DataField = "Department"
Set txtBSal.DataSource = adoRSPR
txtBSal.DataField = "basic_salary"
Set txtHRA.DataSource = adoRSPR
txtHRA.DataField = "HRA"
Set txtDA.DataSource = adoRSPR
txtDA.DataField = "DA"
Set txtCCA.DataSource = adoRSPR
txtCCA.DataField = "CCA"
Set txtGP.DataSource = adoRSPR
txtGP.DataField = "GROSS_PAY"
Set txtTAX.DataSource = adoRSPR
txtTAX.DataField = "TAX"
Set txtLIC.DataSource = adoRSPR
txtLIC.DataField = "LIC"
Set txtGD.DataSource = adoRSPR
txtGD.DataField = "GROSS_DED"
Set txtNP.DataSource = adoRSPR
txtNP.DataField = "NET_PAY"
adoRSPR.AddNew
txtHiredate.Text = sysdate
End Sub

Private Sub txtName_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtAddress_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtCity_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtDob_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtHiredate_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtQualifications_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtDesignation_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub
Private Sub txtDeptName_KeyPress(KeyAscii As Integer)
Call ConvUpcase(KeyAscii)
End Sub

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