frmresult.frm

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

 Dim a1 As Variant, a2 As Variant, a3 As Variant, a4 As Variant, a5 As Variant
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 cmbCourse_Click()
    Call ShowSemester(cmbSemester, cmbCourse.ItemData(cmbCourse.ListIndex))
        FillStudent
            SaveSetting App.Path, "Cmbcourse", "Cmb1", cmbCourse.ListIndex
End Sub

Private Sub cmbExams_Click()
Call GridData(Val(T1.Text), cmbSemester.ListIndex + 1)
SaveSetting App.Path, "CmbExam", "Cmb3", cmbExams.ListIndex
End Sub

Private Sub cmbSemester_Click()
ShowSubjects
Call GridData(Val(T1.Text), cmbSemester.ListIndex + 1)
SaveSetting App.Path, "Cmbsemester", "Cmb2", cmbSemester.ListIndex
End Sub



Private Sub cmbSubjects_Click()
t3.Text = ""
If (Trim(cmbSubjects.Text) <> "") Then
DisplayTotal
End If
End Sub
Sub DisplayTotal()
Dim Rs As New ADODB.Recordset
t3.Text = ""
Rs.Open "select TotalMarks from subjects where Sub_name='" & Trim(cmbSubjects.Text) & "'", frmMain.Cn, 2, 3
t3.Text = Rs!TotalMarks
Set Rs = Nothing

End Sub
Private Sub cmdCancel_Click()
On Error Resume Next
cmbCourse.Enabled = True
cmbSemester.Enabled = True
 cmdCancel.Enabled = False
  cmbCourse.Text = a1
 cmbSemester.Text = a2
 cmbSubjects.Text = a3
 DT.Value = a4
 cmbExams.Text = a5
JK = False
 T2.Text = ""
End Sub


Private Sub cmdPrint_Click()
On Error GoTo 1
Call GridData(Val(T1.Text), cmbSemester.ListIndex + 1)

If pREP = True Then
 MsgBox "THERE ARE NOT ENOUGH DATA TO PROCEED, 4 SUBJECTS ARE REQUIRED THAT ARE NOT AVAILABEL , PLEASE CHECK IT FIRST", vbInformation, App.Comments
 Exit Sub
End If

st1 = Val(T1.Text)
cb = cmbCourse.ItemData(cmbCourse.ListIndex)
db = cmbExams.ItemData(cmbExams.ListIndex)
se = cmbSemester.ListIndex + 1
' With Cr1
'
'  .Destination = crptToPrinter
'  .ReportFileName = App.Path & " \MYREPORT.RPT"
'  .ParameterFields(0) = "STUDID;" & Val(T1.Text) & ";TRUE"
'  .ParameterFields(1) = "COUR;" & cmbCourse.ItemData(cmbCourse.ListIndex) & ";TRUE"
'  .ParameterFields(2) = "EXAMID;" & cmbExams.ItemData(cmbExams.ListIndex) & ";TRUE"
'  .ParameterFields(3) = "SEM;" & cmbSemester.ListIndex + 1 & ";TRUE"
'  .Action = 1
' End With
With DE.rsrptTranscript_Grouping
  If .State = 1 Then .Close
   
   Call DE.rptTranscript_Grouping(st1, cb, db, se)
   Gh = DE.rsrptTranscript_Grouping("aver").Value
   
   If .RecordCount = 0 Then
     MsgBox "No record Found", vbInformation, App.Comments
     Exit Sub
  End If
  rptTranscript.Sections("rptTranscript_Grouping_Footer").Controls("L").Caption = Grading(Gh)
 rptTranscript.Show
 End With
  
  Exit Sub
1:
  MsgBox "THERE ARE ERRORS LOADING REPORT " & _
         vbCrLf & "POSSIBLE CAUSES" & vbCrLf & _
         vbCrLf & "1: THERE IS SOME FIELD IS EMPTY PLEASE CHECK THEM THROUGHLY "
  
End Sub

Private Sub cmdSave_Click()
 

  SaveRecord
  
  T2.Text = ""
  
  T1.SetFocus
  
End Sub



Private Sub Command1_Click()
frmstsearch.Show
DisplayTotal
End Sub

Private Sub Form_Activate()
' With frmMain.La(1)
'  .FontBold = True
'  .BackColor = vbBlack
'  .ForeColor = vbYellow
' End With
  
 'frmMain.ActiveBar1.Bands("New Entry SubBand").Tools("Course").Enabled = True
 
End Sub

Private Sub Form_Load()
 '  frmMain.ActiveBar1.Bands("New Entry SubBand").Tools("Exams").Enabled = True
