frmempleaveentry.frm

This project is developed for school management system in vb and sql server 2000. All source code in

         End
         Begin VB.Label Label1 
            Alignment       =   1  'Right Justify
            BackStyle       =   0  'Transparent
            Caption         =   "Father's Name:"
            ForeColor       =   &H00000000&
            Height          =   255
            Index           =   7
            Left            =   4920
            TabIndex        =   6
            Top             =   840
            Width           =   1095
         End
         Begin VB.Label Label1 
            Alignment       =   1  'Right Justify
            BackStyle       =   0  'Transparent
            Caption         =   "Employee  Name:"
            ForeColor       =   &H00000000&
            Height          =   255
            Index           =   8
            Left            =   240
            TabIndex        =   5
            Top             =   840
            Width           =   1335
         End
         Begin VB.Image Image1 
            Height          =   840
            Left            =   3720
            Picture         =   "frmempLeaveEntry.frx":44963
            Stretch         =   -1  'True
            Top             =   3000
            Width           =   795
         End
      End
      Begin MSHierarchicalFlexGridLib.MSHFlexGrid Grid 
         Height          =   4845
         Left            =   -74880
         TabIndex        =   21
         Top             =   450
         Width           =   8235
         _ExtentX        =   14526
         _ExtentY        =   8546
         _Version        =   393216
         Rows            =   3
         Cols            =   6
         FixedCols       =   0
         WordWrap        =   -1  'True
         FocusRect       =   2
         SelectionMode   =   1
         AllowUserResizing=   3
         BeginProperty FontFixed {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         _NumberOfBands  =   1
         _Band(0).Cols   =   6
         _Band(0).GridLinesBand=   2
         _Band(0).TextStyleBand=   0
         _Band(0).TextStyleHeader=   0
      End
   End
End
Attribute VB_Name = "frmEmpLeaveEntry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim a As String
Dim rs As ADODB.Recordset
Dim rsgrid As New ADODB.Recordset
Dim RsCombo As New ADODB.Recordset
Dim found As Boolean
Private Sub cmd_Go_Click()
Dim myrs As New ADODB.Recordset
 lblVisit(1).Caption = ""
T(0).Text = ""
T(1).Text = ""
T(3).Text = ""
T(2).Text = ""
txt_nDays.Text = ""
txt_reason.Text = ""
txt_nDays.Text = ""


myrs.Open "select * from qry_onlyEmployees where Employeeid=" & Val(txt_employeecode.Text), frmMain.Cn, 2, 3

If Not (myrs.EOF And myrs.BOF) Then

 lblVisit(1).Caption = myrs!employeeid
T(0).Text = myrs!Firstname
T(1).Text = myrs!lastname
T(3).Text = myrs!BasicSalaryPerMonth
T(2).Text = myrs!TypeName
txt_nDays.Text = ""
txt_reason.Text = ""
txt_nDays.Text = ""
cmdSave.Enabled = True
Else

MsgBox "Please Enter Correct EMployee id "
End If


End Sub

Private Sub cmdDelete_Click()
Dim myrs As New ADODB.Recordset

myrs.Open "Select * from LeavesEntry Where id=" & Val(lblVisit(0).Caption), frmMain.Cn, 2, 3

If myrs.EOF = True Then MsgBox "CAN'T BE DELETED,BECAUSE IT IS ONLY RECORD IN DATABASE", vbInformation, App.Comments: Exit Sub


N = MsgBox("Are You sure you want to delete the record", vbYesNo + vbInformation, App.Comments)

If N = vbYes Then

  myrs.Delete
  rs.Requery
 
 
End If
 SetGridData

End Sub

Private Sub cmdEdit_Click()
 EnableButtons
 found = True
T(0).SetFocus
End Sub


Private Sub cmdPrint_Click()
 With DE.rsrptVisitors
 If .State = 1 Then .Close
  DE.rptemployee (Val(lblVisit(0).Caption))
  
  If .RecordCount = 0 Then MsgBox "No record found"
  rptemployees.Show
 End With
End Sub

Private Sub cmdSave_Click()
On Error GoTo 1
Dim T As Boolean
T = CheckField
  If T = False Then Exit Sub

Dim myrs As New ADODB.Recordset

If (found = False) Then
myrs.Open "LeavesEntry", frmMain.Cn, 2, 3
myrs.AddNew
Else
found = False
myrs.Open "Select * from LeavesEntry Where id=" & Val(lblVisit(0).Caption), frmMain.Cn, 2, 3
End If

myrs!employeeid = rs!employeeid
myrs!Fromdate = dt_fromDate.Value
myrs!toDate = dt_toDate.Value
myrs!Reason = Trim(txt_reason.Text)
myrs!LeaveNoDAys = Val(txt_nDays.Text)
myrs.Update
txt_employeecode.Text = ""

   DisableButtons
   SetGridData
   rs.Requery
  SetDataSources
  rs.MoveLast
  Exit Sub
1:
MsgBox Err.Description, vbInformation, App.Comments
End Sub

Private Sub Command1_Click()
rs.MovePrevious
If rs.BOF Then
MsgBox ("First Record"), vbInformation
rs.MoveLast
End If
SetDataSources
End Sub

Private Sub Command2_Click()
rs.MoveNext
If rs.EOF Then
MsgBox ("Last Record"), vbInformation
rs.MoveFirst
End If
SetDataSources

End Sub
Private Sub Form_Unload(Cancel As Integer)
For i = 0 To 3
SaveSetting App.EXEName, "Grid21", "grid21" & i, Grid.ColWidth(i)
 Next
End Sub

Private Sub Grid_DblClick()
cmdCancel_Click
rs.Requery
ST.Tab = 0
 H = Grid.TextMatrix(Grid.Row, 0)
  rs.Find "employeeid= " & H, 1, adSearchForward, 1
 If rs.EOF Then
  rs.Requery
 End If


End Sub

Private Sub C_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If (KeyCode = vbKeyDown And Shift = vbAltMask) Or KeyCode = 13 Then
 
   SendKeys "{tab}"

 End If
 If (KeyCode = vbKeyUp And Shift = vbAltMask) Or (KeyCode = 13 And Shift = vbCtrlMask) Then
  If Index = 0 Then
   T(1).SetFocus
  Else
'   C(Index - 1).SetFocus
  End If
End If
End Sub

Private Sub cmbCourse_KeyDown(KeyCode As Integer, Shift As Integer)
If (KeyCode = vbKeyDown) Or KeyCode = 13 Then
 
   SendKeys "{tab}"

 End If
 If (KeyCode = vbKeyUp And Shift = vbCtrlMask) Or (KeyCode = 13 And Shift = vbCtrlMask) Then
   ' C(1).SetFocus
    
 End If

End Sub


Private Sub Form_Load()
found = False
Dither Me
 Me.Left = 1500
  Set rs = New ADODB.Recordset
  If rs.State = 1 Then rs.Close
  rs.CursorLocation = adUseClient
  rs.Open "Select * from qry_Employees", frmMain.Cn, adOpenKeyset, adLockOptimistic
  
 SetDataSources

 SetGridData

 For i = 0 To 4
   Grid.ColWidth(i) = GetSetting(App.EXEName, "Grid21", "grid21" & i, 1200)
 Next
End Sub




Private Sub Label2_Click()
Unload frmEmployees
End Sub

Private Sub Picture1_Click()
'lblVisit(0).Caption = AutoNumber
End Sub

Private Sub cmdAddNew_Click()
 If Not rs.EOF Or Not rs.BOF Then
 Mv = rs.Bookmark
 End If
 EnableButtons
 
 Dim ct As Control
 
 For Each ct In Me.Controls
 If TypeOf ct Is TextBox Then ct.Text = ""
  Next
 
 cmdSave.Enabled = False
 'rs.AddNew
found = False


End Sub


Private Sub cmdCancel_Click()
'On Error Resume Next
 rs.CancelUpdate

 If Mv > 0 Then
   rs.Bookmark = Mv
' Else
'   Rs.Requery
 End If
 DisableButtons
  
  
End Sub


Public Sub SetGridData()
If rsgrid.State = 1 Then rsgrid.Close
  rsgrid.CursorLocation = adUseClient
  rsgrid.Open "select * from qry_employees", frmMain.Cn, adOpenDynamic, adLockOptimistic

  Set Grid.DataSource = rsgrid
  Grid.Refresh
  
End Sub
Public Sub SetDataSources()
 lblVisit(0).Caption = rs!ID
 lblVisit(1).Caption = rs!employeeid
T(0).Text = rs!Firstname
T(1).Text = rs!lastname
T(3).Text = rs!BasicSalaryPerMonth
T(2).Text = rs!TypeName
txt_nDays.Text = rs!LeaveNoDAys
txt_reason.Text = rs!Reason
dt_fromDate.Value = rs!Fromdate
dt_toDate.Value = rs!toDate
LoadInCombo
End Sub

Private Sub T_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If (KeyCode = vbKeyDown) Or KeyCode = 13 Then
 
   SendKeys "{tab}"

 End If
 If (KeyCode = vbKeyUp) Or (KeyCode = 13 And Shift = vbCtrlMask) Then
  If Index = 2 Then
   DataCombo.SetFocus
  Else
  If Index = 0 Then Exit Sub
   T(Index - 1).SetFocus
  End If
End If

If KeyCode = 32 And T(Index).Text = "" Then
MsgBox "Starting Space Are Not Allow Please Enter Correct Data "
T(Index).SelStart = 0
T(Index).Text = Trim(T(Index).Text)

End If

End Sub

Private Sub T_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 4 And KeyAscii <> 13 Then
    ChkNumericDigit KeyAscii
  End If
  If Index = 0 Or Index = 1 Or Index = 3 Then
If KeyAscii <> 8 And KeyAscii <> 32 And KeyAscii <> 46 And KeyAscii <> 45 Then
  If KeyAscii < 65 Or (KeyAscii > 90 And KeyAscii < 97) Then KeyAscii = 0
  If KeyAscii > 122 Then KeyAscii = 0
 End If
 End If
 End Sub

Private Sub T_LostFocus(Index As Integer)
' T(Index).Text = UCase(T(Index).Text)
End Sub

Public Sub ScanValue()
' For i = 1 To C(1).ListIndex - 1
' '  If Left(C(1).Text, Len(A)) Then
'     With C(1)
'       .Text = .ListIndex
'      .SelStart = Len(a)
'      .SelLength = .SelText
'      'Exit For
'     End With
'   ' End If
'Next
End Sub



Public Sub EnableButtons()
 cmdAddNew.Enabled = False
 cmdEdit.Enabled = False
 cmdDelete.Enabled = False
 cmdPrint.Enabled = False
 cmdCancel.Enabled = True
 cmdSave.Enabled = True
txt_employeecode.Enabled = True
cmd_Go.Enabled = True

' this will enable all text boxes
  Dim K As Control
   For Each K In frmEmpLeaveEntry
     If TypeOf K Is TextBox Then
      K.Enabled = True
     ElseIf TypeOf K Is DataCombo Then
       K.Enabled = True
       ElseIf TypeOf K Is DTPicker Then
       K.Enabled = True
       ElseIf TypeOf K Is ComboBox Then
       K.Enabled = True
     End If
     Next
End Sub
Public Sub DisableButtons()
 cmdAddNew.Enabled = True
 cmdEdit.Enabled = True
 cmdDelete.Enabled = True
 cmdPrint.Enabled = True
 cmdCancel.Enabled = False
 cmdSave.Enabled = False
txt_employeecode.Enabled = False
cmd_Go.Enabled = False

  Dim K As Control
   For Each K In frmEmpLeaveEntry
     If TypeOf K Is TextBox Then
      K.Enabled = False
     ElseIf TypeOf K Is DataCombo Then
       K.Enabled = False
     ElseIf TypeOf K Is DTPicker Then
       K.Enabled = False
     ElseIf TypeOf K Is ComboBox Then
      K.Enabled = False
     End If
  Next
End Sub
Public Sub LoadInCombo()
  
End Sub


Public Function CheckField() As Boolean
 If T(0).Text = "" Then
   MsgBox "Name Can't be emptied", vbInformation, App.Comments
   T(0).SetFocus
   CheckField = False
  Exit Function
 End If
 If T(1).Text = "" Then
   MsgBox "Father Name Can't be emptied", vbInformation, App.Comments
   T(1).SetFocus
   CheckField = False
    Exit Function
 End If
 If T(2).Text = "" Then
   MsgBox "Address Can't be emptied", vbInformation, App.Comments
   T(2).SetFocus
   CheckField = False
    Exit Function
 End If
 CheckField = True
End Function