frmexams.frm

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

                  BackColor       =   &H00C0C0C0&
                  Height          =   300
                  Left            =   6195
                  Picture         =   "frmExams.frx":466BC
                  Style           =   1  'Graphical
                  TabIndex        =   17
                  Top             =   0
                  UseMaskColor    =   -1  'True
                  Width           =   345
               End
               Begin VB.CommandButton cmdNext 
                  BackColor       =   &H00C0C0C0&
                  Height          =   300
                  Left            =   5850
                  Picture         =   "frmExams.frx":469FE
                  Style           =   1  'Graphical
                  TabIndex        =   16
                  Top             =   0
                  UseMaskColor    =   -1  'True
                  Width           =   345
               End
               Begin VB.CommandButton cmdPrevious 
                  BackColor       =   &H00C0C0C0&
                  Height          =   300
                  Left            =   345
                  Picture         =   "frmExams.frx":46D40
                  Style           =   1  'Graphical
                  TabIndex        =   15
                  Top             =   0
                  UseMaskColor    =   -1  'True
                  Width           =   345
               End
               Begin VB.CommandButton cmdFirst 
                  BackColor       =   &H00C0C0C0&
                  Height          =   300
                  Left            =   0
                  Picture         =   "frmExams.frx":47082
                  Style           =   1  'Graphical
                  TabIndex        =   14
                  Top             =   0
                  UseMaskColor    =   -1  'True
                  Width           =   345
               End
               Begin VB.Label lblStatus 
                  Alignment       =   2  'Center
                  BackColor       =   &H00FFFFFF&
                  BorderStyle     =   1  'Fixed Single
                  Height          =   285
                  Left            =   720
                  TabIndex        =   18
                  Top             =   0
                  Width           =   5115
               End
            End
         End
      End
      Begin MSHierarchicalFlexGridLib.MSHFlexGrid Grid 
         Height          =   2805
         Left            =   -74910
         TabIndex        =   9
         Top             =   570
         Width           =   5925
         _ExtentX        =   10451
         _ExtentY        =   4948
         _Version        =   393216
         BackColor       =   -2147483647
         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 = "frmExams"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents Rs As ADODB.Recordset
Attribute Rs.VB_VarHelpID = -1
Dim rsgrid As New ADODB.Recordset

Private Sub cmdSave_Click()
On Error GoTo 1
  If T(0).Text = "" Then
   MsgBox "EXAM NAME CAN'T BE EMPTIED", vbInformation, App.Comments
   T(0).SetFocus
  End If
  
   Rs.UpdateBatch adAffectCurrent
   DisableButtons
   SetGridData
  
  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
End Sub

Private Sub Command2_Click()
Rs.MoveNext
If Rs.EOF Then
MsgBox ("Last Record"), vbInformation
Rs.MoveLast
End If
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 "exams", frmMain.Cn, adOpenKeyset, adLockOptimistic
  
 SetDataSources

 SetGridData

 For i = 0 To Rs.Fields.Count - 1
   Grid.ColWidth(i) = GetSetting(App.EXEName, "Grid2", "grid2" & i, 1200)
 Next
End Sub

Private Sub cmdDelete_Click()
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
  lblStatus.Caption = "Editing Record....."
T(0).SetFocus
End Sub

Private Sub cmdFind_Click()
Rs.Requery

U = InputBox("Enter the ID which you want to search")
Rs.Find "exam_id=" & Val(U), 0, adSearchForward, 1
If Rs.EOF Then
 Rs.Requery
 MsgBox "No match Found...", vbInformation, App.Comments
End If
 
End Sub
Private Sub cmdAddNew_Click()
 If Not Rs.EOF Or Not Rs.BOF Then
 Mv = Rs.Bookmark
 End If
 EnableButtons
 
 Rs.AddNew
 
   
 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 exam_id as [EXAM ID], exam_name as [EXAM NAME],DESCRIPTION FROM EXAMS", frmMain.Cn, adOpenDynamic, adLockOptimistic

  Set Grid.DataSource = rsgrid
  Grid.Refresh
  
End Sub
Public Sub SetDataSources()
  Dim j As Control
For Each j In frmExams
  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 = "EXAM_ID"
T(0).DataField = "EXAM_NAME"
T(1).DataField = "DESCRIPTION"
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 frmExams
     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
 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 frmExams
     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

Private Sub Form_Unload(Cancel As Integer)
For i = 0 To Rs.Fields.Count - 1
   SaveSetting App.EXEName, "Grid2", "grid2" & i, Grid.ColWidth(i)
 Next
 
' Call ShowExams(frmResult.cmbExams)
End Sub

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


End Sub

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

Private Sub Label1_Click()
Unload frmExams
End Sub

'Private Sub Label2_Click()
'Unload frmExams
'End Sub

Private Sub T_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
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)
Else
If Index < 1 And KeyCode = 13 Then
T(Index + 1).SetFocus
End If
End If
End Sub

Private Sub T_KeyPress(Index As Integer, KeyAscii As Integer)
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 Sub

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