Dither Me
Ch = True
JK = False
'frmMain.La(1).Visible = True
Call ShowExams(cmbExams)
cmbExams.ListIndex = GetSetting(App.Path, "CmbExam", "Cmb3", 0)

ShowCourses
cmbCourse.ListIndex = GetSetting(App.Path, "Cmbcourse", "Cmb1", 0)

Call ShowSemester(cmbSemester, cmbCourse.ItemData(cmbCourse.ListIndex))
ShowSubjects


cmbSemester.ListIndex = GetSetting(App.Path, "Cmbsemester", "Cmb2", 0)
pREP = False
 frm2 = 1
'frmMain.ActiveBar1.Tools("Exams").Enabled = True
End Sub

Private Sub Form_Resize()
 'Me.WindowState = vbMaximized
  
End Sub

Public Sub ShowSubjects()
 Dim RsSub As New ADODB.Recordset
 v = cmbCourse.ItemData(cmbCourse.ListIndex)
 cmbSubjects.Clear
 SQL = "SELECT SUB_COURSE.SUB_ID, SUB_COURSE.COURSE_ID, SUBJECTS.SUB_NAME" & _
       " FROM SUBJECTS INNER JOIN (COURSE INNER JOIN SUB_COURSE ON COURSE.COURSE_ID = SUB_COURSE.COURSE_ID)" & _
       "ON SUBJECTS.SUB_ID = SUB_COURSE.SUB_ID " & _
       " WHERE (((SUB_COURSE.COURSE_ID)= " & v & ") AND ((SUB_COURSE.SEMESTER)=" & cmbSemester.ListIndex + 1 & "))"
       
     
 With RsSub
   If .State = 1 Then .Close
  .CursorLocation = adUseClient
  .Open SQL, frmMain.Cn, adOpenDynamic, adLockOptimistic
While Not .EOF
  cmbSubjects.AddItem .Fields(2)
  cmbSubjects.ItemData(cmbSubjects.NewIndex) = .Fields(0)
  .MoveNext
Wend
End With
End Sub



Private Sub Form_Unload(Cancel As Integer)
' frmMain.La(1).Visible = False
'frmMain.ActiveBar1.Tools("Exams").Name= False
   'frmMain.ActiveBar1.Bands("New Entry SubBand").Tools("Exams").Visible = False
 'frmMain.ActiveBar1.Bands("New Entry SubBand").Tools("Exams").Enabled = False
 frm2 = 0
End Sub

Private Sub Text1_Change()
 
End Sub

Private Sub Label3_Click()
Unload frmResult
End Sub

Private Sub MainGrid_DblClick()
a1 = cmbCourse.Text
a2 = cmbSemester.Text
a3 = cmbSubjects.Text
a4 = DT.Value
a5 = cmbExams.Text
 JK = True
With MainGrid
 DT.Value = .TextMatrix(.Row, 0)
cmbSubjects.Enabled = True
 cmbSubjects.Text = .TextMatrix(.Row, 1)
 T2.Text = .TextMatrix(.Row, 2)
 cmbCourse.Enabled = False
 cmbSemester.Enabled = False
FIR = cmbSubjects.ItemData(cmbSubjects.ListIndex)
 SU = cmbExams.ItemData(cmbExams.ListIndex)
 cmdCancel.Enabled = True
 End With
End Sub

Private Sub t1_Click()
Call GridData(Val(T1.Text), cmbSemester.ListIndex + 1)

End Sub

Private Sub t1_DblClick()
'CheckStuden
End Sub

'Private Sub t1_GotFocus()
' t1.BackColor = vbGreen
'End Sub

Private Sub t1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF2 Then
  MyDialog.Show vbModal
 End If
  
 If KeyCode = 13 Then
  T2.SetFocus
 End If
End Sub

Private Sub t1_LostFocus()
 T1.BackColor = vbWhite
End Sub

Private Sub t2_Change()
If T1.Text = "" Or T2.Text = "" Then
   cmdSave.Enabled = False
 Else
   cmdSave.Enabled = True
 End If
 If Not IsNumeric(T2.Text) Then
   If Len(T2.Text) > 0 Then
      T2.Text = Left(T2.Text, Len(T2.Text) - 1)
      SendKeys "{end}"
   Else
     T2.Text = ""
   End If
 End If
End Sub

Function Grading(G As Integer) As String
 If G >= 90 Then
   B = "A+"
 ElseIf G >= 85 Then
   B = "A"
 ElseIf G >= 80 Then
   B = "B+"
  ElseIf G >= 70 Then
    B = "B"
  ElseIf G >= 60 Then
    B = "C"
  ElseIf G >= 50 Then
    B = "D"
 Else
  B = "FAIL"
 End If
  Grading = B
End Function

