frmsubject.frm

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

 SetMainGrid
 Exit Sub
1:
  MsgBox Err.Description, vbInformation, App.Comments
   SetMainGrid
End Sub

Private Sub cmdSave_Click()
Dim v As Integer
    If T(0).Text = "" Then
      MsgBox "Subject Name can't be emptied", vbInformation, App.Comments
      T(0).SetFocus
      Exit Sub
    End If
    If T(1).Text = "" Then
      MsgBox "Author can't be emptied", vbInformation, App.Comments
      T(1).SetFocus
      Exit Sub
    End If
    '======================================
    If rs.EditMode = adEditAdd Then
       v = 1
       If p = 0 Or q = 0 Then
          MsgBox "Course And Semester Can't be Emptied", vbInformation
          Exit Sub
       End If
    End If
    
    
  On Error GoTo 1
  rs.UpdateBatch adAffectCurrent
   If v = 1 Then
     frmMain.Cn.Execute "insert into sub_course values (" & _
               lblSub_ID.Caption & "," & p & "," & q & " )"
   End If
  DisableButtons

  SetGridData
  SetMainGrid
  cmbCourse.ListIndex = -1
  cmbSemester.ListIndex = -1
    cmdCan_Click
  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.MoveFirst
End If
SetGridData
SetMainGrid
End Sub

Private Sub Command2_Click()
rs.MoveNext
If rs.EOF Then
MsgBox ("Last Record"), vbInformation
rs.MoveLast
End If
SetGridData
SetMainGrid

End Sub

Private Sub Form_Load()
Dither Me
 
  Set rs = New ADODB.Recordset
  If rs.State = 1 Then rs.Close
  rs.CursorLocation = adUseClient
  rs.Open "subjects", frmMain.Cn, adOpenKeyset, adLockOptimistic
  
 SetDataSources
 ShowCourses
 SetGridData
 SetMainGrid
 For i = 0 To rs.Fields.Count - 1
   Grid.ColWidth(i) = GetSetting(App.EXEName, "Grid1", "grid1" & i, 1200)
 Next
 Ch = False
 frm1 = 1
End Sub

Public Sub ShowSemester()
Dim v As Integer
  Dim RsSem As New ADODB.Recordset
  If cmbCourse.ListIndex = -1 Then Exit Sub
  v = cmbCourse.ItemData(cmbCourse.ListIndex)
 SQL = "Select sections from course where course_id= " & v
cmbSemester.Clear
With RsSem
 If .State = 1 Then .Close
   .CursorLocation = adUseClient
   .Open SQL, frmMain.Cn, adOpenDynamic, adLockOptimistic
 For i = 1 To .Fields(0)
   cmbSemester.AddItem "Sections " & i
 Next
End With
End Sub

Private Sub Form_Resize()

' Me.Left = (frmMain.Width - Me.Width) / 70
End Sub

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

Private Sub Grid_DblClick()

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

End Sub

Private Sub Grid_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
   Grid_DblClick
 End If
End Sub


Public Sub ShowCourses()
  Dim RsCourse As New ADODB.Recordset
cmbCourse.Clear
 With RsCourse
   If .State = 1 Then .Close
  .CursorLocation = adUseClient
  .Open "Select Course_id,course_Name from course", frmMain.Cn, adOpenDynamic, adLockOptimistic
While Not .EOF
  cmbCourse.AddItem .Fields(1)
  cmbCourse.ItemData(cmbCourse.NewIndex) = .Fields(0)
  .MoveNext
Wend
End With
End Sub

Private Sub Image1_Click()
Unload Me
End Sub

Private Sub Label2_Click()
Unload frmSubject
End Sub

Private Sub MainGrid_DblClick()
 Ch = True
 With MainGrid
  cmbCourse.Text = .TextMatrix(.Row, 0)
  ZP = cmbCourse.ItemData(cmbCourse.ListIndex)
  cmbSemester.ListIndex = .TextMatrix(.Row, 1) - 1
 End With
 cmdCan.Enabled = True
End Sub

Private Sub MainGrid_KeyDown(KeyCode As Integer, Shift As Integer)
If Ch = True Then Exit Sub
If KeyCode = vbKeyDelete Then
 Call frmMenu.mnuDel_Click
End If
End Sub

Private Sub MainGrid_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Ch = True Then Exit Sub
  If Button = vbRightButton Then
    PopupMenu frmMenu.mnuGrid, 1
  End If
End Sub

