frmemployees.frm

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

            Top             =   1920
            Width           =   1095
         End
         Begin VB.Label Label1 
            Alignment       =   1  'Right Justify
            BackStyle       =   0  'Transparent
            Caption         =   "Father's Name:"
            ForeColor       =   &H00000000&
            Height          =   255
            Index           =   7
            Left            =   1470
            TabIndex        =   9
            Top             =   1410
            Width           =   1095
         End
         Begin VB.Label Label1 
            Alignment       =   1  'Right Justify
            BackStyle       =   0  'Transparent
            Caption         =   "Employee  Name:"
            ForeColor       =   &H00000000&
            Height          =   255
            Index           =   8
            Left            =   1230
            TabIndex        =   8
            Top             =   900
            Width           =   1335
         End
         Begin VB.Image Image1 
            Height          =   840
            Left            =   8640
            Picture         =   "frmEmployees.frx":44963
            Stretch         =   -1  'True
            Top             =   840
            Width           =   795
         End
      End
      Begin MSHierarchicalFlexGridLib.MSHFlexGrid Grid 
         Height          =   4845
         Left            =   -74880
         TabIndex        =   24
         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 = "frmEmployees"
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

Private Sub cmdDelete_Click()
If Rs.RecordCount = 1 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
  Rs.Delete adAffectCurrent
 Rs.Requery
End If
 SetGridData

End Sub

Private Sub cmdEdit_Click()
 EnableButtons
 
T(0).SetFocus
End Sub


Private Sub cmdPrint_Click()
With DE
  If .Con1.State = 1 Then .Con1.Close
   .Con1.Open
   DE.rptemployee (Val(lblVisit(0).Caption))
    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
   Rs.UpdateBatch adAffectCurrent
   DisableButtons
   SetGridData
  Rs.Requery
  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
End Sub

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

Private Sub DataCombo1_Click(Area As Integer)

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()
Dither Me
 Me.Left = 1500
  Set Rs = New ADODB.Recordset
  If Rs.State = 1 Then Rs.Close
  Rs.CursorLocation = adUseClient
  Rs.Open "Employee", 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
 
 Rs.AddNew
 lblVisit(1).Caption = Date
 '  DataCombo.ListIndex = 0

'   C(1).ListIndex = 0
'T(0).SetFocus

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 employeeid,firstname,lastname,hiredate,address,Qualification,phone,city,BasicSalaryPerMonth from employee", frmMain.Cn, adOpenDynamic, adLockOptimistic

  Set Grid.DataSource = rsgrid
  Grid.Refresh
  
End Sub
Public Sub SetDataSources()
  Dim j As Control
For Each j In frmEmployees
  If TypeOf j Is TextBox Then
    Set j.DataSource = Rs
  ElseIf TypeOf j Is ComboBox Then
   Set j.DataSource = Rs
   ElseIf TypeOf j Is DTPicker Then
   Set j.DataSource = Rs
  End If
Next
 

 Set lblVisit(0).DataSource = Rs
 Set lblVisit(1).DataSource = Rs
 lblVisit(0).DataField = "Employeeid"
 lblVisit(1).DataField = "HireDate"
T(0).DataField = "Firstname"
T(1).DataField = "lastname"
DataCombo.DataField = "Typeid"
T(2).DataField = "Address"
T(3).DataField = "Qualification"
T(4).DataField = "phone"
T(5).DataField = "BasicSalaryPerMonth"
T(6).DataField = "city"
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

' this will enable all text boxes
  Dim K As Control
   For Each K In frmEmployees
     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

  Dim K As Control
   For Each K In frmEmployees
     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()
  With RsCombo
  If .State = 1 Then .Close
     .CursorLocation = adUseClient

  .Open "employeetype", frmMain.Cn, adOpenDynamic, adLockOptimistic
  End With

  With DataCombo
    Set .DataSource = Rs
     Set .RowSource = RsCombo
         .ListField = RsCombo(1).Name
         .BoundColumn = RsCombo(0).Name
         .DataField = Rs("Typeid").Name
End With

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