Public Sub GridData(B As Double, j As Integer)
'On Error Resume Next
'If cmbCourse.Text = "" Or cmbSemester.Text = "" Or _
'   cmbExams.Text = "" Then
'   'MsgBox "No Field can be empty , Please Fill these First", vbInformation, App.Comments
'   Exit Sub
' End If

  Dim rsgrid As New ADODB.Recordset
  
  o = cmbExams.ItemData(cmbExams.ListIndex)
 With rsgrid
' SQL = "select exam_date as [EXAM DATE],sub_id AS [SUBJECT],score AS [OBTAINED MARKS],grade AS [GRADE] from STUD_SUBJECT WHERE STUD_ID = " & _
'        B & " AND SEM = " & J & _
'      " And Exam_id= " &
 SQL = "SELECT [STUD_SUBJECT].[EXAM_DATE], [SUBJECTS].[SUB_NAME] ," & _
       "[STUD_SUBJECT].[SCORE], [STUD_SUBJECT].[GRADE] " & _
       " FROM SUBJECTS INNER JOIN STUD_SUBJECT ON " & _
       "[SUBJECTS].[SUB_ID] =[STUD_SUBJECT].[SUB_ID] where stud_id = " & B & _
       "And  Sections= " & j & " and Exam_id = " & o
  .CursorLocation = adUseClient
If .State = 1 Then .Close
  .Open SQL, frmMain.Cn, adOpenDynamic, adLockOptimistic
 ' THIS WILL INSURE THAT ALL THE DATA WILL ALL FOUR RECORD FOR REPORT ARE HERE
 ' IF IT IS NOT THEN REPORT WILL NOT BE PRINTED
 
 If .RecordCount < 4 Then
   pREP = True
 Else
  pREP = False
 End If
 '====================
End With
With MainGrid
  Set .DataSource = rsgrid
  For i = 0 To 4
    .ColWidth(i) = 2200
   Next

End With


End Sub

Public Sub FillStudent()
  Dim RS1 As New ADODB.Recordset
 With RS1
 T1.Clear
   hj = cmbCourse.ItemData(cmbCourse.ListIndex)

   .CursorLocation = adUseClient
   .Open "Select Stud_id from student where  course_id= " & hj, frmMain.Cn, adOpenDynamic
While Not .EOF
   T1.AddItem .Fields(0)
   .MoveNext
Wend
End With
End Sub

Public Sub SaveRecord()
'On Error GoTo 1
  T = cmbCourse.ItemData(cmbCourse.ListIndex)
  r = cmbSemester.ListIndex + 1
  q = cmbSubjects.ItemData(cmbSubjects.ListIndex)
  DT.Value = Date
  d = DT.Value
  E = cmbExams.ItemData(cmbExams.ListIndex)
  G = Grading((Val(T2.Text) / Val(t3.Text)) * 100)
  If JK = True Then
    cmbCourse.Enabled = True
    cmbSemester.Enabled = True
    frmMain.Cn.Execute "UPDATE STUD_SUBJECT SET EXAM_DATE='" & d & _
                       "',SUB_ID =" & q & ",SCORE =" & Val(T2.Text) & " ,EXAM_ID =" & _
                       E & ",GRADE = '" & G & "' WHERE STUD_ID=" & _
                       T1.Text & " AND EXAM_ID = " & SU & " AND SUB_ID = " & FIR
    JK = False
  Else
      frmMain.Cn.Execute "Insert into stud_subject values ( '" & d & "','" & Trim(cmbExams.Text) & "'," & _
                 Val(T1.Text) & "," & q & "," & T2.Text & ",'" & G & "'," & _
                 E & "," & r & ")"
  End If
  Call GridData(Val(T1.Text), cmbSemester.ListIndex + 1)

 Exit Sub
                 
1:
  'MsgBox Err.Number
  If Err.Number = 381 Then
    MsgBox "Some Required Values are missed, Please First Fill the Required Field and Then click &Save", vbInformation, App.Comments
  Else
   MsgBox Err.Description, vbInformation, App.Comments
  End If
End Sub

'Private Sub t2_GotFocus()
' T2.BackColor = vbGreen
'End Sub

Private Sub t2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 And Shift = vbCtrlMask Then
 T1.SetFocus
End If
 If KeyCode = 13 Then
  If cmdSave.Enabled = False Then Exit Sub
  cmdSave.SetFocus
  cmdSave_Click
 End If
End Sub

Private Sub T2_KeyPress(KeyAscii As Integer)
If Index = 2 And KeyAscii <> 13 Then
    ChkNumericDigit KeyAscii
  End If
  
End Sub

Private Sub t2_LostFocus()
T2.BackColor = vbWhite
End Sub