Private Sub RS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
On Error GoTo 1

If rs.EOF Or rs.BOF Then Exit Sub
If rs.EditMode = adEditAdd Then
  lblStatus.Caption = "Add New Record...."

Else
 lblStatus.Caption = "RECORD " & CStr(rs.AbsolutePosition) & " / " & rs.RecordCount
End If

Exit Sub
1:
 
  Exit Sub
End Sub


Public Sub SetDataSources()
  Dim j As Control
For Each j In frmSubject
  If TypeOf j Is TextBox Then
    Set j.DataSource = rs
  ElseIf TypeOf j Is DTPicker Then
   Set j.DataSource = rs
  
  End If
Next
 Set lblSub_ID.DataSource = rs
lblSub_ID.DataField = "Sub_ID"
T(0).DataField = "sub_NAME"
T(1).DataField = "author"
DT.DataField = "startdate"
T(2).DataField = "description"
T(3).DataField = "TotalMarks"
End Sub


Public Sub EnableButtons()
 cmdAddNew.Enabled = False
 cmdEdit.Enabled = False
 cmdDelete.Enabled = False
 cmdFind.Enabled = False

 cmdCancel.Enabled = True
 cmdSave.Enabled = True
 cmdNext.Enabled = False
 cmdFirst.Enabled = False
 cmdLast.Enabled = False
 cmdPrevious.Enabled = False
' this will enable all text boxes
  Dim K As Control
   For Each K In frmSubject
     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
  MainGrid.Enabled = True
End Sub
Public Sub DisableButtons()
 cmdAddNew.Enabled = True
 cmdEdit.Enabled = True
 cmdDelete.Enabled = True
 cmdFind.Enabled = True

 cmdCancel.Enabled = False
 cmdSave.Enabled = False
 
 cmdNext.Enabled = True
 cmdFirst.Enabled = True
 cmdLast.Enabled = True
 cmdPrevious.Enabled = True
  
  Dim K As Control
   For Each K In frmSubject
     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
MainGrid.Enabled = False
End Sub


Public Sub LoadInCombo()
  With RsCombo
  If .State = 1 Then .Close
     .CursorLocation = adUseClient

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

'  With cmbCourse
'     Set .DataSource = Rs
'     Set .RowSource = RsCombo
'         .ListField = RsCombo(2).Name
'         .BoundColumn = RsCombo(0).Name
'         .DataField = Rs("Course_ID").Name
'End With

End Sub

Public Sub SetGridData()
If rsgrid.State = 1 Then rsgrid.Close
  rsgrid.CursorLocation = adUseClient
  rsgrid.Open "select sub_id as [SubjectID] , sub_name as [Subject Name],Author,Description,StartDate,TotalMarks from subjects", frmMain.Cn, adOpenDynamic, adLockOptimistic

  Set Grid.DataSource = rsgrid
  Grid.Refresh

End Sub





Function AutoNumber() As Double
 Dim rsAuto As New ADODB.Recordset
 If rsAuto.State = 1 Then rsAuto.Close
 rsAuto.CursorLocation = adUseClient
  rsAuto.Open "select Max(sub_id) as M from subjects", frmMain.Cn
  AutoNumber = rsAuto("M").Value
 
End Function


Private Sub T_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
 If KeyCode = 13 Then
  SendKeys "{tab}"
 'ElseIf KeyCode = 13 And Shift = vbCtrlMask Then
 
 End If
 

' If T(Index).SelLength = 0 And IsNull(T(Index).Text) = True Then
'MsgBox "Starting Space Are Not Allow Please Enter Correct Data "
'T(Index).SelStart = 0
'
'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 = 0 Or Index = 1 Or Index = 2 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 SetMainGrid()
  Dim RsMain As New ADODB.Recordset
With RsMain
 If .State = 1 Then .Close
 .CursorLocation = adUseClient
 .Open "SELECT COURSE.COURSE_NAME ,SUB_COURSE.SEMESTER FROM COURSE " & _
        "INNER JOIN  SUB_COURSE  ON  COURSE.COURSE_ID= SUB_COURSE.COURSE_ID " & _
        "Where SUB_COURSE.SUB_ID = " & Val(lblSub_ID.Caption), frmMain.Cn _
        , adOpenDynamic, adLockOptimistic
 Set MainGrid.DataSource = RsMain
  With MainGrid
   .ColWidth(0) = 2800
   .ColWidth(1) = 2500
 End With
 End With
 
End Sub