FORM ABOUT CODES

Option Explicit

Private m_blnSplash As Boolean

Public Property Let SplashMode(ByVal NewVal As Boolean)

m_blnSplash = NewVal

End Property

Private Sub cmdOK_Click()

Unload Me

End Sub

Private Sub Form_Activate()

Timer1.Enabled = True
lblSystem(0).Caption = App.Title
lblSystem(1).Caption = App.Title
lblFor.Caption = App.Comments
lblVersion.Caption = App.FileDescription
lblCopyright.Caption = App.LegalCopyright

End Sub

Private Sub Form_Load()

'Background color....
imgBgColor.Top = Me.Top
imgBgColor.Left = Me.Left
imgBgColor.Height = Me.Height
imgBgColor.Width = Me.Width
imgBgColor.Stretch = True
imgBgColor.ZOrder 1
'Hide the OK Button
If m_blnSplash Then
cmdOK.Visible = False
lblDeveloper.Visible = False
lblRags.Visible = False
End If

End Sub

Private Sub Form_Unload(Cancel As Integer)

Timer1.Enabled = False

End Sub

Private Sub Timer1_Timer()

Static ctr As Integer
Dim arrRags As Variant
arrRags = Array("Ryan M. Ablaza", "Robert S. Roblo", "Edville M. Geslani", "Jojie M. Samson")
lblRags.Caption = arrRags(ctr)
If ctr >= 3 Then
ctr = -1
End If
ctr = ctr + 1

End Sub

CHILD CODES

CLIENT

Option Explicit

Private m_strInputs As String

Public Property Let PassVariable(strValue As String)

m_strInputs = strValue
End Property

Public Function CodeExisting(strCode) As Boolean

Dim rsTemp As ADODB.Recordset

On Error GoTo ErrorHandler

strCode = IIf(Len(strCode) < GENERICCODE_LEN, strCode & "?", strCode)

Set rsTemp = CreateRecordSet(strCode, vbNullString)

If Not rsTemp.EOF Then

ReDim Clients_Search(1)
'load clients info to a table
Clients_Search(1).ClientCode = rsTemp.Fields("ClientCode")
Clients_Search(1).ClientName = Trim(rsTemp.Fields("ClientName"))
End If

ErrorHandler:
Set rsTemp = Nothing

End Function

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchClients"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strClientCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strClientName", adVarChar, adParamInput, 50, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Group Code|<Group Name"
.Rows = 2
.Cols = 2
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1100
.ColWidth(1) = .Width - .ColWidth(0)
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub cmdClear_Click()

ClearAllFields Me
ClearGridContents MSFlexGrid1
 txtClientCode.SetFocus

End Sub

Private Sub cmdExit_Click()

Unload Me

End Sub

Private Sub cmdFind_Click()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(txtClientCode.Text, txtClientName.Text)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("ClientCode")
.Col = 1: .Text = rsTemp.Fields("ClientName")
If txtClientCode.Text = rsTemp.Fields("ClientCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing
'If record found is only one
If intlastrow = 2 Then
MSFlexGrid1_DblClick
End If
MsgBar vbNullString

End Sub

Private Sub Form_Activate()

DoEvents
InitGrid
cmdFind_Click

End Sub

Private Sub Form_Load()

If IsNumeric(Trim(m_strInputs)) Then
txtClientCode.Text = FillWithSpaces(m_strInputs, GENERICCODE_LEN)
Else
 txtClientName.Text = m_strInputs
End If

End Sub

Private Sub MSFlexGrid1_DblClick()

With MSFlexGrid1
If .TextArray(.Row * .Cols + 1) <> vbNullString Then
ReDim Clients_Search(1)
Clients_Search(1).ClientCode = .TextArray(.Row * .Cols + 0)
Clients_Search(1).ClientName = .TextArray(.Row * .Cols + 1)
Unload Me
DoEvents
End If
End With

End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)

If KeyAscii = vbKeyReturn Then
MSFlexGrid1_DblClick
End If

End Sub

Private Sub txtClientCode_GotFocus()

SelectCtl txtClientCode

End Sub

Private Sub txtClientName_GotFocus()

SelectCtl txtClientName

End Sub

Private Sub txtClientName_LostFocus()

cmdFind_Click
End Sub

COURSES

Option Explicit

Private m_strInputs As String

Public Property Let PassVariable(strValue As String)

m_strInputs = strValue

End Property

Public Function CodeExisting(strCode) As Boolean

Dim rsTemp As ADODB.Recordset

On Error GoTo ErrorHandler

strCode = IIf(Len(strCode) < GENERICCODE_LEN, strCode & "?", strCode)

Set rsTemp = CreateRecordSet(strCode, vbNullString)

If Not rsTemp.EOF Then

ReDim Courses_Search(1)
'load courses info to a table
Courses_Search(1).CourseCode = rsTemp.Fields("CourseCode")
Courses_Search(1).CourseName = Trim(rsTemp.Fields("CourseName"))
End If

ErrorHandler:
Set rsTemp = Nothing
End Function

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchCourses"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strCourseCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strCourseName", adVarChar, adParamInput, 50, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Course Code|<Course Name"
.Rows = 2
.Cols = 2
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = .Width - .ColWidth(0)
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub cmdClear_Click()

ClearAllFields Me
ClearGridContents MSFlexGrid1
txtCourseCode.SetFocus

End Sub

Private Sub cmdExit_Click()

Unload Me

End Sub

Private Sub cmdFind_Click()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(txtCourseCode.Text, txtCourseName.Text)

Screen.MousePointer = vbHourglass
 MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("CourseCode")
.Col = 1: .Text = rsTemp.Fields("CourseName")
If txtCourseCode.Text = rsTemp.Fields("CourseCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing
'If record found is only one
If intlastrow = 2 Then
MSFlexGrid1_DblClick
End If
MsgBar vbNullString

End Sub

Private Sub Form_Activate()

DoEvents
InitGrid
cmdFind_Click

End Sub

Private Sub Form_Load()

If IsNumeric(Trim(m_strInputs)) Then
txtCourseCode.Text = FillWithSpaces(m_strInputs, GENERICCODE_LEN)
Else
txtCourseName.Text = m_strInputs
End If

End Sub

Private Sub MSFlexGrid1_DblClick()

With MSFlexGrid1
If .TextArray(.Row * .Cols + 1) <> vbNullString Then
ReDim Courses_Search(1)
Courses_Search(1).CourseCode = .TextArray(.Row * .Cols + 0)
Courses_Search(1).CourseName = .TextArray(.Row * .Cols + 1)
Unload Me
DoEvents
End If
End With

End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)

 If KeyAscii = vbKeyReturn Then
MSFlexGrid1_DblClick
End If

End Sub

Private Sub txtCourseCode_GotFocus()

SelectCtl txtCourseCode

End Sub

Private Sub txtCourseName_GotFocus()

SelectCtl txtCourseName

End Sub

Private Sub txtCourseName_LostFocus()

cmdFind_Click

End Sub

FILTERED

Option Explicit

Private m_strInputs As String

Private m_strInputs2 As String

Public Property Let PassVariable(strValue As String)

m_strInputs = strValue

End Property

Public Property Let PassVariable2(strValue As String)

m_strInputs2 = strValue

End Property

Public Function CodeExisting(strTCode, strCode) As Boolean

Dim rsTemp As ADODB.Recordset

On Error GoTo ErrorHandler

strCode = IIf(Len(strCode) < GENERICCODE_LEN, strCode & "?", strCode)

Set rsTemp = CreateRecordSet(strTCode, strCode, vbNullString)

If Not rsTemp.EOF Then

ReDim Trainees_Search(1)
'load trainees info to a table
Trainees_Search(1).TraineeCode = rsTemp.Fields("TraineeCode")
Trainees_Search(1).TraineeName = Trim(rsTemp.Fields("TraineeName"))
End If

ErrorHandler:
Set rsTemp = Nothing

End Function

Private Function CreateRecordSet(strTCode, strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchFilteredTrainees"
.CommandType = adCmdStoredProc
 .CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strTCode))
.Parameters.Append .CreateParameter("strTraineeCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strTraineeName", adVarChar, adParamInput, 65, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Trainee Code|<Trainee Name"
.Rows = 2
.Cols = 2
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = .Width - .ColWidth(0)
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub cmdClear_Click()

ClearAllFields Me
ClearGridContents MSFlexGrid1
txtTraineeCode.SetFocus

End Sub

Private Sub cmdExit_Click()

Unload Me

End Sub

Private Sub cmdFind_Click()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(m_strInputs2, txtTraineeCode.Text, txtTraineeName.Text)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
 Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("TraineeCode")
.Col = 1: .Text = rsTemp.Fields("TraineeName")
If txtTraineeCode.Text = rsTemp.Fields("TraineeCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing
'If record found is only one
If intlastrow = 2 Then
MSFlexGrid1_DblClick
End If
MsgBar vbNullString

End Sub

Private Sub Form_Activate()

DoEvents
InitGrid
cmdFind_Click

End Sub

Private Sub Form_Load()

If IsNumeric(Trim(m_strInputs)) Then
txtTraineeCode.Text = FillWithSpaces(m_strInputs, GENERICCODE_LEN)
Else
txtTraineeName.Text = m_strInputs
End If

End Sub

Private Sub MSFlexGrid1_DblClick()

With MSFlexGrid1
If .TextArray(.Row * .Cols + 1) <> vbNullString Then
ReDim Trainees_Search(1)
Trainees_Search(1).TraineeCode = .TextArray(.Row * .Cols + 0)
Trainees_Search(1).TraineeName = .TextArray(.Row * .Cols + 1)
Unload Me
DoEvents
End If
End With

End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)

If KeyAscii = vbKeyReturn Then
MSFlexGrid1_DblClick
End If

End Sub

Private Sub txtTraineeCode_GotFocus()

SelectCtl txtTraineeCode

End Sub

Private Sub txtTraineeName_GotFocus()

 SelectCtl txtTraineeName

End Sub

Private Sub txtTraineename_LostFocus()

cmdFind_Click

End Sub

GROUPS

Option Explicit

Private m_strInputs As String

Public Property Let PassVariable(strValue As String)

m_strInputs = strValue

End Property

Public Function CodeExisting(strCode) As Boolean

Dim rsTemp As ADODB.Recordset

On Error GoTo ErrorHandler

strCode = IIf(Len(strCode) < GROUPCODE_LEN, strCode & "?", strCode)

Set rsTemp = CreateRecordSet(strCode, vbNullString)

If Not rsTemp.EOF Then

ReDim Groups_Search(1)
'load user group info to a table
Groups_Search(1).GroupCode = rsTemp.Fields("GroupCode")
Groups_Search(1).GroupName = Trim(rsTemp.Fields("Description"))
End If

ErrorHandler:
Set rsTemp = Nothing

End Function

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchGroups"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strGroupCode", adVarChar, adParamInput, GROUPCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strGroupName", adVarChar, adParamInput, 50, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Group Code|<Group Name"
.Rows = 2
.Cols = 2
.AllowUserResizing = flexResizeColumns
 .ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1100
.ColWidth(1) = .Width - .ColWidth(0)
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub cmdClear_Click()

ClearAllFields Me
ClearGridContents MSFlexGrid1
txtGroupCode.SetFocus

End Sub

Private Sub cmdExit_Click()

Unload Me

End Sub

Private Sub cmdFind_Click()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(txtGroupCode.Text, txtGroupName.Text)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("GroupCode")
.Col = 1: .Text = rsTemp.Fields("Description")
If txtGroupCode.Text = rsTemp.Fields("GroupCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing
 'If record found is only one
If intlastrow = 2 Then
MSFlexGrid1_DblClick
End If
MsgBar vbNullString

End Sub

Private Sub Form_Activate()

DoEvents
InitGrid
cmdFind_Click

End Sub

Private Sub Form_Load()

If IsNumeric(Trim(m_strInputs)) Then
txtGroupCode.Text = FillWithSpaces(m_strInputs, GROUPCODE_LEN)
Else
txtGroupName.Text = m_strInputs
End If

End Sub

Private Sub MSFlexGrid1_DblClick()

With MSFlexGrid1
If .TextArray(.Row * .Cols + 1) <> vbNullString Then
ReDim Groups_Search(1)
Groups_Search(1).GroupCode = .TextArray(.Row * .Cols + 0)
Groups_Search(1).GroupName = .TextArray(.Row * .Cols + 1)
Unload Me
DoEvents
End If
End With

End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)

If KeyAscii = vbKeyReturn Then
MSFlexGrid1_DblClick
End If

End Sub

Private Sub txtGroupCode_GotFocus()

SelectCtl txtGroupCode

End Sub

Private Sub txtGroupName_GotFocus()

SelectCtl txtGroupName

End Sub

Private Sub txtGroupName_LostFocus()

cmdFind_Click

End Sub

ON-LINE USERS

Option Explicit

Private m_strInputs As String

Public Property Let PassVariable(strValue As String)

m_strInputs = strValue
End Property

Public Function CodeExisting(strCode) As Boolean

Dim rsTemp As ADODB.Recordset

On Error GoTo ErrorHandler

strCode = IIf(Len(strCode) < GENERICCODE_LEN, strCode & "?", strCode)

Set rsTemp = CreateRecordSet(strCode, vbNullString)

If Not rsTemp.EOF Then

ReDim DeanCOO_Search(1)
'load dean/coo info to a table
DeanCOO_Search(1).DeanCode = rsTemp.Fields("DeanCode")
DeanCOO_Search(1).DeanName = Trim(rsTemp.Fields("DeanName"))
DeanCOO_Search(1).GroupCode = rsTemp.Fields("Company")
DeanCOO_Search(1).GroupName = rsTemp.Fields("CompanyName")
End If

ErrorHandler:
Set rsTemp = Nothing

End Function

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchOnlineUsers"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strDeanCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strDeanName", adVarChar, adParamInput, 65, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Dean/COO Code|<Dean/COO Name|^Group Code|<GroupName"
.Rows = 2
.Cols = 4
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub
Private Sub cmdClear_Click()
ClearAllFields Me
ClearGridContents MSFlexGrid1
txtDeanCode.SetFocus

End Sub

Private Sub cmdExit_Click()

Unload Me

End Sub

Private Sub cmdFind_Click()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(txtDeanCode.Text, txtDeanName.Text)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("DeanCode")
.Col = 1: .Text = rsTemp.Fields("DeanName")
.Col = 2: .Text = rsTemp.Fields("Company")
.Col = 3: .Text = rsTemp.Fields("CompanyName")
If txtDeanCode.Text = rsTemp.Fields("DeanCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing
'If record found is only one
If intlastrow = 2 Then
MSFlexGrid1_DblClick
End If
MsgBar vbNullString

End Sub

Private Sub Form_Activate()

DoEvents
InitGrid
cmdFind_Click

End Sub
Private Sub Form_Load()
If IsNumeric(Trim(m_strInputs)) Then
txtDeanCode.Text = FillWithSpaces(m_strInputs, GENERICCODE_LEN)
Else
txtDeanName.Text = m_strInputs
End If

End Sub

Private Sub MSFlexGrid1_DblClick()

With MSFlexGrid1
If .TextArray(.Row * .Cols + 1) <> vbNullString Then
ReDim DeanCOO_Search(1)
DeanCOO_Search(1).DeanCode = .TextArray(.Row * .Cols + 0)
DeanCOO_Search(1).DeanName = .TextArray(.Row * .Cols + 1)
DeanCOO_Search(1).GroupCode = .TextArray(.Row * .Cols + 2)
DeanCOO_Search(1).GroupName = .TextArray(.Row * .Cols + 3)
Unload Me
DoEvents
End If
End With

End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)

If KeyAscii = vbKeyReturn Then
MSFlexGrid1_DblClick
End If

End Sub

Private Sub txtDeanCode_GotFocus()

SelectCtl txtDeanCode

End Sub

Private Sub txtDeanName_GotFocus()

SelectCtl txtDeanName

End Sub

Private Sub txtDeanName_LostFocus()

cmdFind_Click

End Sub

PRE-REQUISITES

Option Explicit

Private m_strInputs As String

Public Property Let PassVariable(strValue As String)

m_strInputs = strValue

End Property

Public Function CodeExisting(strCode) As Boolean

Dim rsTemp As ADODB.Recordset

On Error GoTo ErrorHandler

strCode = IIf(Len(strCode) < GENERICCODE_LEN, strCode & "?", strCode)

Set rsTemp = CreateRecordSet(strCode, vbNullString)

If Not rsTemp.EOF Then

ReDim Courses_Search(1)
 'load courses info to a table
Courses_Search(1).CourseCode = rsTemp.Fields("CourseCode")
Courses_Search(1).CourseName = Trim(rsTemp.Fields("CourseName"))
End If

ErrorHandler:
Set rsTemp = Nothing

End Function

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchPreRequisite"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strCourseCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strCourseName", adVarChar, adParamInput, 50, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Course Code|<Course Name"
.Rows = 2
.Cols = 2
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = .Width - .ColWidth(0)
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub cmdClear_Click()

ClearAllFields Me
ClearGridContents MSFlexGrid1
txtCourseCode.SetFocus

End Sub

Private Sub cmdExit_Click()

Unload Me

End Sub

Private Sub cmdFind_Click()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
 Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(txtCourseCode.Text, txtCourseName.Text)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("CourseCode")
.Col = 1: .Text = rsTemp.Fields("CourseName")
If txtCourseCode.Text = rsTemp.Fields("CourseCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing
'If record found is only one
If intlastrow = 2 Then
MSFlexGrid1_DblClick
End If
MsgBar vbNullString

End Sub

Private Sub Form_Activate()

DoEvents
InitGrid
cmdFind_Click

End Sub

Private Sub Form_Load()

If IsNumeric(Trim(m_strInputs)) Then
txtCourseCode.Text = FillWithSpaces(m_strInputs, GENERICCODE_LEN)
Else
txtCourseName.Text = m_strInputs
End If

End Sub

Private Sub MSFlexGrid1_DblClick()

With MSFlexGrid1
If .TextArray(.Row * .Cols + 1) <> vbNullString Then
ReDim Courses_Search(1)
Courses_Search(1).CourseCode = .TextArray(.Row * .Cols + 0)
Courses_Search(1).CourseName = .TextArray(.Row * .Cols + 1)
Unload Me
 DoEvents
End If
End With

End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)

If KeyAscii = vbKeyReturn Then
MSFlexGrid1_DblClick
End If

End Sub

Private Sub txtCourseCode_GotFocus()

SelectCtl txtCourseCode

End Sub

Private Sub txtCourseName_GotFocus()

SelectCtl txtCourseName

End Sub

Private Sub txtCourseName_LostFocus()

cmdFind_Click

End Sub

TRAINEES

Option Explicit

Private m_strInputs As String

Public Property Let PassVariable(strValue As String)

m_strInputs = strValue

End Property

Public Function CodeExisting(strCode) As Boolean

Dim rsTemp As ADODB.Recordset

On Error GoTo ErrorHandler

strCode = IIf(Len(strCode) < GENERICCODE_LEN, strCode & "?", strCode)

Set rsTemp = CreateRecordSet(strCode, vbNullString)

If Not rsTemp.EOF Then

ReDim Trainees_Search(1)
'load trainees info to a table
Trainees_Search(1).TraineeCode = rsTemp.Fields("TraineeCode")
Trainees_Search(1).TraineeName = Trim(rsTemp.Fields("TraineeName"))
End If

ErrorHandler:
Set rsTemp = Nothing

End Function

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchTrainees"
 .CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTraineeCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strTraineeName", adVarChar, adParamInput, 65, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Trainee Code|<Trainee Name"
.Rows = 2
.Cols = 2
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = .Width - .ColWidth(0)
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub cmdClear_Click()

ClearAllFields Me
ClearGridContents MSFlexGrid1
txtTraineeCode.SetFocus

End Sub

Private Sub cmdExit_Click()

Unload Me

End Sub

Private Sub cmdFind_Click()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(txtTraineeCode.Text, txtTraineeName.Text)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
 Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("TraineeCode")
.Col = 1: .Text = rsTemp.Fields("TraineeName")
If txtTraineeCode.Text = rsTemp.Fields("TraineeCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing
'If record found is only one
If intlastrow = 2 Then
MSFlexGrid1_DblClick
End If
MsgBar vbNullString

End Sub

Private Sub Form_Activate()

DoEvents
InitGrid
cmdFind_Click

End Sub

Private Sub Form_Load()

If IsNumeric(Trim(m_strInputs)) Then
txtTraineeCode.Text = FillWithSpaces(m_strInputs, GENERICCODE_LEN)
Else
txtTraineeName.Text = m_strInputs
End If

End Sub

Private Sub MSFlexGrid1_DblClick()

With MSFlexGrid1
If .TextArray(.Row * .Cols + 1) <> vbNullString Then
ReDim Trainees_Search(1)
Trainees_Search(1).TraineeCode = .TextArray(.Row * .Cols + 0)
Trainees_Search(1).TraineeName = .TextArray(.Row * .Cols + 1)
Unload Me
DoEvents
End If
End With

End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)

If KeyAscii = vbKeyReturn Then
MSFlexGrid1_DblClick
End If

End Sub

Private Sub txtTraineeCode_GotFocus()

SelectCtl txtTraineeCode

End Sub

Private Sub txtTraineeName_GotFocus()

 SelectCtl txtTraineeName

End Sub

Private Sub txtTraineename_LostFocus()

cmdFind_Click
End Sub

TRAINEERS

Option Explicit

Private m_strInputs As String

Public Property Let PassVariable(strValue As String)

m_strInputs = strValue

End Property

Public Function CodeExisting(strCode) As Boolean

Dim rsTemp As ADODB.Recordset

On Error GoTo ErrorHandler

strCode = IIf(Len(strCode) < GENERICCODE_LEN, strCode & "?", strCode)

Set rsTemp = CreateRecordSet(strCode, vbNullString)

If Not rsTemp.EOF Then

ReDim Trainers_Search(1)
'load trainers info to a table
Trainers_Search(1).TrainerCode = rsTemp.Fields("TrainerCode")
Trainers_Search(1).TrainerName = Trim(rsTemp.Fields("TrainerName"))
End If

ErrorHandler:
Set rsTemp = Nothing

End Function

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchTrainers"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strTrainerCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strTrainerName", adVarChar, adParamInput, 65, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Trainer Code|<Trainer Name"
.Rows = 2
.Cols = 2
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
 .SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = .Width - .ColWidth(0)
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub cmdClear_Click()

ClearAllFields Me
ClearGridContents MSFlexGrid1
txtTrainerCode.SetFocus

End Sub

Private Sub cmdExit_Click()

Unload Me

End Sub

Private Sub cmdFind_Click()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(txtTrainerCode.Text, txtTrainerName.Text)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("TrainerCode")
.Col = 1: .Text = rsTemp.Fields("TrainerName")
If txtTrainerCode.Text = rsTemp.Fields("TrainerCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing
'If record found is only one
If intlastrow = 2 Then
 MSFlexGrid1_DblClick
End If
MsgBar vbNullString

End Sub

Private Sub Form_Activate()

DoEvents
InitGrid
cmdFind_Click

End Sub

Private Sub Form_Load()

If IsNumeric(Trim(m_strInputs)) Then
txtTrainerCode.Text = FillWithSpaces(m_strInputs, GENERICCODE_LEN)
Else
txtTrainerName.Text = m_strInputs
End If

End Sub

Private Sub MSFlexGrid1_DblClick()

With MSFlexGrid1
If .TextArray(.Row * .Cols + 1) <> vbNullString Then
ReDim Trainers_Search(1)
Trainers_Search(1).TrainerCode = .TextArray(.Row * .Cols + 0)
Trainers_Search(1).TrainerName = .TextArray(.Row * .Cols + 1)
Unload Me
DoEvents
End If
End With

End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)

If KeyAscii = vbKeyReturn Then
MSFlexGrid1_DblClick
End If

End Sub

Private Sub txtTrainerCode_GotFocus()

SelectCtl txtTrainerCode

End Sub

Private Sub txtTrainerName_GotFocus()

SelectCtl txtTrainerName

End Sub

Private Sub txtTrainername_LostFocus()

cmdFind_Click

End Sub

TRAINING

Option Explicit

Private m_strInputs As String

Public Property Let PassVariable(strValue As String)

m_strInputs = strValue

End Property
Public Function CodeExisting(strCode) As Boolean
Dim rsTemp As ADODB.Recordset

On Error GoTo ErrorHandler

strCode = IIf(Len(strCode) < GENERICCODE_LEN, strCode & "?", strCode)

Set rsTemp = CreateRecordSet(strCode, vbNullString)

If Not rsTemp.EOF Then

ReDim TrainingCourses_Search(1)
'load training courses info to a table
TrainingCourses_Search(1).TrainingCode = rsTemp.Fields("TrainingCode")
TrainingCourses_Search(1).TrainingName = rsTemp.Fields("TrainingName")
TrainingCourses_Search(1).CourseCode = rsTemp.Fields("CourseCode")
TrainingCourses_Search(1).CourseName = rsTemp.Fields("CourseName")
TrainingCourses_Search(1).TrainerCode = rsTemp.Fields("TrainerCode")
TrainingCourses_Search(1).TrainerName = rsTemp.Fields("LastName") & ", " & rsTemp.Fields("FirstName")
TrainingCourses_Search(1).ScheduleFr = rsTemp.Fields("ScheduleFrom")
TrainingCourses_Search(1).ScheduleTo = rsTemp.Fields("ScheduleTo")
TrainingCourses_Search(1).ScheduleTime = rsTemp.Fields("ScheduleTime")
TrainingCourses_Search(1).Days = rsTemp.Fields("ScheduleDays")
End If

ErrorHandler:
Set rsTemp = Nothing

End Function

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchTrainingCourses"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strTrainingName", adVarChar, adParamInput, 50, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Training Code|<Training Name|^Course Code|<Course Name|^Trainer Code|<Trainer
Name|^From|^To|^Time|<Days"
.Rows = 2
.Cols = 10
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.ColWidth(4) = 1215
.ColWidth(5) = 4005
.ColWidth(6) = 1100
.ColWidth(7) = 1100
.ColWidth(8) = 1100
 .ColWidth(9) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub cmdClear_Click()

ClearAllFields Me
ClearGridContents MSFlexGrid1
txtTrainingCode.SetFocus

End Sub

Private Sub cmdExit_Click()

Unload Me

End Sub

Private Sub cmdFind_Click()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(txtTrainingCode.Text, txtTrainingName.Text)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("TrainingCode")
.Col = 1: .Text = rsTemp.Fields("TrainingName")
.Col = 2: .Text = rsTemp.Fields("CourseCode")
.Col = 3: .Text = rsTemp.Fields("CourseName")
.Col = 4: .Text = rsTemp.Fields("TrainerCode")
.Col = 5: .Text = rsTemp.Fields("LastName") & ", " & rsTemp.Fields("FirstName")
.Col = 6: .Text = rsTemp.Fields("ScheduleFrom")
.Col = 7: .Text = rsTemp.Fields("ScheduleTo")
.Col = 8: .Text = rsTemp.Fields("ScheduleTime")
.Col = 9: .Text = rsTemp.Fields("ScheduleDays")
If txtTrainingCode.Text = rsTemp.Fields("TrainingCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing
'If record found is only one
If intlastrow = 2 Then
MSFlexGrid1_DblClick
End If
MsgBar vbNullString

End Sub

Private Sub Form_Activate()

DoEvents
InitGrid
cmdFind_Click

End Sub

Private Sub Form_Load()

If IsNumeric(Trim(m_strInputs)) Then
txtTrainingCode.Text = FillWithSpaces(m_strInputs, GENERICCODE_LEN)
Else
txtTrainingName.Text = m_strInputs
End If

End Sub

Private Sub MSFlexGrid1_DblClick()

With MSFlexGrid1
If .TextArray(.Row * .Cols + 1) <> vbNullString Then
ReDim TrainingCourses_Search(1)
TrainingCourses_Search(1).TrainingCode = .TextArray(.Row * .Cols + 0)
TrainingCourses_Search(1).TrainingName = .TextArray(.Row * .Cols + 1)
TrainingCourses_Search(1).CourseCode = .TextArray(.Row * .Cols + 2)
TrainingCourses_Search(1).CourseName = .TextArray(.Row * .Cols + 3)
TrainingCourses_Search(1).TrainerCode = .TextArray(.Row * .Cols + 4)
TrainingCourses_Search(1).TrainerName = .TextArray(.Row * .Cols + 5)
TrainingCourses_Search(1).ScheduleFr = .TextArray(.Row * .Cols + 6)
TrainingCourses_Search(1).ScheduleTo = .TextArray(.Row * .Cols + 7)
TrainingCourses_Search(1).ScheduleTime = .TextArray(.Row * .Cols + 8)
TrainingCourses_Search(1).Days = .TextArray(.Row * .Cols + 9)
Unload Me
DoEvents
End If
End With

End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)

If KeyAscii = vbKeyReturn Then
MSFlexGrid1_DblClick
End If

End Sub

Private Sub txtTrainingCode_GotFocus()

SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingName_GotFocus()

SelectCtl txtTrainingName

End Sub

Private Sub txtTrainingName_LostFocus()

cmdFind_Click
End Sub

VENUES

Option Explicit

Private m_strInputs As String

Public Property Let PassVariable(strValue As String)

m_strInputs = strValue

End Property

Public Function CodeExisting(strCode) As Boolean

Dim rsTemp As ADODB.Recordset

On Error GoTo ErrorHandler

strCode = IIf(Len(strCode) < GENERICCODE_LEN, strCode & "?", strCode)

Set rsTemp = CreateRecordSet(strCode, vbNullString)

If Not rsTemp.EOF Then

ReDim Venues_Search(1)
'load venues info to a table
Venues_Search(1).VenueCode = rsTemp.Fields("VenueCode")
Venues_Search(1).VenueName = Trim(rsTemp.Fields("VenueName"))
End If

ErrorHandler:
Set rsTemp = Nothing

End Function

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchVenues"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strVenueCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strVenueName", adVarChar, adParamInput, 50, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Venue Code|<Description"
.Rows = 2
.Cols = 2
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1100
.ColWidth(1) = .Width - .ColWidth(0)
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
 .Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub cmdClear_Click()

ClearAllFields Me
ClearGridContents MSFlexGrid1
txtVenueCode.SetFocus

End Sub

Private Sub cmdExit_Click()

Unload Me

End Sub

Private Sub cmdFind_Click()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(txtVenueCode.Text, txtVenueName.Text)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("VenueCode")
.Col = 1: .Text = rsTemp.Fields("VenueName")
If txtVenueCode.Text = rsTemp.Fields("VenueCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing
'If record found is only one
If intlastrow = 2 Then
MSFlexGrid1_DblClick
End If
MsgBar vbNullString

End Sub
Private Sub Form_Activate()
DoEvents
InitGrid
cmdFind_Click

End Sub

Private Sub Form_Load()

If IsNumeric(Trim(m_strInputs)) Then
txtVenueCode.Text = FillWithSpaces(m_strInputs, GENERICCODE_LEN)
Else
txtVenueName.Text = m_strInputs
End If

End Sub

Private Sub MSFlexGrid1_DblClick()

With MSFlexGrid1
If .TextArray(.Row * .Cols + 1) <> vbNullString Then
ReDim Venues_Search(1)
Venues_Search(1).VenueCode = .TextArray(.Row * .Cols + 0)
Venues_Search(1).VenueName = .TextArray(.Row * .Cols + 1)
Unload Me
DoEvents
End If
End With

End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)

If KeyAscii = vbKeyReturn Then
MSFlexGrid1_DblClick
End If

End Sub

Private Sub txtVenueCode_GotFocus()

SelectCtl txtVenueCode

End Sub

Private Sub txtVenueName_GotFocus()

SelectCtl txtVenueName

End Sub

Private Sub txtVenueName_LostFocus()

cmdFind_Click

End Sub
DATA ENRTY CODES

BLACKLIST TRAINEE

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)
End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
MSFlexGrid1.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean, blnFind As
Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint

End Sub

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Trainee Code|<Trainee Name|<Sanction Date|<Remarks"
.Rows = 2
.Cols = 4
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 1305
.ColWidth(3) = .Width
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

If blnPrint Then Exit Sub
blnPrint = True

MsgBar "Generating Trainee Black listed Report. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Trainee Black listed Report'"
.WindowTitle = "Trainee Black listed Report"
.SelectionFormula = "{vwD_BlkTrainee.GroupCode} = '" & g_strUserGroup & "' AND {vwD_BlkTrainee.Remarks} = '" &
REM_TRAINEE & "'"
.ReportFileName = g_DirectoryReports & "R_BlklistTrainee.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False
End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraBlackListed.Enabled = False
txtTraineeCode.Locked = False
m_intOperation = BTN_FIND
MSFlexGrid1_Click
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraBlackListed.Enabled = True
EnableOperation m_blnRightsADD, False, False, False, False
EnabledClose False
ClearAllFields Me
txtTraineeCode.SetFocus
Case BTN_EDIT 'edit/1
If txtTraineeCode <> vbNullString Then
MsgBar MSG_EDIT
fraBlackListed.Enabled = True
txtTraineeCode.Locked = True
EnableOperation False, m_blnRightsEDIT, False, False, False
EnabledClose False
dtpTrainee.SetFocus
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_DELETE 'delete/2
Dim strMsg As String
MsgBar MSG_DELETE
With MSFlexGrid1
strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & vbLf & _
"Do you want to delete this record?"
End With
If txtTraineeCode <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
Case BTN_FIND 'find/4
MsgBar MSG_FIND
fraBlackListed.Enabled = True
EnableOperation False, False, False, False, True
cmdCancel.Enabled = True
ClearAllFields Me
txtTraineeCode.SetFocus
End Select

End Sub

Private Sub cmdSave_Click()

 'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtTraineeCode.Text) = vbNullString Then
MsgBar "Course code must not be blank. Please fill-in the field."
txtTraineeCode.SetFocus
Exit Sub
End If
End If

'save and load data to grid

Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spBlkListTrainee"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strRemarks", adChar, adParamInput, 1, REM_TRAINEE)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN, txtTraineeCode.Text)
.Parameters.Append .CreateParameter("strSanctionDate", adChar, adParamInput, DATE_LEN, Format(dtpTrainee.value,
DATE_FORMAT))
.Parameters.Append .CreateParameter("strReason", adChar, adParamInput, 50, txtRemTrainee.Text)
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("TraineeCode")
.Col = 1: .Text = rsTemp.Fields("FirstName") & " " & rsTemp.Fields("LastName")
.Col = 2: .Text = Format(rsTemp.Fields("SanctionDate"), DATE_FORMAT)
.Col = 3: .Text = rsTemp.Fields("Reason")
If txtTraineeCode.Text = rsTemp.Fields("TraineeCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
 ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub Form_Load()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraBlackListed.Enabled = False
m_intOperation = BTN_FIND
InitGrid
cmdSave_Click
MSFlexGrid1_Click
DoEvents

End Sub

Private Sub MSFlexGrid1_Click()

With MSFlexGrid1
txtTraineeCode.Text = Trim(.TextArray(.Row * .Cols + 0))
lblTraineeName.Caption = Trim(.TextArray(.Row * .Cols + 1))
dtpTrainee.value = CheckDate(Trim(.TextArray(.Row * .Cols + 2)))
txtRemTrainee.Text = Trim(.TextArray(.Row * .Cols + 3))
If m_intOperation = BTN_EDIT Then
SelectCtl txtRemTrainee
End If
End With
MsgBar vbNullString

End Sub

Private Sub MSFlexGrid1_SelChange()

MSFlexGrid1_Click

End Sub

'Pop-up Trainees
Private Sub txtTraineeCode_GotFocus()
SelectCtl txtTraineeCode

End Sub

Private Sub txtTraineeCode_LostFocus()

CheckTraineesField

End Sub

Private Sub txtTraineeCode_Validate(Cancel As Boolean)

Cancel = TraineeSearch(Me, txtTraineeCode.Text)

End Sub

Private Sub cmdTrainee_Click()

TraineeSearch Me, vbNullString, True
CheckTraineesField

End Sub

Private Sub CheckTraineesField()

If Trainees_Search(1).TraineeCode <> vbNullString Then
txtTraineeCode.Text = Trainees_Search(1).TraineeCode
lblTraineeName.Caption = Trainees_Search(1).TraineeName
End If

End Sub
'End of Pop-up Trainee

BLACK LIST TRAINER

Option Explicit
Dim blnPrint As Boolean
Const COL_ARCHIVE = 9

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^ |^Trainer Code|<First Name|^MI|<Last Name|<Title|<Specialization|<Telephone No.|<Email Address"
.Rows = 2
.Cols = 10
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 570
.ColWidth(1) = 1215
.ColWidth(2) = 4005
.ColWidth(3) = 500
.ColWidth(4) = 4005
.ColWidth(5) = 4005
.ColWidth(6) = 4005
.ColWidth(7) = 1590
.ColWidth(8) = 4005
.ColWidth(9) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub Load_TrainerToGrid()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spBlkListTrainer"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, BTN_FIND)
.Parameters.Append .CreateParameter("strTrainerCode", adChar, adParamInput, GENERICCODE_LEN, vbNullString)
.Parameters.Append .CreateParameter("strBlackListed", adChar, adParamInput, 1, vbNullString)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
 Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
If rsTemp.Fields("BlackListed") <> NO Then
.Col = 0: Set .CellPicture = imgSelected.Picture
.CellPictureAlignment = flexAlignCenterCenter
End If
.Col = 1: .Text = rsTemp.Fields("TrainerCode")
.Col = 2: .Text = rsTemp.Fields("FirstName")
.Col = 3: .Text = rsTemp.Fields("MiddleInit")
.Col = 4: .Text = rsTemp.Fields("LastName")
.Col = 5: .Text = rsTemp.Fields("Title")
.Col = 6: .Text = rsTemp.Fields("Specialized")
.Col = 7: .Text = rsTemp.Fields("TelNumber")
.Col = 8: .Text = rsTemp.Fields("Email")
.Col = 9: .Text = rsTemp.Fields("BlackListed")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click()

If blnPrint Then Exit Sub
blnPrint = True

MsgBar "Generating Trainer Black listed Report. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Trainer Black listed Report'"
.WindowTitle = "Trainer Black listed Report"
.SelectionFormula = "{Trainers.BlackListed} = '1'"
.ReportFileName = g_DirectoryReports & "R_BlklistTrainer.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

InitGrid
Load_TrainerToGrid
 DoEvents

End Sub

Private Sub MSFlexGrid1_DblClick()

Dim cmdTemp As ADODB.Command
Dim erTemp As ADODB.Error
Dim i As Integer, nTmpRow As Integer

On Error GoTo ErrorHandler

With MSFlexGrid1
nTmpRow = .Col
If (.Row = (.Rows - 1)) Then
Exit Sub
End If
If (nTmpRow = 0) Then
If Trim(.TextArray(.Row * .Cols + COL_ARCHIVE)) = NO Then
.TextArray(.Row * .Cols + COL_ARCHIVE) = 1
.Col = nTmpRow: Set .CellPicture = imgSelected.Picture
Else
.TextArray(.Row * .Cols + COL_ARCHIVE) = 0
.Col = nTmpRow: Set .CellPicture = LoadPicture
End If
.CellPictureAlignment = flexAlignCenterCenter
Set cmdTemp = New ADODB.Command
cmdTemp.ActiveConnection = cnnServer
cmdTemp.CommandText = "spBlkListTrainer"
cmdTemp.CommandType = adCmdStoredProc
cmdTemp.Parameters.Append cmdTemp.CreateParameter("strOperation", adChar, adParamInput, 1, BTN_EDIT)
cmdTemp.Parameters.Append cmdTemp.CreateParameter("strTrainerCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(.TextArray(.Row * .Cols + 1)))
cmdTemp.Parameters.Append cmdTemp.CreateParameter("strBlackListed", adChar, adParamInput, 1, Trim(.TextArray(.Row
* .Cols + COL_ARCHIVE)))
cmdTemp.Execute
End If
End With

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing

End Sub

EVALUATION SUMMARY

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim m_strTrainingCode As String

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

 With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchTrainingCourses"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strTrainingName", adVarChar, adParamInput, 50, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitTrainingCourseGrid()

Dim intCtr As Integer
With flgTrainingCourses
.FormatString = "<Training Name|^Training Code|^Course Code|<Course Name|^Trainee Code|<Trainee
Name|^From|^To|^Time|<Days"
.Rows = 2
.Cols = 10
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionByRow
.ColWidth(0) = 4005
.ColWidth(1) = 1215
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.ColWidth(4) = 1215
.ColWidth(5) = 4005
.ColWidth(6) = 1100
.ColWidth(7) = 1100
.ColWidth(8) = 1620
.ColWidth(9) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadTrainingCourseGrid()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(vbNullString, vbNullString)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgTrainingCourses
intlastrow = 1

With flgTrainingCourses
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 0
.Text = MSG_NORECORD
End If
 Do While Not rsTemp.EOF
AddGridRow flgTrainingCourses, intlastrow
.Col = 0: .Text = rsTemp.Fields("TrainingName")
.Col = 1: .Text = rsTemp.Fields("TrainingCode")
.Col = 2: .Text = rsTemp.Fields("CourseCode")
.Col = 3: .Text = rsTemp.Fields("CourseName")
.Col = 4: .Text = rsTemp.Fields("TrainerCode")
.Col = 5: .Text = rsTemp.Fields("LastName") & ", " & rsTemp.Fields("FirstName")
.Col = 6: .Text = rsTemp.Fields("ScheduleFrom")
.Col = 7: .Text = rsTemp.Fields("ScheduleTo")
.Col = 8: .Text = rsTemp.Fields("ScheduleTime")
.Col = 9: .Text = rsTemp.Fields("ScheduleDays")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
MsgBar vbNullString
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing

End Sub

Private Sub cmdCancel_Click()

m_intOperation = BTN_FIND
LoadSummary
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdSave_Click()

'validate entries
If Trim(txtSummary.Text) = vbNullString Then
MsgBar "Evaluation Summary must not be blank. Please fill-in the field."
txtSummary.SetFocus
Exit Sub
End If
If Trim(txtRecommendation.Text) = vbNullString Then
MsgBar "Recommendation by must not be blank. Please fill-in the field."
txtRecommendation.SetFocus
Exit Sub
End If
If Trim(txtGradeResults.Text) = vbNullString Then
MsgBar "Grade Results must not be blank. Please fill-in the field."
txtGradeResults.SetFocus
Exit Sub
End If

m_intOperation = BTN_EDIT

'save and load data to grid

Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

 Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spEvaluationSummaryOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strSummary", adVarChar, adParamInput, 3000, Trim(txtSummary.Text))
.Parameters.Append .CreateParameter("strRecommendation", adVarChar, adParamInput, 3000, Trim(txtRecommendation.Text))
.Parameters.Append .CreateParameter("strGradeResults", adVarChar, adParamInput, 500, Trim(txtGradeResults.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."

If rsTemp.EOF Then
txtSummary.Text = MSG_NORECORD
txtRecommendation.Text = vbNullString
End If
txtSummary.Text = rsTemp.Fields("Summary")
txtRecommendation.Text = rsTemp.Fields("Recommendation")
txtGradeResults.Text = rsTemp.Fields("GradeResults")
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub flgTrainingCourses_Click()

m_strTrainingCode = Trim(flgTrainingCourses.TextArray(flgTrainingCourses.Row * flgTrainingCourses.Cols + 1))
LoadSummary

End Sub

Private Sub flgTrainingCourses_SelChange()

flgTrainingCourses_Click

End Sub

Private Sub Form_Load()

InitTrainingCourseGrid
LoadTrainingCourseGrid
m_intOperation = BTN_FIND
LoadSummary
flgTrainingCourses_Click
DoEvents

End Sub

Private Sub txtRecommendation_DblClick()

SelectCtl txtRecommendation

End Sub

Private Sub txtSummary_DblClick()

SelectCtl txtSummary

End Sub

Private Sub LoadSummary()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
 Dim erTemp As ADODB.Error

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spEvaluationSummaryOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strSummary", adVarChar, adParamInput, 3000, Trim(txtSummary.Text))
.Parameters.Append .CreateParameter("strRecommendation", adVarChar, adParamInput, 3000, Trim(txtRecommendation.Text))
.Parameters.Append .CreateParameter("strGradeResults", adVarChar, adParamInput, 500, Trim(txtGradeResults.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."

If rsTemp.EOF Then
txtSummary.Text = vbNullString
txtRecommendation.Text = vbNullString
txtGradeResults.Text = vbNullString
Else
txtSummary.Text = rsTemp.Fields("Summary")
txtRecommendation.Text = rsTemp.Fields("Recommendation")
txtGradeResults.Text = rsTemp.Fields("GradeResults")
End If
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

GRADING

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean
Dim m_strTrainingCode As String

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
flgTrainingCourses.Enabled = blnVal
flgGrading.Enabled = blnVal

End Sub
Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint

End Sub

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchTrainingCourses"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strTrainingName", adVarChar, adParamInput, 50, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitTrainingCourseGrid()

Dim intCtr As Integer
With flgTrainingCourses
.FormatString = "<Training Name|^Training Code|^Course Code|<Course Name|^Trainee Code|<Trainee
Name|^From|^To|^Time|<Days"
.Rows = 2
.Cols = 10
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionByRow
.ColWidth(0) = 4005
.ColWidth(1) = 1215
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.ColWidth(4) = 1215
.ColWidth(5) = 4005
.ColWidth(6) = 1100
.ColWidth(7) = 1100
.ColWidth(8) = 1620
.ColWidth(9) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadTrainingCourseGrid()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
 Set rsTemp = CreateRecordSet(vbNullString, vbNullString)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgTrainingCourses
intlastrow = 1

With flgTrainingCourses
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 0
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgTrainingCourses, intlastrow
.Col = 0: .Text = rsTemp.Fields("TrainingName")
.Col = 1: .Text = rsTemp.Fields("TrainingCode")
.Col = 2: .Text = rsTemp.Fields("CourseCode")
.Col = 3: .Text = rsTemp.Fields("CourseName")
.Col = 4: .Text = rsTemp.Fields("TrainerCode")
.Col = 5: .Text = rsTemp.Fields("LastName") & ", " & rsTemp.Fields("FirstName")
.Col = 6: .Text = rsTemp.Fields("ScheduleFrom")
.Col = 7: .Text = rsTemp.Fields("ScheduleTo")
.Col = 8: .Text = rsTemp.Fields("ScheduleTime")
.Col = 9: .Text = rsTemp.Fields("ScheduleDays")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing

End Sub

Private Sub InitGradeGrid()

Dim intCtr As Integer
With flgGrading
.FormatString = "^Trainee Code|<Trainee Name|^Grade|^Pass?|<Remarks"
.Rows = 2
.Cols = 5
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 1215
.ColWidth(3) = 1215
.ColWidth(4) = 4005
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

 If blnPrint Then Exit Sub
blnPrint = True

MsgBar "Generating Grades Report. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Grades Report'"
.WindowTitle = "Grades Report"
.SelectionFormula = "{Grades.GroupCode} = '" & g_strUserGroup & "' AND {Grades.TrainingCode} = '" & m_strTrainingCode
& "'"
.ReportFileName = g_DirectoryReports & "R_Grades.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT
EnabledClose True
fraGrading.Enabled = False
txtTraineeCode.Locked = False
m_intOperation = BTN_FIND
flgGrading_Click
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

If m_strTrainingCode = vbNullString Then Exit Sub

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraGrading.Enabled = True
EnableOperation m_blnRightsADD, False, False, False
EnabledClose False
ClearAllFields Me
txtTraineeCode.SetFocus
Case BTN_EDIT 'edit/1
If txtTraineeCode <> vbNullString Then
MsgBar MSG_EDIT
fraGrading.Enabled = True
txtTraineeCode.Locked = True
EnableOperation False, m_blnRightsEDIT, False, False
EnabledClose False
txtGrade.SetFocus
Else
MsgBar "No selected record! Select record from list."
m_intOperation = BTN_FIND
End If
Case BTN_DELETE 'delete/2
Dim strMsg As String
 MsgBar MSG_DELETE
With flgGrading
strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & vbLf & _
"Do you want to delete this record?"
End With
If txtTraineeCode <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
End Select

End Sub

Private Sub cmdSave_Click()

'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtTraineeCode.Text) = vbNullString Then
MsgBar "Trainee must not be blank. Please fill-in the field."
txtTraineeCode.SetFocus
Exit Sub
End If
If Val(txtGrade.Text) > 100 Or Val(txtGrade.Text) < 50 Then
MsgBar "Grades must be between 50 and 100. Please fill-in the field."
txtGrade.SetFocus
Exit Sub
End If
End If

'save and load data to grid

Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGradeOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTraineeCode.Text))
.Parameters.Append .CreateParameter("monGrade", adCurrency, adParamInput, 8, Val(txtGrade.Text))
.Parameters.Append .CreateParameter("strPass", adVarChar, adParamInput, 10, Trim(cboPassFail.Text))
.Parameters.Append .CreateParameter("strRemarks", adVarChar, adParamInput, 50, Trim(txtRemarks.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgGrading
intlastrow = 1

With flgGrading
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
 If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgGrading, intlastrow
.Col = 0: .Text = rsTemp.Fields("TraineeCode")
.Col = 1: .Text = rsTemp.Fields("TraineeLName") & ", " & rsTemp.Fields("TraineeFName")
.Col = 2: .Text = Format(rsTemp.Fields("Grade"), AMOUNT_FORMAT)
.Col = 3: .Text = rsTemp.Fields("Pass")
.Col = 4: .Text = rsTemp.Fields("Remarks")
If txtTraineeCode.Text = rsTemp.Fields("TraineeCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub flgGrading_Click()

With flgGrading
txtTraineeCode.Text = Trim(.TextArray(.Row * .Cols + 0))
lblTraineeName.Caption = Trim(.TextArray(.Row * .Cols + 1))
txtGrade.Text = Trim(.TextArray(.Row * .Cols + 2))
SetCurrentItem cboPassFail, Trim(.TextArray(.Row * .Cols + 3))
txtRemarks.Text = Trim(.TextArray(.Row * .Cols + 4))
If m_intOperation = BTN_EDIT Then
SelectCtl txtTraineeCode
End If
End With
MsgBar vbNullString

End Sub

Private Sub flgGrading_SelChange()

flgGrading_Click

End Sub

Private Sub flgTrainingCourses_Click()

m_strTrainingCode = Trim(flgTrainingCourses.TextArray(flgTrainingCourses.Row * flgTrainingCourses.Cols + 1))
cmdSave_Click

End Sub

Private Sub flgTrainingCourses_SelChange()

flgTrainingCourses_Click

End Sub

Private Sub Form_Load()

InitTrainingCourseGrid
LoadTrainingCourseGrid
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT
EnabledClose True
fraGrading.Enabled = False
 m_intOperation = BTN_FIND
GetPassFailItem cboPassFail
InitGradeGrid
flgTrainingCourses_Click
cmdSave_Click
flgGrading_Click
DoEvents

End Sub

Private Sub txtGrade_GotFocus()

txtGrade.Text = RemoveComma(txtGrade.Text)
SelectCtl txtGrade

End Sub

Private Sub txtGrade_KeyPress(KeyAscii As Integer)

KeyAscii = CheckNumeric(KeyAscii, txtGrade)

End Sub

Private Sub txtGrade_LostFocus()

txtGrade.Text = Format(txtGrade.Text, AMOUNT_FORMAT)
If Val(txtGrade.Text) >= PASS_GRADE Then
SetCurrentItem cboPassFail, strYES
Else
SetCurrentItem cboPassFail, strNO
End If
End Sub

Private Sub txtRemarks_GotFocus()

SelectCtl txtRemarks

End Sub

'Pop-up Trainees
Private Sub txtTraineeCode_GotFocus()
SelectCtl txtTraineeCode

End Sub

Private Sub txtTraineeCode_LostFocus()

CheckTraineesField

End Sub

Private Sub txtTraineeCode_Validate(Cancel As Boolean)

Cancel = FilteredTraineeSearch(Me, m_strTrainingCode, txtTraineeCode.Text)

End Sub

Private Sub cmdTrainee_Click()

FilteredTraineeSearch Me, m_strTrainingCode, vbNullString, True
CheckTraineesField

End Sub

Private Sub CheckTraineesField()

If Trainees_Search(1).TraineeCode <> vbNullString Then
txtTraineeCode.Text = Trainees_Search(1).TraineeCode
lblTraineeName.Caption = Trainees_Search(1).TraineeName
End If

End Sub
'End of Pop-up Trainee

PRIVATE EVALUATION

Option Explicit
Private Const DESC_COL = 0
Private Const GRADE5_COL = 1
Private Const GRADE4_COL = 2
Private Const GRADE3_COL = 3
Private Const GRADE2_COL = 4
Private Const GRADE1_COL = 5
Private m_strOperation As String
Private m_strTrainingCode As String
Private m_strTraineeCode As String
Private m_strTraineeName As String
Private m_strSPOTM As String
Private m_strWPOTM As String
Private m_strADYWLTHCIM As String
Private m_strWTAUM As String

Public Property Let getParameters(ByVal NewVal As String)

m_strOperation = Mid(NewVal, 1, 1)
m_strTrainingCode = Mid(NewVal, 2, 6)
m_strTraineeCode = Mid(NewVal, 8, 6)
m_strTraineeName = Mid(NewVal, 14)

End Property

Public Property Let getSPOTM(ByVal NewVal As String)

m_strSPOTM = NewVal

End Property

Public Property Let getWPOTM(ByVal NewVal As String)

m_strWPOTM = NewVal

End Property

Public Property Let getADYWLTHCIM(ByVal NewVal As String)

m_strADYWLTHCIM = NewVal

End Property

Public Property Let getWTAUM(ByVal NewVal As String)

m_strWTAUM = NewVal

End Property

Private Sub cmdCancel_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub InitSkillLevelGrid()

Dim intCtr As Integer
With flgSkillLevel
.FormatString = "<Knowledge and Skill Level|^5|^4|^3|^ 2|^1"
.Rows = 2
.Cols = 6
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 4800
.ColWidth(1) = 750
.ColWidth(2) = 750
.ColWidth(3) = 750
.ColWidth(4) = 750
.ColWidth(5) = 750
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
 .Row = 1
.Col = 0
End With

End Sub

Private Sub LoadSkillLevelGrid()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer, nTmpRow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetTemplates"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, TEMPLATE_SKILL)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN, m_strTraineeCode)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgSkillLevel
intlastrow = 1

With flgSkillLevel
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 0
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgSkillLevel, intlastrow
.Col = 0: .Text = rsTemp.Fields("Description")
If m_strTraineeCode <> vbNullString Then
nTmpRow = rsTemp.Fields("Grade")
End If
If nTmpRow = 5 Then
.Col = 1: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 4 Then
.Col = 2: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 3 Then
.Col = 3: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 2 Then
.Col = 4: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 1 Then
.Col = 5: Set .CellPicture = imgSelected.Picture
End If
.CellPictureAlignment = flexAlignCenterCenter
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Function SaveSkillLevelToArray() As Boolean

Dim intCtr As Integer, intCol As Integer
Dim intGrade As Integer, intItemCtr As Integer

On Error GoTo ErrorHandler

With flgSkillLevel
ReDim PvtEvaluation_Table(.Rows)
intItemCtr = 0
For intCtr = 1 To .Rows - 1
.Row = intCtr
If Trim(.TextArray(intCtr * .Cols + DESC_COL)) <> vbNullString Then
intItemCtr = intItemCtr + 1
intGrade = 0
For intCol = 1 To 5
.Col = intCol
If .CellPicture <> 0 Then
If intCol = 1 Then
intGrade = 5
ElseIf intCol = 2 Then
intGrade = 4
ElseIf intCol = 3 Then
intGrade = 3
ElseIf intCol = 4 Then
intGrade = 2
ElseIf intCol = 5 Then
intGrade = 1
End If
Exit For
End If
Next intCol
PvtEvaluation_Table(intItemCtr).TrainingCode = m_strTrainingCode
PvtEvaluation_Table(intItemCtr).TraineeCode = txtTraineeCode.Text
PvtEvaluation_Table(intItemCtr).Description = Trim(.TextArray(intCtr * .Cols + DESC_COL))
PvtEvaluation_Table(intItemCtr).Grade = intGrade
End If
Next intCtr
End With
ReDim Preserve PvtEvaluation_Table(intItemCtr)
SaveSkillLevelToArray = True
Exit Function

ErrorHandler:
SaveSkillLevelToArray = False
ReDim PvtEvaluation_Table(1)

End Function

Private Sub InitEvaluationGrid()

Dim intCtr As Integer
With flgEvaluation
.FormatString = "<Item of Evaluation|^5|^4|^3|^ 2|^1"
.Rows = 2
.Cols = 6
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 4800
.ColWidth(1) = 750
.ColWidth(2) = 750
.ColWidth(3) = 750
.ColWidth(4) = 750
 .ColWidth(5) = 750
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadEvaluationGrid()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer, nTmpRow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetTemplates"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, TEMPLATE_ITEM)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN, m_strTraineeCode)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgEvaluation
intlastrow = 1

With flgEvaluation
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 0
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgEvaluation, intlastrow
.Col = 0: .Text = rsTemp.Fields("Description")
If m_strTraineeCode <> vbNullString Then
nTmpRow = rsTemp.Fields("Grade")
End If
If nTmpRow = 5 Then
.Col = 1: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 4 Then
.Col = 2: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 3 Then
.Col = 3: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 2 Then
.Col = 4: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 1 Then
.Col = 5: Set .CellPicture = imgSelected.Picture
End If
.CellPictureAlignment = flexAlignCenterCenter
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
 .TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Function SaveEvaluationToArray() As Boolean

Dim intCtr As Integer, intCol As Integer
Dim intGrade As Integer, intItemCtr As Integer

On Error GoTo ErrorHandler

With flgEvaluation
ReDim PvtEvaluation_Table(.Rows)
intItemCtr = 0
For intCtr = 1 To .Rows - 1
.Row = intCtr
If Trim(.TextArray(intCtr * .Cols + DESC_COL)) <> vbNullString Then
intItemCtr = intItemCtr + 1
intGrade = 0
For intCol = 1 To 5
.Col = intCol
If .CellPicture <> 0 Then
If intCol = 1 Then
intGrade = 5
ElseIf intCol = 2 Then
intGrade = 4
ElseIf intCol = 3 Then
intGrade = 3
ElseIf intCol = 4 Then
intGrade = 2
ElseIf intCol = 5 Then
intGrade = 1
End If
Exit For
End If
Next intCol
PvtEvaluation_Table(intItemCtr).TrainingCode = m_strTrainingCode
PvtEvaluation_Table(intItemCtr).TraineeCode = txtTraineeCode.Text
PvtEvaluation_Table(intItemCtr).Description = Trim(.TextArray(intCtr * .Cols + DESC_COL))
PvtEvaluation_Table(intItemCtr).Grade = intGrade
End If
Next intCtr
End With
ReDim Preserve PvtEvaluation_Table(intItemCtr)
SaveEvaluationToArray = True
Exit Function

ErrorHandler:
SaveEvaluationToArray = False
ReDim PvtEvaluation_Table(1)

End Function

Private Sub InitRateInstructorGrid()

Dim intCtr As Integer
With flgRateInstructor
.FormatString = "<Rating of Instructor|^5|^4|^3|^ 2|^1"
.Rows = 2
.Cols = 6
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
 .SelectionMode = flexSelectionFree
.ColWidth(0) = 4800
.ColWidth(1) = 750
.ColWidth(2) = 750
.ColWidth(3) = 750
.ColWidth(4) = 750
.ColWidth(5) = 750
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadRateInstructorGrid()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer, nTmpRow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetTemplates"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, TEMPLATE_RATING)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN, m_strTraineeCode)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgRateInstructor
intlastrow = 1

With flgRateInstructor
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 0
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgRateInstructor, intlastrow
.Col = 0: .Text = rsTemp.Fields("Description")
If m_strTraineeCode <> vbNullString Then
nTmpRow = rsTemp.Fields("Grade")
End If
If nTmpRow = 5 Then
.Col = 1: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 4 Then
.Col = 2: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 3 Then
.Col = 3: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 2 Then
.Col = 4: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 1 Then
.Col = 5: Set .CellPicture = imgSelected.Picture
 End If
.CellPictureAlignment = flexAlignCenterCenter
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Function SaveRateInstructorToArray() As Boolean

Dim intCtr As Integer, intCol As Integer
Dim intGrade As Integer, intItemCtr As Integer

On Error GoTo ErrorHandler

With flgRateInstructor
ReDim PvtEvaluation_Table(.Rows)
intItemCtr = 0
For intCtr = 1 To .Rows - 1
.Row = intCtr
If Trim(.TextArray(intCtr * .Cols + DESC_COL)) <> vbNullString Then
intItemCtr = intItemCtr + 1
intGrade = 0
For intCol = 1 To 5
.Col = intCol
If .CellPicture <> 0 Then
If intCol = 1 Then
intGrade = 5
ElseIf intCol = 2 Then
intGrade = 4
ElseIf intCol = 3 Then
intGrade = 3
ElseIf intCol = 4 Then
intGrade = 2
ElseIf intCol = 5 Then
intGrade = 1
End If
Exit For
End If
Next intCol
PvtEvaluation_Table(intItemCtr).TrainingCode = m_strTrainingCode
PvtEvaluation_Table(intItemCtr).TraineeCode = txtTraineeCode.Text
PvtEvaluation_Table(intItemCtr).Description = Trim(.TextArray(intCtr * .Cols + DESC_COL))
PvtEvaluation_Table(intItemCtr).Grade = intGrade
End If
Next intCtr
End With
ReDim Preserve PvtEvaluation_Table(intItemCtr)
SaveRateInstructorToArray = True
Exit Function

ErrorHandler:
SaveRateInstructorToArray = False
ReDim PvtEvaluation_Table(1)

End Function

Private Sub SaveArrayToTable(strTemplate As String)

Dim intCtr As Integer, intCtr2 As Integer
Dim cmdTemp As ADODB.Command
 On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandTimeout = 0
.CommandType = adCmdStoredProc
.CommandText = "spSaveTemplates"
.Prepared = True
For intCtr = 1 To UBound(PvtEvaluation_Table)
.Parameters.Append .CreateParameter("intRetval", adInteger, adParamReturnValue, 4)
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, strTemplate)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN,
m_strTrainingCode)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN,
txtTraineeCode.Text)
.Parameters.Append .CreateParameter("strDescription", adVarChar, adParamInput, 50,
Trim(PvtEvaluation_Table(intCtr).Description))
.Parameters.Append .CreateParameter("intGrade", adSmallInt, adParamInput, , Trim(PvtEvaluation_Table(intCtr).Grade))
.Parameters.Append .CreateParameter("strComments", adChar, adParamInput, 50, vbNullString)
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
.Execute , , adExecuteNoRecords
If .Parameters("intRetval") <> 0 Then
GoTo ErrorHandler
Else
For intCtr2 = .Parameters.Count - 1 To 0 Step -1
.Parameters.Delete intCtr2
Next intCtr2
End If
Next intCtr
End With

Set cmdTemp = Nothing 'then reset

Exit Sub

ErrorHandler:
Set cmdTemp = Nothing 'then reset

End Sub

Private Sub cmdSave_Click()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

If Trim(txtTraineeCode.Text) = vbNullString Then

MsgBar "Trainee must not be blank. Please fill-in the field."
txtTraineeCode.SetFocus
Exit Sub
End If

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spPrivateEvaluationOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("intRetval", adInteger, adParamReturnValue, 4)
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, m_strOperation)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN, txtTraineeCode.Text)
.Parameters.Append .CreateParameter("strSPOTM", adVarChar, adParamInput, 500, Trim(txtSPOTM.Text))
.Parameters.Append .CreateParameter("strWPOTM", adVarChar, adParamInput, 500, Trim(txtWPOTM.Text))
.Parameters.Append .CreateParameter("strADYWLTHCIM", adVarChar, adParamInput, 500, Trim(txtADYWLTHCIM.Text))
 .Parameters.Append .CreateParameter("strWTAUM", adVarChar, adParamInput, 500, Trim(txtWTAUM.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
.Execute , , adExecuteNoRecords
If .Parameters("intRetval") <> 0 Then
If SaveSkillLevelToArray Then
SaveArrayToTable TEMPLATE_SKILL
Else
GoTo ErrorHandler
End If
If SaveEvaluationToArray Then
SaveArrayToTable TEMPLATE_ITEM
Else
GoTo ErrorHandler
End If
If SaveRateInstructorToArray Then
SaveArrayToTable TEMPLATE_RATING
Else
GoTo ErrorHandler
End If
End If
End With
cmdCancel_Click

ErrorHandler:
ErrorDisplay erTemp
Set cmdTemp = Nothing

End Sub

Private Sub flgEvaluation_DblClick()

Dim i As Integer, nTmpRow As Integer
With flgEvaluation
nTmpRow = .Col
If (.Row = (.Rows - 1)) Then
Exit Sub
End If
If (nTmpRow >= 1 And nTmpRow <= 5) Then
For i = 1 To 5
.Col = i: Set .CellPicture = LoadPicture
Next
.Col = nTmpRow: Set .CellPicture = imgSelected.Picture
.CellPictureAlignment = flexAlignCenterCenter
End If
End With

End Sub

Private Sub flgEvaluation_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)

flgEvaluation.ToolTipText = MSG_RATING
End Sub

Private Sub flgRateInstructor_DblClick()

Dim i As Integer, nTmpRow As Integer
With flgRateInstructor
nTmpRow = .Col
If (.Row = (.Rows - 1)) Then
Exit Sub
End If
If (nTmpRow >= 1 And nTmpRow <= 5) Then
For i = 1 To 5
.Col = i: Set .CellPicture = LoadPicture
Next
.Col = nTmpRow: Set .CellPicture = imgSelected.Picture
.CellPictureAlignment = flexAlignCenterCenter
End If
End With

End Sub
Private Sub flgRateInstructor_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
flgRateInstructor.ToolTipText = MSG_RATING
End Sub

Private Sub flgSkillLevel_DblClick()

Dim i As Integer, nTmpRow As Integer
With flgSkillLevel
nTmpRow = .Col
If (.Row = (.Rows - 1)) Then
Exit Sub
End If
If (nTmpRow >= 1 And nTmpRow <= 5) Then
For i = 1 To 5
.Col = i: Set .CellPicture = LoadPicture
Next
.Col = nTmpRow: Set .CellPicture = imgSelected.Picture
.CellPictureAlignment = flexAlignCenterCenter
End If
End With

End Sub

Private Sub flgSkillLevel_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)

flgSkillLevel.ToolTipText = MSG_RATING

End Sub

Private Sub Form_Activate()

If Val(m_strOperation) = BTN_EDIT Then
txtTraineeCode.Text = m_strTraineeCode
lblTraineeName.Caption = m_strTraineeName
txtSPOTM.Text = m_strSPOTM
txtWPOTM.Text = m_strWPOTM
txtADYWLTHCIM.Text = m_strADYWLTHCIM
txtWTAUM.Text = m_strWTAUM
End If

End Sub

Private Sub Form_Load()

Me.Top = FormSet.FormTop
Me.Left = FormSet.FormLeft
Me.Height = FormSet.FormHeight
Me.Width = FormSet.FormWidth
InitSkillLevelGrid
LoadSkillLevelGrid
InitEvaluationGrid
LoadEvaluationGrid
InitRateInstructorGrid
LoadRateInstructorGrid
fraTrainee.Enabled = Val(m_strOperation) = BTN_ADD

End Sub

'Pop-up Trainees
Private Sub txtTraineeCode_GotFocus()
SelectCtl txtTraineeCode

End Sub

Private Sub txtTraineeCode_LostFocus()

CheckTraineesField

End Sub

Private Sub txtTraineeCode_Validate(Cancel As Boolean)

Cancel = FilteredTraineeSearch(Me, m_strTrainingCode, txtTraineeCode.Text)

End Sub
Private Sub cmdTrainee_Click()
FilteredTraineeSearch Me, m_strTrainingCode, vbNullString, True
CheckTraineesField

End Sub

Private Sub CheckTraineesField()

If Trainees_Search(1).TraineeCode <> vbNullString Then
txtTraineeCode.Text = Trainees_Search(1).TraineeCode
lblTraineeName.Caption = Trainees_Search(1).TraineeName
End If

End Sub
'End of Pop-up Trainee

PRIVATE EVALUATION LIST

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean
Dim m_strTrainingCode As String

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdClose.Enabled = blnVal
flgTrainingCourses.Enabled = blnVal
flgTrainee.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint

End Sub

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchTrainingCourses"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strTrainingName", adVarChar, adParamInput, 50, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing
End Function

Private Sub InitTrainingCourseGrid()

Dim intCtr As Integer
With flgTrainingCourses
.FormatString = "<Training Name|^Training Code|^Course Code|<Course Name|^Trainee Code|<Trainee
Name|^From|^To|^Time|<Days"
.Rows = 2
.Cols = 10
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionByRow
.ColWidth(0) = 4005
.ColWidth(1) = 1215
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.ColWidth(4) = 1215
.ColWidth(5) = 4005
.ColWidth(6) = 1100
.ColWidth(7) = 1100
.ColWidth(8) = 1620
.ColWidth(9) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadTrainingCourseGrid()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(vbNullString, vbNullString)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgTrainingCourses
intlastrow = 1

With flgTrainingCourses
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 0
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgTrainingCourses, intlastrow
.Col = 0: .Text = rsTemp.Fields("TrainingName")
.Col = 1: .Text = rsTemp.Fields("TrainingCode")
.Col = 2: .Text = rsTemp.Fields("CourseCode")
.Col = 3: .Text = rsTemp.Fields("CourseName")
.Col = 4: .Text = rsTemp.Fields("TrainerCode")
.Col = 5: .Text = rsTemp.Fields("LastName") & ", " & rsTemp.Fields("FirstName")
.Col = 6: .Text = rsTemp.Fields("ScheduleFrom")
.Col = 7: .Text = rsTemp.Fields("ScheduleTo")
.Col = 8: .Text = rsTemp.Fields("ScheduleTime")
.Col = 9: .Text = rsTemp.Fields("ScheduleDays")
intlastrow = intlastrow + 1
rsTemp.MoveNext
 Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing

End Sub

Private Sub InitTraineeGrid()

Dim intCtr As Integer
With flgTrainee
.FormatString = "^Trainee Code|<Trainee Name|<Strong Points Of The Module|<Weak Points Of The Module|< Additional Data
You Would Like To Have Covered In Module|<Was There Any Unnecessary Materials?"
.Rows = 2
.Cols = 6
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = .Width
.ColWidth(3) = .Width
.ColWidth(4) = .Width
.ColWidth(5) = .Width
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadTraineeGrid()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spPrivateEvaluationOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN,
flgTrainee.TextArray(flgTrainee.Row * flgTrainee.Cols + 0))
.Parameters.Append .CreateParameter("strSPOTM", adVarChar, adParamInput, 500, vbNullString)
.Parameters.Append .CreateParameter("strWPOTM", adVarChar, adParamInput, 500, vbNullString)
.Parameters.Append .CreateParameter("strADYWLTHCIM", adVarChar, adParamInput, 500, vbNullString)
.Parameters.Append .CreateParameter("strWTAUM", adVarChar, adParamInput, 500, vbNullString)
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
 End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgTrainee
intlastrow = 1

With flgTrainee
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgTrainee, intlastrow
.Col = 0: .Text = rsTemp.Fields("TraineeCode")
.Col = 1: .Text = rsTemp.Fields("LastName") & ", " & rsTemp.Fields("FirstName")
.Col = 2: .Text = rsTemp.Fields("SPOTM")
.Col = 3: .Text = rsTemp.Fields("WPOTM")
.Col = 4: .Text = rsTemp.Fields("ADYWLTHCIM")
.Col = 5: .Text = rsTemp.Fields("WTAUM")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
MsgBar vbNullString
m_intOperation = BTN_FIND

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub PrintReport()

Dim str As String

If blnPrint Then Exit Sub

blnPrint = True

MsgBar "Generating {Private} Evaluation Form. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.WindowTitle = "{Private} Evaluation Form"
.SelectionFormula = "{vwD_Registration.GroupCode} = '" & g_strUserGroup & "' AND {vwD_Registration.TrainingCode} = '"
& m_strTrainingCode & "'"
.ReportFileName = g_DirectoryReports & "R_PvtEvaluationWData.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub
Private Sub cmdClose_Click()
MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

If m_strTrainingCode = vbNullString Then Exit Sub

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
frmD_PrivateEvaluation.getParameters = Trim(str(m_intOperation)) + m_strTrainingCode
frmD_PrivateEvaluation.Show vbModal
m_intOperation = BTN_FIND
LoadTraineeGrid
Case BTN_EDIT 'edit/1
With flgTrainee
If .TextArray(.Row * .Cols + 0) <> vbNullString Then
MsgBar MSG_EDIT
frmD_PrivateEvaluation.getParameters = Trim(str(m_intOperation)) + m_strTrainingCode + .TextArray(.Row * .Cols +
0) + .TextArray(.Row * .Cols + 1)
frmD_PrivateEvaluation.getSPOTM = .TextArray(.Row * .Cols + 2)
frmD_PrivateEvaluation.getWPOTM = .TextArray(.Row * .Cols + 3)
frmD_PrivateEvaluation.getADYWLTHCIM = .TextArray(.Row * .Cols + 4)
frmD_PrivateEvaluation.getWTAUM = .TextArray(.Row * .Cols + 5)
frmD_PrivateEvaluation.Show vbModal
m_intOperation = BTN_FIND
LoadTraineeGrid
Else
MsgBar "No selected record! Select record from list."
m_intOperation = BTN_FIND
End If
End With
Case BTN_DELETE 'delete/2
Dim strMsg As String
MsgBar MSG_DELETE
With flgTrainee
strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & vbLf & _
"Do you want to delete this record?"
End With
If flgTrainee.TextArray(flgTrainee.Row * flgTrainee.Cols + 0) <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
LoadTraineeGrid
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
m_intOperation = BTN_FIND
End Select

End Sub

Private Sub flgTrainingCourses_Click()

m_strTrainingCode = Trim(flgTrainingCourses.TextArray(flgTrainingCourses.Row * flgTrainingCourses.Cols + 1))
LoadTraineeGrid

End Sub

Private Sub flgTrainingCourses_SelChange()

flgTrainingCourses_Click

End Sub

Private Sub Form_Load()

 InitTrainingCourseGrid
LoadTrainingCourseGrid
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT
EnabledClose True
m_intOperation = BTN_FIND
InitTraineeGrid
flgTrainingCourses_Click
LoadTraineeGrid
DoEvents

End Sub

REGISTRATION

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean
Dim m_strTrainingCode As String
Dim m_strCourseCode As String

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
flgTrainingCourses.Enabled = blnVal
flgRegistration.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint

End Sub

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchTrainingCourses"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strTrainingName", adVarChar, adParamInput, 50, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function
Private Sub InitTrainingCourseGrid()
Dim intCtr As Integer
With flgTrainingCourses
.FormatString = "<Training Name|^Training Code|^Course Code|<Course Name|^Trainee Code|<Trainee
Name|^From|^To|^Time|<Days"
.Rows = 2
.Cols = 10
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionByRow
.ColWidth(0) = 4005
.ColWidth(1) = 1215
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.ColWidth(4) = 1215
.ColWidth(5) = 4005
.ColWidth(6) = 1100
.ColWidth(7) = 1100
.ColWidth(8) = 1620
.ColWidth(9) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadTrainingCourseGrid()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(vbNullString, vbNullString)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgTrainingCourses
intlastrow = 1

With flgTrainingCourses
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 0
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgTrainingCourses, intlastrow
.Col = 0: .Text = rsTemp.Fields("TrainingName")
.Col = 1: .Text = rsTemp.Fields("TrainingCode")
.Col = 2: .Text = rsTemp.Fields("CourseCode")
.Col = 3: .Text = rsTemp.Fields("CourseName")
.Col = 4: .Text = rsTemp.Fields("TrainerCode")
.Col = 5: .Text = rsTemp.Fields("LastName") & ", " & rsTemp.Fields("FirstName")
.Col = 6: .Text = rsTemp.Fields("ScheduleFrom")
.Col = 7: .Text = rsTemp.Fields("ScheduleTo")
.Col = 8: .Text = rsTemp.Fields("ScheduleTime")
.Col = 9: .Text = rsTemp.Fields("ScheduleDays")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
 .Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing

End Sub

Private Sub InitRegistrationGrid()

Dim intCtr As Integer
With flgRegistration
.FormatString = "^Trainee Code|<Trainee Name|^Date Entrolled|^Enrolled by|<Dean/COO Name"
.Rows = 2
.Cols = 7
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 1305
.ColWidth(3) = 1215
.ColWidth(4) = 4005
.ColWidth(5) = 0
.ColWidth(6) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

Dim str As String

If blnPrint Then Exit Sub

blnPrint = True

MsgBar "Generating Registration Reports. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Registration Reports'"
.WindowTitle = "Registration Reports"
.SelectionFormula = "{vwD_Registration.GroupCode} = '" & g_strUserGroup & "' AND {vwD_Registration.TrainingCode} = '"
& m_strTrainingCode & "'"
.ReportFileName = g_DirectoryReports & "R_Registration.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False
cmdCancel_Click
End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT
EnabledClose True
fraRegistration.Enabled = False
m_intOperation = BTN_FIND
flgRegistration_Click
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

If m_strTrainingCode = vbNullString Then Exit Sub

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraRegistration.Enabled = True
EnableOperation m_blnRightsADD, False, False, False
EnabledClose False
ClearAllFields Me
txtTraineeCode.SetFocus
Case BTN_EDIT 'edit/1
If txtTraineeCode <> vbNullString Then
MsgBar MSG_EDIT
fraRegistration.Enabled = True
EnableOperation False, m_blnRightsEDIT, False, False
EnabledClose False
txtTraineeCode.SetFocus
Else
MsgBar "No selected record! Select record from list."
m_intOperation = BTN_FIND
End If
Case BTN_DELETE 'delete/2
Dim strMsg As String
MsgBar MSG_DELETE
With flgRegistration
strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & vbLf & _
"Do you want to delete this record?"
End With
If txtTraineeCode <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
End Select

End Sub

Private Sub cmdSave_Click()

'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtTraineeCode.Text) = vbNullString Then
MsgBar "Trainee must not be blank. Please fill-in the field."
txtTraineeCode.SetFocus
Exit Sub
End If
 If Trim(txtEnrolledBy.Text) = vbNullString Then
MsgBar "Enrolled by must not be blank. Please fill-in the field."
txtEnrolledBy.SetFocus
Exit Sub
End If
End If
'check if trainee is blacklisted or not
If (m_intOperation = BTN_ADD Or m_intOperation = BTN_EDIT) Then
Dim rsBlacklist As ADODB.Recordset
Set rsBlacklist = New ADODB.Recordset
Set rsBlacklist = CheckBlacklisted("E", Trim(txtTraineeCode.Text))
If Not rsBlacklist.EOF Then
MsgBox rsBlacklist.Fields("TraineeCode") & " - " & rsBlacklist.Fields("TraineeName") & " is blacklisted until " &
Format(rsBlacklist.Fields("SanctionDate"), LONGDATE_FORMAT) & Chr(10) & _
"due to " & rsBlacklist.Fields("Reason"), vbCritical
Set rsBlacklist = Nothing
txtTraineeCode.SetFocus
Exit Sub
End If
Set rsBlacklist = Nothing
End If

'save and load data to grid

Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spRegistrationOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strCourseCode", adChar, adParamInput, GENERICCODE_LEN, m_strCourseCode)
.Parameters.Append .CreateParameter("strOldTraineeCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(flgRegistration.TextArray(flgRegistration.Row * flgRegistration.Cols + 0)))
.Parameters.Append .CreateParameter("strOldEnrolledBy", adChar, adParamInput, GENERICCODE_LEN,
Trim(flgRegistration.TextArray(flgRegistration.Row * flgRegistration.Cols + 3)))
.Parameters.Append .CreateParameter("strDateEnrolled", adChar, adParamInput, DATE_LEN, Format(dtpDateEnrolled.value,
DATE_FORMAT))
.Parameters.Append .CreateParameter("strNewTraineeCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTraineeCode.Text))
.Parameters.Append .CreateParameter("strNewEnrolledBy", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtEnrolledBy.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgRegistration
intlastrow = 1

With flgRegistration
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgRegistration, intlastrow
 .Col = 0: .Text = rsTemp.Fields("TraineeCode")
.Col = 1: .Text = rsTemp.Fields("TraineeLName") & ", " & rsTemp.Fields("TraineeFName")
.Col = 2: .Text = Format(rsTemp.Fields("DateEnrolled"), DATE_FORMAT)
.Col = 3: .Text = rsTemp.Fields("EnrolledBy")
.Col = 4: .Text = rsTemp.Fields("DeanCOOLName") & ", " & rsTemp.Fields("DeanCOOFName")
.Col = 5: .Text = rsTemp.Fields("CompanyCode")
.Col = 6: .Text = rsTemp.Fields("CompanyName")
If txtTraineeCode.Text = rsTemp.Fields("TraineeCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub dtpDateEnrolled_Change()

If dtpDateEnrolled.value > g_strCurrentDate Then
dtpDateEnrolled.value = g_strCurrentDate
End If

End Sub

Private Sub flgRegistration_Click()

With flgRegistration
txtTraineeCode.Text = Trim(.TextArray(.Row * .Cols + 0))
lblTraineeName.Caption = Trim(.TextArray(.Row * .Cols + 1))
dtpDateEnrolled.value = CheckDate(Trim(.TextArray(.Row * .Cols + 2)))
txtEnrolledBy.Text = Trim(.TextArray(.Row * .Cols + 3))
lblEnrolledBy.Caption = Trim(.TextArray(.Row * .Cols + 4))
lblGroupCode.Caption = Trim(.TextArray(.Row * .Cols + 5))
lblGroupName.Caption = Trim(.TextArray(.Row * .Cols + 6))
If m_intOperation = BTN_EDIT Then
SelectCtl txtTraineeCode
End If
End With
MsgBar vbNullString

End Sub

Private Sub flgRegistration_SelChange()

flgRegistration_Click

End Sub

Private Sub flgTrainingCourses_Click()

m_strTrainingCode = Trim(flgTrainingCourses.TextArray(flgTrainingCourses.Row * flgTrainingCourses.Cols + 1))
m_strCourseCode = Trim(flgTrainingCourses.TextArray(flgTrainingCourses.Row * flgTrainingCourses.Cols + 2))
cmdSave_Click

End Sub

Private Sub flgTrainingCourses_SelChange()

flgTrainingCourses_Click

End Sub
Private Sub Form_Load()
InitTrainingCourseGrid
LoadTrainingCourseGrid
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT
EnabledClose True
fraRegistration.Enabled = False
m_intOperation = BTN_FIND
InitRegistrationGrid
flgTrainingCourses_Click
cmdSave_Click
flgRegistration_Click
DoEvents

End Sub

'Pop-up Trainees
Private Sub txtTraineeCode_GotFocus()
SelectCtl txtTraineeCode

End Sub

Private Sub txtTraineeCode_LostFocus()

CheckTraineesField

End Sub

Private Sub txtTraineeCode_Validate(Cancel As Boolean)

Cancel = TraineeSearch(Me, txtTraineeCode.Text)

End Sub

Private Sub cmdTrainee_Click()

TraineeSearch Me, vbNullString, True
CheckTraineesField

End Sub

Private Sub CheckTraineesField()

If Trainees_Search(1).TraineeCode <> vbNullString Then
txtTraineeCode.Text = Trainees_Search(1).TraineeCode
lblTraineeName.Caption = Trainees_Search(1).TraineeName
End If

End Sub
'End of Pop-up Trainee

'Pop-up Deans/COO's
Private Sub txtEnrolledBy_GotFocus()
SelectCtl txtEnrolledBy

End Sub

Private Sub txtEnrolledBy_LostFocus()

CheckDeansField

End Sub

Private Sub txtEnrolledBy_Validate(Cancel As Boolean)

Cancel = DeanSearch(Me, txtEnrolledBy.Text)

End Sub

Private Sub cmdEnrolled_Click()

DeanSearch Me, vbNullString, True
CheckDeansField

End Sub

Private Sub CheckDeansField()

If DeanCOO_Search(1).DeanCode <> vbNullString Then
 txtEnrolledBy.Text = DeanCOO_Search(1).DeanCode
lblEnrolledBy.Caption = DeanCOO_Search(1).DeanName
lblGroupCode.Caption = DeanCOO_Search(1).GroupCode
lblGroupName.Caption = DeanCOO_Search(1).GroupName
End If

End Sub
'End of Pop-up Dean/COO's

FORM STI-HQ EVALUATION

Option Explicit
Private Const DESC_COL = 0
Private Const GRADE5_COL = 1
Private Const GRADE4_COL = 2
Private Const GRADE3_COL = 3
Private Const GRADE2_COL = 4
Private Const GRADE1_COL = 5
Private Const COMMENTS_COL = 6
Private m_strOperation As String
Private m_strTrainingCode As String
Private m_strTraineeCode As String
Private m_strTraineeName As String
Private m_strHDTTATE As String
Private m_strACR As String

Public Property Let getParameters(ByVal NewVal As String)

m_strOperation = Mid(NewVal, 1, 1)
m_strTrainingCode = Mid(NewVal, 2, 6)
m_strTraineeCode = Mid(NewVal, 8, 6)
m_strTraineeName = Mid(NewVal, 14)

End Property

Public Property Let getHDTTATE(ByVal NewVal As String)

m_strHDTTATE = NewVal

End Property

Public Property Let getACR(ByVal NewVal As String)

m_strACR = NewVal

End Property

Private Sub InitOverAllGrid()

Dim intCtr As Integer
With flgOverAll
.FormatString = "<Overall Training|^5|^4|^3|^ 2|^1|<Comments"
.Rows = 2
.Cols = 7
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 4005
.ColWidth(1) = 500
.ColWidth(2) = 500
.ColWidth(3) = 500
.ColWidth(4) = 500
.ColWidth(5) = 500
.ColWidth(6) = 4005
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With
End Sub

Private Sub LoadOverAllGrid()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer, nTmpRow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetTemplates"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, TEMPLATE_ALL)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN, m_strTraineeCode)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgOverAll
intlastrow = 1

With flgOverAll
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 0
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgOverAll, intlastrow
.Col = 0: .Text = rsTemp.Fields("Description")
If m_strTraineeCode <> vbNullString Then
nTmpRow = rsTemp.Fields("Grade")
End If
If nTmpRow = 5 Then
.Col = 1: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 4 Then
.Col = 2: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 3 Then
.Col = 3: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 2 Then
.Col = 4: Set .CellPicture = imgSelected.Picture
ElseIf nTmpRow = 1 Then
.Col = 5: Set .CellPicture = imgSelected.Picture
End If
.CellPictureAlignment = flexAlignCenterCenter
.Col = 6: .Text = rsTemp.Fields("Comments")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
 ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Function SaveOverAllToArray() As Boolean

Dim intCtr As Integer, intCol As Integer
Dim intGrade As Integer, intItemCtr As Integer

On Error GoTo ErrorHandler

With flgOverAll
ReDim OverAll_Table(.Rows)
intItemCtr = 0
For intCtr = 1 To .Rows - 1
.Row = intCtr
If Trim(.TextArray(intCtr * .Cols + DESC_COL)) <> vbNullString Then
intItemCtr = intItemCtr + 1
intGrade = 0
For intCol = 1 To 5
.Col = intCol
If .CellPicture <> 0 Then
If intCol = 1 Then
intGrade = 5
ElseIf intCol = 2 Then
intGrade = 4
ElseIf intCol = 3 Then
intGrade = 3
ElseIf intCol = 4 Then
intGrade = 2
ElseIf intCol = 5 Then
intGrade = 1
End If
Exit For
End If
Next intCol
OverAll_Table(intItemCtr).TrainingCode = m_strTrainingCode
OverAll_Table(intItemCtr).TraineeCode = txtTraineeCode.Text
OverAll_Table(intItemCtr).Description = Trim(.TextArray(intCtr * .Cols + DESC_COL))
OverAll_Table(intItemCtr).Grade = intGrade
OverAll_Table(intItemCtr).Comments = Trim(.TextArray(intCtr * .Cols + COMMENTS_COL))
End If
Next intCtr
End With
ReDim Preserve OverAll_Table(intItemCtr)
SaveOverAllToArray = True
Exit Function

ErrorHandler:
SaveOverAllToArray = False
ReDim OverAll_Table(1)

End Function

Private Sub SaveArrayToTable()

Dim intCtr As Integer, intCtr2 As Integer
Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandTimeout = 0
.CommandType = adCmdStoredProc
.CommandText = "spSaveTemplates"
.Prepared = True
For intCtr = 1 To UBound(OverAll_Table)
.Parameters.Append .CreateParameter("intRetval", adInteger, adParamReturnValue, 4)
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, TEMPLATE_ALL)
 .Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN,
m_strTrainingCode)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN,
txtTraineeCode.Text)
.Parameters.Append .CreateParameter("strDescription", adVarChar, adParamInput, 50,
Trim(OverAll_Table(intCtr).Description))
.Parameters.Append .CreateParameter("intGrade", adSmallInt, adParamInput, , Trim(OverAll_Table(intCtr).Grade))
.Parameters.Append .CreateParameter("strComments", adChar, adParamInput, 50, Trim(OverAll_Table(intCtr).Comments))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
.Execute , , adExecuteNoRecords
If .Parameters("intRetval") <> 0 Then
GoTo ErrorHandler
Else
For intCtr2 = .Parameters.Count - 1 To 0 Step -1
.Parameters.Delete intCtr2
Next intCtr2
End If
Next intCtr
End With

Set cmdTemp = Nothing 'then reset

Exit Sub

ErrorHandler:
Set cmdTemp = Nothing 'then reset

End Sub

Private Sub cmdCancel_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdSave_Click()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

If Trim(txtTraineeCode.Text) = vbNullString Then

MsgBar "Trainee must not be blank. Please fill-in the field."
txtTraineeCode.SetFocus
Exit Sub
End If

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSTIHQEvaluationOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("intRetval", adInteger, adParamReturnValue, 4)
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, m_strOperation)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN, txtTraineeCode.Text)
.Parameters.Append .CreateParameter("strHDTTATE", adVarChar, adParamInput, 500, Trim(txtHDTTATE.Text))
.Parameters.Append .CreateParameter("strACR", adVarChar, adParamInput, 500, Trim(txtACR.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
.Execute , , adExecuteNoRecords
If .Parameters("intRetval") <> 0 Then
If SaveOverAllToArray Then
SaveArrayToTable
Else
GoTo ErrorHandler
End If
 End If
End With
cmdCancel_Click

ErrorHandler:
ErrorDisplay erTemp
Set cmdTemp = Nothing

End Sub

Private Sub flgOverAll_DblClick()

Dim i As Integer, nTmpRow As Integer
With flgOverAll
nTmpRow = .Col
If (.Row = (.Rows - 1)) Then
Exit Sub
End If
If (nTmpRow >= 1 And nTmpRow <= 5) Then
For i = 1 To 5
.Col = i: Set .CellPicture = LoadPicture
Next
.Col = nTmpRow: Set .CellPicture = imgSelected.Picture
.CellPictureAlignment = flexAlignCenterCenter
ElseIf nTmpRow = 6 Then
txtComments.Visible = True
txtComments.Top = .CellTop + 780: txtComments.Left = .CellLeft + 120
txtComments.Width = .CellWidth: txtComments.Height = .CellHeight
txtComments.Text = .Text
SelectCtl txtComments

End If
End With

End Sub

Private Sub flgOverAll_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)

flgOverAll.ToolTipText = MSG_RATING

End Sub

Private Sub Form_Activate()

If Val(m_strOperation) = BTN_EDIT Then
txtTraineeCode.Text = m_strTraineeCode
lblTraineeName.Caption = m_strTraineeName
txtHDTTATE.Text = m_strHDTTATE
txtACR.Text = m_strACR
End If

End Sub

Private Sub Form_Load()

Me.Top = FormSet.FormTop
Me.Left = FormSet.FormLeft
Me.Height = FormSet.FormHeight
Me.Width = FormSet.FormWidth
InitOverAllGrid
LoadOverAllGrid
fraTrainee.Enabled = Val(m_strOperation) = BTN_ADD

End Sub

Private Sub txtComments_KeyPress(KeyAscii As Integer)

With flgOverAll
If KeyAscii = vbKeyReturn Then
.Text = txtComments.Text
txtComments.Visible = False
ElseIf KeyAscii = vbKeyEscape Then
txtComments.Visible = False
End If
End With
End Sub

Private Sub txtComments_LostFocus()

flgOverAll.Text = txtComments.Text
txtComments.Visible = False

End Sub

'Pop-up Trainees
Private Sub txtTraineeCode_GotFocus()
SelectCtl txtTraineeCode

End Sub

Private Sub txtTraineeCode_LostFocus()

CheckTraineesField

End Sub

Private Sub txtTraineeCode_Validate(Cancel As Boolean)

Cancel = FilteredTraineeSearch(Me, m_strTrainingCode, txtTraineeCode.Text)

End Sub

Private Sub cmdTrainee_Click()

FilteredTraineeSearch Me, m_strTrainingCode, vbNullString, True
CheckTraineesField

End Sub

Private Sub CheckTraineesField()

If Trainees_Search(1).TraineeCode <> vbNullString Then
txtTraineeCode.Text = Trainees_Search(1).TraineeCode
lblTraineeName.Caption = Trainees_Search(1).TraineeName
End If

End Sub
'End of Pop-up Trainee

STI-HQ EVALUATION LIST

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean
Dim m_strTrainingCode As String

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdClose.Enabled = blnVal
flgTrainingCourses.Enabled = blnVal
flgTrainee.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
 cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint

End Sub

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchTrainingCourses"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strTrainingName", adVarChar, adParamInput, 50, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitTrainingCourseGrid()

Dim intCtr As Integer
With flgTrainingCourses
.FormatString = "<Training Name|^Training Code|^Course Code|<Course Name|^Trainee Code|<Trainee
Name|^From|^To|^Time|<Days"
.Rows = 2
.Cols = 10
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionByRow
.ColWidth(0) = 4005
.ColWidth(1) = 1215
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.ColWidth(4) = 1215
.ColWidth(5) = 4005
.ColWidth(6) = 1100
.ColWidth(7) = 1100
.ColWidth(8) = 1620
.ColWidth(9) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadTrainingCourseGrid()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(vbNullString, vbNullString)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
 ClearGridContents flgTrainingCourses
intlastrow = 1

With flgTrainingCourses
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 0
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgTrainingCourses, intlastrow
.Col = 0: .Text = rsTemp.Fields("TrainingName")
.Col = 1: .Text = rsTemp.Fields("TrainingCode")
.Col = 2: .Text = rsTemp.Fields("CourseCode")
.Col = 3: .Text = rsTemp.Fields("CourseName")
.Col = 4: .Text = rsTemp.Fields("TrainerCode")
.Col = 5: .Text = rsTemp.Fields("LastName") & ", " & rsTemp.Fields("FirstName")
.Col = 6: .Text = rsTemp.Fields("ScheduleFrom")
.Col = 7: .Text = rsTemp.Fields("ScheduleTo")
.Col = 8: .Text = rsTemp.Fields("ScheduleTime")
.Col = 9: .Text = rsTemp.Fields("ScheduleDays")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing

End Sub

Private Sub InitTraineeGrid()

Dim intCtr As Integer
With flgTrainee
.FormatString = "^Trainee Code|<Trainee Name|<How did the training address the expectations?|<Additional
Comments/Recommendations"
.Rows = 2
.Cols = 4
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = .Width
.ColWidth(3) = .Width
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadTraineeGrid()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
 Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSTIHQEvaluationOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN,
flgTrainee.TextArray(flgTrainee.Row * flgTrainee.Cols + 0))
.Parameters.Append .CreateParameter("strHDTTATE", adVarChar, adParamInput, 500, vbNullString)
.Parameters.Append .CreateParameter("strACR", adVarChar, adParamInput, 500, vbNullString)
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgTrainee
intlastrow = 1

With flgTrainee
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgTrainee, intlastrow
.Col = 0: .Text = rsTemp.Fields("TraineeCode")
.Col = 1: .Text = rsTemp.Fields("LastName") & ", " & rsTemp.Fields("FirstName")
.Col = 2: .Text = rsTemp.Fields("HDTTATE")
.Col = 3: .Text = rsTemp.Fields("ACR")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
MsgBar vbNullString
m_intOperation = BTN_FIND

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub PrintReport()

If blnPrint Then Exit Sub
blnPrint = True

MsgBar "Generating STI-HQ Training Evaluation Form. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
 .WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.WindowTitle = "STI-HQ Training Evaluation Form"
.SelectionFormula = "{vwD_Registration.GroupCode} = '" & g_strUserGroup & "' AND {vwD_Registration.TrainingCode} = '"
& m_strTrainingCode & "'"
.ReportFileName = g_DirectoryReports & "R_STIHQTrainingWData.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

If m_strTrainingCode = vbNullString Then Exit Sub

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
frmD_STIHQEvaluation.getParameters = Trim(str(m_intOperation)) + m_strTrainingCode
frmD_STIHQEvaluation.Show vbModal
m_intOperation = BTN_FIND
LoadTraineeGrid
Case BTN_EDIT 'edit/1
With flgTrainee
If .TextArray(.Row * .Cols + 0) <> vbNullString Then
MsgBar MSG_EDIT
frmD_STIHQEvaluation.getParameters = Trim(str(m_intOperation)) + m_strTrainingCode + .TextArray(.Row * .Cols +
0) + .TextArray(.Row * .Cols + 1)
frmD_STIHQEvaluation.getHDTTATE = .TextArray(.Row * .Cols + 2)
frmD_STIHQEvaluation.getACR = .TextArray(.Row * .Cols + 3)
frmD_STIHQEvaluation.Show vbModal
m_intOperation = BTN_FIND
LoadTraineeGrid
Else
MsgBar "No selected record! Select record from list."
m_intOperation = BTN_FIND
End If
End With
Case BTN_DELETE 'delete/2
Dim strMsg As String
MsgBar MSG_DELETE
With flgTrainee
strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & vbLf & _
"Do you want to delete this record?"
End With
If flgTrainee.TextArray(flgTrainee.Row * flgTrainee.Cols + 0) <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
LoadTraineeGrid
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
m_intOperation = BTN_FIND
End Select
End Sub

Private Sub flgTrainingCourses_Click()

m_strTrainingCode = Trim(flgTrainingCourses.TextArray(flgTrainingCourses.Row * flgTrainingCourses.Cols + 1))
LoadTraineeGrid

End Sub

Private Sub flgTrainingCourses_SelChange()

flgTrainingCourses_Click

End Sub

Private Sub Form_Load()

InitTrainingCourseGrid
LoadTrainingCourseGrid
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT
EnabledClose True
m_intOperation = BTN_FIND
InitTraineeGrid
flgTrainingCourses_Click
LoadTraineeGrid
DoEvents

End Sub

TRAINING COST

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean
Dim m_strTrainingCode As String
Dim m_strCourseCode As String

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
flgTrainingCourses.Enabled = blnVal
flgTrainingCost.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint

End Sub

Private Function CreateRecordSet(strCode, strDesc) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

 Set cmdTemp = New ADODB.Command
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spSearchTrainingCourses"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adVarChar, adParamInput, GENERICCODE_LEN, Trim(strCode))
.Parameters.Append .CreateParameter("strTrainingName", adVarChar, adParamInput, 50, Trim(strDesc))
Set CreateRecordSet = .Execute
End With

ErrorHandler:
Set cmdTemp = Nothing

End Function

Private Sub InitTrainingCourseGrid()

Dim intCtr As Integer
With flgTrainingCourses
.FormatString = "<Training Name|^Training Code|^Course Code|<Course Name|^Trainee Code|<Trainee
Name|^From|^To|^Time|<Days"
.Rows = 2
.Cols = 10
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionByRow
.ColWidth(0) = 4005
.ColWidth(1) = 1215
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.ColWidth(4) = 1215
.ColWidth(5) = 4005
.ColWidth(6) = 1100
.ColWidth(7) = 1100
.ColWidth(8) = 1620
.ColWidth(9) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadTrainingCourseGrid()

Dim rsTemp As ADODB.Recordset
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

'populate recordset
Set rsTemp = CreateRecordSet(vbNullString, vbNullString)

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgTrainingCourses
intlastrow = 1

With flgTrainingCourses
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 0
.Text = MSG_NORECORD
 End If
Do While Not rsTemp.EOF
AddGridRow flgTrainingCourses, intlastrow
.Col = 0: .Text = rsTemp.Fields("TrainingName")
.Col = 1: .Text = rsTemp.Fields("TrainingCode")
.Col = 2: .Text = rsTemp.Fields("CourseCode")
.Col = 3: .Text = rsTemp.Fields("CourseName")
.Col = 4: .Text = rsTemp.Fields("TrainerCode")
.Col = 5: .Text = rsTemp.Fields("LastName") & ", " & rsTemp.Fields("FirstName")
.Col = 6: .Text = rsTemp.Fields("ScheduleFrom")
.Col = 7: .Text = rsTemp.Fields("ScheduleTo")
.Col = 8: .Text = rsTemp.Fields("ScheduleTime")
.Col = 9: .Text = rsTemp.Fields("ScheduleDays")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

ErrorHandler:
Screen.MousePointer = vbDefault
Set rsTemp = Nothing

End Sub

Private Sub InitRegistrationGrid()

Dim intCtr As Integer
With flgTrainingCost
.FormatString = "<SeqNo|<Criteria|>Projected Cost|>Actual Cost"
.Rows = 2
.Cols = 4
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 0
.ColWidth(1) = 3675
.ColWidth(2) = 1380
.ColWidth(3) = 1380
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

Dim str As String

If blnPrint Then Exit Sub

blnPrint = True

MsgBar "Generating Training Cost Report. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
 .Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Training Cost Report'"
.WindowTitle = "Training Cost Report"
.SelectionFormula = "{TrainingCourses.GroupCode} = '" & g_strUserGroup & "' AND {TrainingCourses.TrainingCode} = '" &
m_strTrainingCode & "'"
.ReportFileName = g_DirectoryReports & "R_TrainingCost.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False
cmdCancel_Click

End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT
EnabledClose True
fraTrainingCost.Enabled = False
m_intOperation = BTN_FIND
flgTrainingCost_Click
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

If m_strTrainingCode = vbNullString Then Exit Sub

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraTrainingCost.Enabled = True
EnableOperation m_blnRightsADD, False, False, False
EnabledClose False
ClearAllFields Me
txtCriteria.SetFocus
Case BTN_EDIT 'edit/1
If txtSeqNo.Text <> vbNullString Then
MsgBar MSG_EDIT
fraTrainingCost.Enabled = True
EnableOperation False, m_blnRightsEDIT, False, False
EnabledClose False
txtCriteria.SetFocus
Else
MsgBar "No selected record! Select record from list."
m_intOperation = BTN_FIND
End If
Case BTN_DELETE 'delete/2
Dim strMsg As String
MsgBar MSG_DELETE
With flgTrainingCost
strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & vbLf & _
"Do you want to delete this record?"
End With
If txtCriteria <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
 PrintReport
End Select

End Sub

Private Sub cmdSave_Click()

'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtCriteria.Text) = vbNullString Then
MsgBar "Criteria must not be blank. Please fill-in the field."
txtCriteria.SetFocus
Exit Sub
End If
End If

'save and load data to grid

Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spTrainingCostOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN, m_strTrainingCode)
.Parameters.Append .CreateParameter("strCriteria", adVarChar, adParamInput, 50, Trim(txtCriteria.Text))
.Parameters.Append .CreateParameter("monProjectedCost", adCurrency, adParamInput, 8, CheckCCur(txtProjectedCost.Text))
.Parameters.Append .CreateParameter("monActualCost", adCurrency, adParamInput, 8, CheckCCur(txtActualCost.Text))
.Parameters.Append .CreateParameter("intSeqNo", adBigInt, adParamInput, 8, Val(txtSeqNo.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgTrainingCost
intlastrow = 1

With flgTrainingCost
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgTrainingCost, intlastrow
.Col = 0: .Text = rsTemp.Fields("SeqNo")
.Col = 1: .Text = Format(rsTemp.Fields("Criteria"), AMOUNT_FORMAT)
.Col = 2: .Text = Format(rsTemp.Fields("RFA"), AMOUNT_FORMAT)
.Col = 3: .Text = Format(rsTemp.Fields("ActualCost"), AMOUNT_FORMAT)
If txtSeqNo.Text = rsTemp.Fields("SeqNo") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
 .Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub flgTrainingCost_Click()

With flgTrainingCost
txtSeqNo.Text = Trim(.TextArray(.Row * .Cols + 0))
txtCriteria.Text = Trim(.TextArray(.Row * .Cols + 1))
txtProjectedCost.Text = Trim(.TextArray(.Row * .Cols + 2))
txtActualCost.Text = Trim(.TextArray(.Row * .Cols + 3))
If m_intOperation = BTN_EDIT Then
SelectCtl txtCriteria
End If
End With
MsgBar vbNullString

End Sub

Private Sub flgTrainingCost_SelChange()

flgTrainingCost_Click

End Sub

Private Sub flgTrainingCourses_Click()

m_strTrainingCode = Trim(flgTrainingCourses.TextArray(flgTrainingCourses.Row * flgTrainingCourses.Cols + 1))
m_strCourseCode = Trim(flgTrainingCourses.TextArray(flgTrainingCourses.Row * flgTrainingCourses.Cols + 2))
cmdSave_Click

End Sub

Private Sub flgTrainingCourses_SelChange()

flgTrainingCourses_Click

End Sub

Private Sub Form_Load()

InitTrainingCourseGrid
LoadTrainingCourseGrid
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT
EnabledClose True
fraTrainingCost.Enabled = False
m_intOperation = BTN_FIND
InitRegistrationGrid
flgTrainingCourses_Click
cmdSave_Click
flgTrainingCost_Click
DoEvents

End Sub

Private Sub txtActualCost_GotFocus()

txtActualCost.Text = RemoveComma(txtActualCost.Text)
SelectCtl txtActualCost

End Sub

Private Sub txtActualCost_KeyPress(KeyAscii As Integer)

KeyAscii = CheckNumeric(KeyAscii, txtActualCost)

End Sub

Private Sub txtActualCost_LostFocus()

 txtActualCost.Text = Format(txtActualCost.Text, AMOUNT_FORMAT)

End Sub

Private Sub txtProjectedCost_GotFocus()

txtProjectedCost.Text = RemoveComma(txtProjectedCost.Text)
SelectCtl txtProjectedCost

End Sub

Private Sub txtProjectedCost_KeyPress(KeyAscii As Integer)

KeyAscii = CheckNumeric(KeyAscii, txtProjectedCost)

End Sub

Private Sub txtProjectedCost_LostFocus()

txtProjectedCost.Text = Format(txtProjectedCost.Text, AMOUNT_FORMAT)

End Sub

INQUIRY CODES

CONFIRMED

Option Explicit
Dim blnPrint As Boolean
Dim strDays As String

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Trainee Code|<Trainee Name|^Date Entrolled|^Enrolled by|<Dean/COO Name|<School/Group"
.Rows = 2
.Cols = 7
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 1305
.ColWidth(3) = 1215
.ColWidth(4) = 4005
.ColWidth(5) = 4005
.ColWidth(6) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadToGrid()

'load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
 .ActiveConnection = cnnServer
.CommandText = "spGetConfirmedParticipants"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTrainingCode.Text))
.Parameters.Append .CreateParameter("strClientCode", adVarChar, adParamInput, GENERICCODE_LEN,
IIf(Trim(txtGroup.Text) = vbNullString, "XXXXXX", Trim(txtGroup.Text)))
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("TraineeCode")
.Col = 1: .Text = rsTemp.Fields("TraineeLName") & ", " & rsTemp.Fields("TraineeFName")
.Col = 2: .Text = Format(rsTemp.Fields("DateEnrolled"), DATE_FORMAT)
.Col = 3: .Text = rsTemp.Fields("EnrolledBy")
.Col = 4: .Text = rsTemp.Fields("DeanCOOLName") & ", " & rsTemp.Fields("DeanCOOFName")
.Col = 5: .Text = rsTemp.Fields("CompanyName")
.Col = 6: .Text = rsTemp.Fields("CompanyCode")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtTrainingCode.Text) = vbNullString Then

MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

blnPrint = True

MsgBar "Generating List of Confirmed Participants. Please wait..."

 With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = False
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'List of Confirmed Participants'"
.StoredProcParam(0) = g_strUserGroup
.StoredProcParam(1) = Trim(txtTrainingCode.Text)
.StoredProcParam(2) = IIf(Trim(txtGroup.Text) = vbNullString, "XXXXXX", Trim(txtGroup.Text))
.WindowTitle = "List of Confirmed Participants"
.ReportFileName = g_DirectoryReports & "I_ConfirmedParticipants.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

ReDim TrainingCourses_Search(1)
ReDim Clients_Search(1)
InitGrid

End Sub

'Pop-up clients
Private Sub txtGroup_GotFocus()
SelectCtl txtGroup

End Sub

Private Sub txtGroup_LostFocus()

CheckClientsField

End Sub

Private Sub txtGroup_Validate(Cancel As Boolean)

Cancel = ClientSearch(Me, txtGroup.Text)

End Sub

Private Sub cmdGroup_Click()

ClientSearch Me, vbNullString, True
CheckClientsField

End Sub

Private Sub CheckClientsField()

If Clients_Search(1).ClientCode <> vbNullString Then
txtGroup.Text = Clients_Search(1).ClientCode
lblGroupName.Caption = Clients_Search(1).ClientName
LoadToGrid
End If

End Sub
'End of Pop-up clients

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

 Dim i As Integer

CheckTrainingCoursesField
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
LoadToGrid
End If

End Sub
'End of Pop-up Training Course

HIGHEST GRADE

Option Explicit
Dim strDays As String
Dim blnPrint As Boolean

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Trainee Code|<Trainee Name|^Grade|<School/Group"
.Rows = 2
.Cols = 4
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With
End Sub

Private Sub LoadToGrid()

'load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetHighestGrade"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTrainingCode.Text))
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("TraineeCode")
.Col = 1: .Text = rsTemp.Fields("TraineeLName") & ", " & rsTemp.Fields("TraineeFName")
.Col = 2: .Text = Format(rsTemp.Fields("Grade"), AMOUNT_FORMAT)
.Col = 3: .Text = rsTemp.Fields("ClientName")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

 If Trim(txtTrainingCode.Text) = vbNullString Then
MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

blnPrint = True

MsgBar "Generating List of Participants who got Highest Grade. Please wait..."
With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = False
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'List of Participants who got Highest Grade'"
.StoredProcParam(0) = g_strUserGroup
.StoredProcParam(1) = Trim(txtTrainingCode.Text)
.WindowTitle = "List of Participants who got Highest Grade"
.ReportFileName = g_DirectoryReports & "I_HighestGrade.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

ReDim TrainingCourses_Search(1)
InitGrid

End Sub

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer

CheckTrainingCoursesField
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
 lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
LoadToGrid
End If

End Sub
'End of Pop-up Training Course

SUMMARY OF TRAINING

Option Explicit
Dim blnPrint As Boolean

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Training Code|<Training Name|^Trainee Code|<Trainee
Name|<School/Group|<Region|^Grade|^Passed?|<Remarks"
.Rows = 2
.Cols = 9
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.ColWidth(4) = 4005
.ColWidth(5) = 4005
.ColWidth(6) = 1215
.ColWidth(7) = 1215
.ColWidth(8) = 4005
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadToGrid()

'load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetTrainingResult"
 .CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTraineeCode", adVarChar, adParamInput, GENERICCODE_LEN,
IIf(Trim(txtTraineeCode.Text) = vbNullString, "XXXXXX", Trim(txtTraineeCode.Text)))
.Parameters.Append .CreateParameter("strClientCode", adVarChar, adParamInput, GENERICCODE_LEN,
IIf(Trim(txtGroup.Text) = vbNullString, "XXXXXX", Trim(txtGroup.Text)))
.Parameters.Append .CreateParameter("strRegionCode", adVarChar, adParamInput, GENERICCODE_LEN,
IIf(Trim(cboRegionCode.Text) = vbNullString, "XXXXXX", Trim(cboRegionCode.Text)))
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("TrainingCode")
.Col = 1: .Text = rsTemp.Fields("TrainingName")
.Col = 2: .Text = rsTemp.Fields("TraineeCode")
.Col = 3: .Text = rsTemp.Fields("TraineeLName") & ", " & rsTemp.Fields("TraineeFName")
.Col = 4: .Text = rsTemp.Fields("ClientName")
.Col = 5: .Text = rsTemp.Fields("RegionName")
.Col = 6: .Text = Format(rsTemp.Fields("Grade"), AMOUNT_FORMAT)
.Col = 7: .Text = rsTemp.Fields("Pass")
.Col = 8: .Text = rsTemp.Fields("Remarks")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub cboRegionName_Click()

cboRegionCode.ListIndex = cboRegionName.ListIndex
If cboRegionName.Enabled Then
LoadToGrid
End If

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

If optInquiryMode(0).value Then
 If Trim(txtTraineeCode.Text) = vbNullString Then
MsgBar "Trainee must not be blank. Please fill-in the field."
txtTraineeCode.SetFocus
Exit Sub
End If
ElseIf optInquiryMode(1).value Then
If Trim(txtGroup.Text) = vbNullString Then
MsgBar "Group/Company must not be blank. Please fill-in the field."
txtGroup.SetFocus
Exit Sub
End If
ElseIf optInquiryMode(2).value Then
If Trim(cboRegionName.Text) = vbNullString Then
MsgBar "Region must not be blank. Please fill-in the field."
cboRegionName.SetFocus
Exit Sub
End If
End If

If blnPrint Then Exit Sub

blnPrint = True

MsgBar "Generating Summary of Training Results. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = False
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Summary of Training Results'"
.StoredProcParam(0) = g_strUserGroup
.StoredProcParam(1) = IIf(Trim(txtTraineeCode.Text) = vbNullString, "XXXXXX", Trim(txtTraineeCode.Text))
.StoredProcParam(2) = IIf(Trim(txtGroup.Text) = vbNullString, "XXXXXX", Trim(txtGroup.Text))
.StoredProcParam(3) = IIf(Trim(cboRegionCode.Text) = vbNullString, "XXXXXX", Trim(cboRegionCode.Text))
.WindowTitle = "Summary of Training Results"
.ReportFileName = g_DirectoryReports & "I_TrainingResult.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

ReDim Trainees_Search(1)
ReDim Clients_Search(1)
InitGrid
GetRegions cboRegionName, cboRegionCode
optInquiryMode_Click 0

End Sub

Private Sub optInquiryMode_Click(Index As Integer)

If Index = 0 Then
txtTraineeCode.Enabled = True
cmdTrainee.Enabled = True
txtGroup.Enabled = False
cmdGroup.Enabled = False
txtGroup.Text = vbNullString
lblGroupName.Caption = vbNullString
SetCurrentItem cboRegionName, vbNullString
cboRegionName.Enabled = False
ElseIf Index = 1 Then
txtTraineeCode.Enabled = False
cmdTrainee.Enabled = False
 txtTraineeCode.Text = vbNullString
lblTraineeName.Caption = vbNullString
txtGroup.Enabled = True
cmdGroup.Enabled = True
SetCurrentItem cboRegionName, vbNullString
cboRegionName.Enabled = False
ElseIf Index = 2 Then
txtTraineeCode.Enabled = False
cmdTrainee.Enabled = False
txtTraineeCode.Text = vbNullString
lblTraineeName.Caption = vbNullString
txtGroup.Enabled = False
cmdGroup.Enabled = False
txtGroup.Text = vbNullString
lblGroupName.Caption = vbNullString
SetCurrentItem cboRegionName, vbNullString
cboRegionName.Enabled = True
End If

End Sub

'Pop-up clients
Private Sub txtGroup_GotFocus()
SelectCtl txtGroup

End Sub

Private Sub txtGroup_LostFocus()

CheckClientsField

End Sub

Private Sub txtGroup_Validate(Cancel As Boolean)

Cancel = ClientSearch(Me, txtGroup.Text)

End Sub

Private Sub cmdGroup_Click()

ClientSearch Me, vbNullString, True
CheckClientsField

End Sub

Private Sub CheckClientsField()

If Clients_Search(1).ClientCode <> vbNullString Then
txtGroup.Text = Clients_Search(1).ClientCode
lblGroupName.Caption = Clients_Search(1).ClientName
LoadToGrid
End If

End Sub
'End of Pop-up clients

'Pop-up Trainees
Private Sub txtTraineeCode_GotFocus()
SelectCtl txtTraineeCode

End Sub

Private Sub txtTraineeCode_LostFocus()

CheckTraineesField

End Sub

Private Sub txtTraineeCode_Validate(Cancel As Boolean)

Cancel = TraineeSearch(Me, txtTraineeCode.Text)

End Sub

Private Sub cmdTrainee_Click()

 TraineeSearch Me, vbNullString, True
CheckTraineesField

End Sub

Private Sub CheckTraineesField()

If Trainees_Search(1).TraineeCode <> vbNullString Then
txtTraineeCode.Text = Trainees_Search(1).TraineeCode
lblTraineeName.Caption = Trainees_Search(1).TraineeName
LoadToGrid
End If

End Sub
'End of Pop-up Trainee

TRAINING MODULE

Option Explicit
Dim blnPrint As Boolean

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Training Code|<Training Name|^Course Code|<Course Name|^Trainer Code|<Trainer Name|^Training
Status|^No. of Seats|^Available Seats|^From|^To|^Time"
.Rows = 2
.Cols = 12
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.ColWidth(4) = 1215
.ColWidth(5) = 4005
.ColWidth(6) = 2025
.ColWidth(7) = 1380
.ColWidth(8) = 1405
.ColWidth(9) = 1100
.ColWidth(10) = 1100
.ColWidth(11) = 1620
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoanToGrid()

'load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetTrainingModule"
.CommandType = adCmdStoredProc
 .Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strVenueCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtVenueCode.Text))
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("TrainingCode")
.Col = 1: .Text = rsTemp.Fields("TrainingName")
.Col = 2: .Text = rsTemp.Fields("CourseCode")
.Col = 3: .Text = rsTemp.Fields("CourseName")
.Col = 4: .Text = rsTemp.Fields("TrainerCode")
.Col = 5: .Text = rsTemp.Fields("LastName") & ", " & rsTemp.Fields("FirstName")
.Col = 6: .Text = rsTemp.Fields("Status")
.Col = 7: .Text = rsTemp.Fields("Seats")
.Col = 8: .Text = rsTemp.Fields("Seats") - rsTemp.Fields("ASeats")
.Col = 9: .Text = Format(rsTemp.Fields("ScheduleFrom"), DATE_FORMAT)
.Col = 10: .Text = Format(rsTemp.Fields("ScheduleTo"), DATE_FORMAT)
.Col = 11: .Text = rsTemp.Fields("ScheduleTime")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtVenueCode.Text) = vbNullString Then

MsgBar "Venue must not be blank. Please fill-in the field."
txtVenueCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

blnPrint = True

MsgBar "Generating List of of Training Modules. Please wait..."

 With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = False
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'List of of Training Modules'"
.StoredProcParam(0) = g_strUserGroup
.StoredProcParam(1) = Trim(txtVenueCode.Text)
.WindowTitle = "List of of Training Modules"
.ReportFileName = g_DirectoryReports & "I_TrainingModule.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

ReDim Venues_Search(1)
InitGrid

End Sub

'Pop-up venues
Private Sub txtVenueCode_GotFocus()
SelectCtl txtVenueCode

End Sub

Private Sub txtVenueCode_LostFocus()

CheckVenuesField

End Sub

Private Sub txtVenueCode_Validate(Cancel As Boolean)

Cancel = VenueSearch(Me, txtVenueCode.Text)

End Sub

Private Sub cmdVenue_Click()

VenueSearch Me, vbNullString, True
CheckVenuesField

End Sub

Private Sub CheckVenuesField()

If Venues_Search(1).VenueCode <> vbNullString Then
txtVenueCode.Text = Venues_Search(1).VenueCode
lblVenueName.Caption = Venues_Search(1).VenueName
LoanToGrid
End If

End Sub
'End of Pop-up venue

LOG-IN CODES

LOG –IN

Option Explicit

Dim intMaxTry As Integer

Private Sub cmdCancel_Click()
'user termination
End

End Sub

Private Sub cmdOK_Click()

Dim rsUser As ADODB.Recordset
Dim strUser As String
Dim strPassword As String
Dim dteExpired As Date
Dim intDaysLeft As Integer

On Error GoTo NotConnected

strUser = Trim(txtUser.Text)
strPassword = EncriptText(Trim(txtPassword.Text))
If Trim(strUser) = vbNullString Then
SelectCtl txtUser
Exit Sub
End If
If Trim(strPassword) = vbNullString Then
SelectCtl txtPassword
Exit Sub
End If
'check if user is existing
Set rsUser = GetUserAndPassword(strUser, strPassword)
If rsUser.EOF Then
MsgBox "The system could not log you on. Make sure your user name is correct" & Chr(10) & "then type your password again.",
vbExclamation, Me.Caption
txtUser.SetFocus
intMaxTry = intMaxTry + 1
If intMaxTry >= MAX_TRY Then
GoTo NotConnected
Else
Exit Sub
End If
Else
' 'check if user is already logged-in
' If IsUserLog(strUser) Then
' MsgBox "User is already logged in!", vbCritical, Me.Caption
' intMaxTry = intMaxTry + 1
' If intMaxTry >= MAX_TRY Then
' GoTo NotConnected
' Else
' Exit Sub
' End If
' End If
'check if user denied by administrator
If rsUser("Blocked") Then
MsgBox "The system deny you to log on. Contact your System Adminstrator" & Chr(10) & "then try again.", vbExclamation,
Me.Caption
intMaxTry = intMaxTry + 1
If intMaxTry >= MAX_TRY Then
GoTo NotConnected
Else
Exit Sub
End If
End If
'check access time within the limmit
dteExpired = rsUser("Expire")
If dteExpired <= CDate(g_strCurrentDate) Then
MsgBox "User expired. Contact your System Administrator" & Chr(10) & "then try again.", vbExclamation, Me.Caption
intMaxTry = intMaxTry + 1
If intMaxTry >= MAX_TRY Then
GoTo NotConnected
Else
Exit Sub
End If
 End If
intDaysLeft = (dteExpired - CDate(g_strCurrentDate))
If intDaysLeft < EXP_UNTIL Then
MsgBox "User will expire within " & intDaysLeft & " day(s). Change your user password.", vbInformation, Me.Caption
End If
'Re-set number of try.
intMaxTry = 0
'set other global variable
g_strLoginDate = Format(Now(), DATETIME_FORMAT)
g_strUserID = rsUser.Fields("UserID")
g_strUserGroup = rsUser.Fields("GroupCode")
g_strUserRole = rsUser.Fields("GroupCode")
g_strUserFullName = rsUser.Fields("FirstName") & " " & rsUser.Fields("LastName")
'update user log and user trail
UpdateUserLog strYES

'ready to view main menu

Load mdiMainMenu
frmLogin.Hide
mdiMainMenu.StatusBar1.Panels(P_USERID).Text = "User Name: " & g_strUserID
mdiMainMenu.Show
End If
Set rsUser = Nothing
Exit Sub

NotConnected:
Set rsUser = Nothing
cmdCancel_Click

End Sub

Private Sub Form_Load()

'STI Logo...
imgSTILogo.Top = Me.ScaleTop
imgSTILogo.Left = Me.ScaleLeft
imgSTILogo.Picture = frmAbout.imgSTILogo.Picture
'Background color....
imgBgColor.Picture = frmAbout.imgBgColor.Picture
imgBgColor.Top = Me.Top
imgBgColor.Left = Me.Left
imgBgColor.Height = Me.Height
imgBgColor.Width = Me.Width
imgBgColor.Stretch = True
imgBgColor.ZOrder 1
'initialize some global variables
g_strCurrentDate = Format(Now, DATE_FORMAT)

End Sub

Private Sub Form_Unload(Cancel As Integer)

cmdCancel_Click

End Sub

Private Sub txtPassword_GotFocus()

SelectCtl txtPassword

End Sub

Private Sub txtUser_GotFocus()

SelectCtl txtUser

End Sub

LOG-IN ADMIN

Option Explicit

Private Sub cmdOK_Click()

 g_strUserGroup = Left(cboGroupName.Text, 2)
Unload Me

End Sub

Private Sub Form_Load()

'STI Logo...
imgSTILogo.Top = Me.ScaleTop
imgSTILogo.Left = Me.ScaleLeft
imgSTILogo.Picture = frmAbout.imgSTILogo.Picture
'Background color....
imgBgColor.Picture = frmAbout.imgBgColor.Picture
imgBgColor.Top = Me.Top
imgBgColor.Left = Me.Left
imgBgColor.Height = Me.Height
imgBgColor.Width = Me.Width
imgBgColor.Stretch = True
imgBgColor.ZOrder 1
'initialize some global variables
g_strCurrentDate = Format(Now, DATE_FORMAT)
GetGroupName cboGroupName

End Sub

Sub GetGroupName(CurrentCtl As Control)

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetGroupName"
.CommandType = adCmdStoredProc
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
With CurrentCtl
Do While Not rsTemp.EOF
.AddItem rsTemp.Fields("GroupCode") & " - " & rsTemp.Fields("Description")
rsTemp.MoveNext
Loop
End With
CurrentCtl.ListIndex = 0

ErrorHandler:
Screen.MousePointer = vbDefault
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

MAINTENANCE CODES

CLIENTS

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
 m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
MSFlexGrid1.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean, blnFind As
Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint
cmdOperation(4).Enabled = blnFind

End Sub

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Group Code|<Group Name|<Address|<Telephone No.|<Region|<STI?"
.Rows = 2
.Cols = 6
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1100
.ColWidth(1) = 4005
.ColWidth(2) = 6000
.ColWidth(3) = 1590
.ColWidth(4) = 2025
.ColWidth(5) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

Dim strCnn As String
If blnPrint Then Exit Sub
blnPrint = True
MsgBar "Generating Client Reports. Please wait..."
With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Group/Company Reports'"
.WindowTitle = "Group/Company Reports"
.ReportFileName = g_DirectoryReports & "GroupCompany.rpt"
.Connect = cnnReport
 .Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub cboRegionName_Click()

cboRegionCode.ListIndex = cboRegionName.ListIndex

End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraClients.Enabled = False
txtClientCode.Locked = False
m_intOperation = BTN_FIND
MSFlexGrid1_Click
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraClients.Enabled = True
EnableOperation m_blnRightsADD, False, False, False, False
EnabledClose False
ClearAllFields Me
txtClientCode.Text = CreateSystemCode(COD_CLIENT)
txtClientCode.SetFocus
Case BTN_EDIT 'edit/1
If txtClientCode <> vbNullString Then
MsgBar MSG_EDIT
fraClients.Enabled = True
txtClientCode.Locked = True
EnableOperation False, m_blnRightsEDIT, False, False, False
EnabledClose False
txtClientName.SetFocus
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_DELETE 'delete/2
If CheckIfCanBeDelete(COD_CLIENT, Trim(txtClientCode.Text)) Then
MsgBar MSG_CANTDELETE
m_intOperation = BTN_FIND
Exit Sub
End If
Dim strMsg As String
MsgBar MSG_DELETE
With MSFlexGrid1
strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & vbLf & _
"Do you want to delete this record?"
End With
If txtClientCode <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
 MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
Case BTN_FIND 'find/4
MsgBar MSG_FIND
fraClients.Enabled = True
EnableOperation False, False, False, False, True
cmdCancel.Enabled = True
ClearAllFields Me
txtClientCode.SetFocus
End Select

End Sub

Private Sub cmdSave_Click()

'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtClientCode.Text) = vbNullString Then
MsgBar "Client code must not be blank. Please fill-in the field."
txtClientCode.SetFocus
Exit Sub
End If
If Trim(cboYesNo.Text) = vbNullString Then
MsgBar "Member of STI Group must not be blank. Please fill-in the field."
cboYesNo.SetFocus
Exit Sub
End If
If Trim(txtClientName.Text) = vbNullString Then
MsgBar "Client name must not be blank. Please fill-in the field."
txtClientName.SetFocus
Exit Sub
End If
End If

'save and load data to grid

Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spClientOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strClientCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtClientCode.Text))
.Parameters.Append .CreateParameter("strClientName", adVarChar, adParamInput, 50, Trim(txtClientName.Text))
.Parameters.Append .CreateParameter("intMember", adInteger, adParamInput, 4, IIf(cboYesNo.Text = strYES, YES, NO))
.Parameters.Append .CreateParameter("strAddress", adVarChar, adParamInput, 100, Trim(txtAddress.Text))
.Parameters.Append .CreateParameter("strTelNum", adVarChar, adParamInput, 50, Trim(txtTelNum.Text))
.Parameters.Append .CreateParameter("strRegionCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(cboRegionCode.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
 intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("ClientCode")
.Col = 1: .Text = rsTemp.Fields("ClientName")
.Col = 2: .Text = rsTemp.Fields("Address")
.Col = 3: .Text = rsTemp.Fields("TelNumber")
.Col = 4: .Text = rsTemp.Fields("RegionName")
.Col = 5: .Text = IIf(rsTemp.Fields("STIMember"), strYES, strNO)
If txtClientCode.Text = rsTemp.Fields("ClientCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub Form_Load()

fraClients.Top = FrameSet.FTop
fraClients.Left = FrameSet.FLeft
fraClients.Width = FrameSet.FWidth
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraClients.Enabled = False
m_intOperation = BTN_FIND
GetYesNoItem cboYesNo
GetRegions cboRegionName, cboRegionCode
InitGrid
cmdSave_Click
MSFlexGrid1_Click
DoEvents

End Sub

Private Sub MSFlexGrid1_Click()

With MSFlexGrid1
txtClientCode.Text = Trim(.TextArray(.Row * .Cols + 0))
txtClientName.Text = Trim(.TextArray(.Row * .Cols + 1))
txtAddress.Text = Trim(.TextArray(.Row * .Cols + 2))
txtTelNum.Text = Trim(.TextArray(.Row * .Cols + 3))
SetCurrentItem cboRegionName, Trim(.TextArray(.Row * .Cols + 4))
SetCurrentItem cboYesNo, Trim(.TextArray(.Row * .Cols + 5))
If m_intOperation = BTN_EDIT Then
SelectCtl txtClientName
End If
End With
MsgBar vbNullString

End Sub

Private Sub MSFlexGrid1_SelChange()

 MSFlexGrid1_Click

End Sub

Private Sub txtAddress_GotFocus()

SelectCtl txtAddress

End Sub

Private Sub txtClientCode_GotFocus()

SelectCtl txtClientCode

End Sub

Private Sub txtClientCode_KeyPress(KeyAscii As Integer)

KeyAscii = CheckNumeric(KeyAscii, txtClientCode)

End Sub

Private Sub txtClientCode_LostFocus()

If m_intOperation <> BTN_FIND Then
txtClientCode.Text = Format(txtClientCode.Text, GENERICCODE_FORMAT)
End If

End Sub

Private Sub txtClientName_GotFocus()

SelectCtl txtClientName

End Sub

Private Sub txtClientName_LostFocus()

If m_intOperation = BTN_FIND Then
cmdSave_Click
End If

End Sub

Private Sub txtTelNum_GotFocus()

SelectCtl txtTelNum

End Sub

COURSES

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
MSFlexGrid1.Enabled = blnVal

End Sub
Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean, blnFind As
Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint
cmdOperation(4).Enabled = blnFind

End Sub

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Course Code|<Course Name|<Course Objective/Description"
.Rows = 2
.Cols = 3
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = .Width
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

If blnPrint Then Exit Sub
blnPrint = True
MsgBar "Generating Courses Reports. Please wait..."
With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Courses Reports'"
.WindowTitle = "Courses Reports"
.ReportFileName = g_DirectoryReports & "Courses.rpt"
.SelectionFormula = "{COURSES.GroupCode} = '" & g_strUserGroup & "'"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraCourses.Enabled = False
txtCourseCode.Locked = False
m_intOperation = BTN_FIND
MSFlexGrid1_Click
MsgBar vbNullString

End Sub
Private Sub cmdClose_Click()
MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraCourses.Enabled = True
EnableOperation m_blnRightsADD, False, False, False, False
EnabledClose False
ClearAllFields Me
txtCourseCode.Text = CreateSystemCode(C0D_COURSE)
txtCourseCode.SetFocus
Case BTN_EDIT 'edit/1
If txtCourseCode <> vbNullString Then
MsgBar MSG_EDIT
fraCourses.Enabled = True
txtCourseCode.Locked = True
EnableOperation False, m_blnRightsEDIT, False, False, False
EnabledClose False
txtCourseName.SetFocus
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_DELETE 'delete/2
If CheckIfCanBeDelete(C0D_COURSE, Trim(txtCourseCode.Text)) Then
MsgBar MSG_CANTDELETE
m_intOperation = BTN_FIND
Exit Sub
End If
Dim strMsg As String
MsgBar MSG_DELETE
With MSFlexGrid1
strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & vbLf & _
"Do you want to delete this record?"
End With
If txtCourseCode <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
Case BTN_FIND 'find/4
MsgBar MSG_FIND
fraCourses.Enabled = True
EnableOperation False, False, False, False, True
cmdCancel.Enabled = True
ClearAllFields Me
txtCourseCode.SetFocus
End Select

End Sub

Private Sub cmdSave_Click()

'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtCourseCode.Text) = vbNullString Then
MsgBar "Course code must not be blank. Please fill-in the field."
txtCourseCode.SetFocus
Exit Sub
 End If
If Trim(txtCourseName.Text) = vbNullString Then
MsgBar "Course name must not be blank. Please fill-in the field."
txtCourseName.SetFocus
Exit Sub
End If
End If

'save and load data to grid

Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spCourseOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strCourseCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtCourseCode.Text))
.Parameters.Append .CreateParameter("strCourseName", adVarChar, adParamInput, 50, Trim(txtCourseName.Text))
.Parameters.Append .CreateParameter("strObjective", adVarChar, adParamInput, 2000, Trim(txtObjective.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("CourseCode")
.Col = 1: .Text = rsTemp.Fields("CourseName")
.Col = 2: .Text = rsTemp.Fields("Objective")
If txtCourseCode.Text = rsTemp.Fields("CourseCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing
End Sub

Private Sub Form_Load()

fraCourses.Top = FrameSet.FTop
fraCourses.Left = FrameSet.FLeft
fraCourses.Width = FrameSet.FWidth
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraCourses.Enabled = False
m_intOperation = BTN_FIND
InitGrid
cmdSave_Click
MSFlexGrid1_Click
DoEvents

End Sub

Private Sub MSFlexGrid1_Click()

With MSFlexGrid1
txtCourseCode.Text = Trim(.TextArray(.Row * .Cols + 0))
txtCourseName.Text = Trim(.TextArray(.Row * .Cols + 1))
txtObjective.Text = Trim(.TextArray(.Row * .Cols + 2))
If m_intOperation = BTN_EDIT Then
SelectCtl txtCourseName
End If
End With
MsgBar vbNullString

End Sub

Private Sub MSFlexGrid1_SelChange()

MSFlexGrid1_Click

End Sub

Private Sub txtCourseCode_GotFocus()

SelectCtl txtCourseCode

End Sub

Private Sub txtCourseCode_KeyPress(KeyAscii As Integer)

KeyAscii = CheckNumeric(KeyAscii, txtCourseCode)

End Sub

Private Sub txtCourseCode_LostFocus()

If m_intOperation <> BTN_FIND Then
txtCourseCode.Text = Format(txtCourseCode.Text, GENERICCODE_FORMAT)
End If

End Sub

Private Sub txtCourseName_GotFocus()

SelectCtl txtCourseName

End Sub

Private Sub txtCourseName_LostFocus()

If m_intOperation = BTN_FIND Then
cmdSave_Click
End If

End Sub

Private Sub txtObjective_GotFocus()

SelectCtl txtObjective

End Sub
EVALUATIONS

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
MSFlexGrid1(0).Enabled = blnVal
MSFlexGrid1(1).Enabled = blnVal
MSFlexGrid1(2).Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean, blnFind As
Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint

End Sub

Private Sub InitGrid(intRow As Integer)

Dim intCtr As Integer

With MSFlexGrid1(intRow)
.FormatString = "<Description"
.Rows = 2
.Cols = 1
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = .Width
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

If blnPrint Then Exit Sub
blnPrint = True
MsgBar "Generating Evaluation Reports. Please wait..."
With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
 .WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Evaluation Reports'"
.WindowTitle = "Evaluation Reports"
.ReportFileName = g_DirectoryReports & "Evaluations.rpt"
.SelectionFormula = "{vwM_TrainingCourses.GroupCode} = '" & g_strUserGroup & "'"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraTrainingCourse.Enabled = True
m_intOperation = BTN_FIND
MSFlexGrid1_Click SSTab1.Tab
MsgBar vbNullString
Dim i As Integer
For i = 0 To SSTab1.Tabs - 1
txtDescription(i).Locked = True
SSTab1.TabEnabled(i) = True
Next i
DoEvents

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

Dim i As Integer

If txtTrainingCode.Text = vbNullString Then

MsgBar "Training course must not be blank. Please fill-in the field."
Exit Sub
End If
m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
For i = 0 To SSTab1.Tabs - 1
If i <> SSTab1.Tab Then SSTab1.TabEnabled(i) = False
txtDescription(i).Locked = False
Next i
fraTrainingCourse.Enabled = False
EnableOperation m_blnRightsADD, False, False, False, False
EnabledClose False
'ClearAllFields Me
txtDescription(SSTab1.Tab).Text = vbNullString
txtDescription(SSTab1.Tab).SetFocus
Case BTN_EDIT 'edit/1
If txtDescription(SSTab1.Tab) <> vbNullString Then
MsgBar MSG_EDIT
For i = 0 To SSTab1.Tabs - 1
If i <> SSTab1.Tab Then SSTab1.TabEnabled(i) = False
txtDescription(i).Locked = False
Next i
fraTrainingCourse.Enabled = False
EnableOperation False, m_blnRightsEDIT, False, False, False
EnabledClose False
 txtDescription(SSTab1.Tab).SetFocus
Else
MsgBar "No selected record! Select record from list."
m_intOperation = BTN_FIND
End If
Case BTN_DELETE 'delete/2
Dim strMsg As String
MsgBar MSG_DELETE
With MSFlexGrid1(SSTab1.Tab)
strMsg = .TextArray(.Row * .Cols + 0) & "-" & _
"Do you want to delete this record?"
End With
If txtDescription(SSTab1.Tab) <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
End Select

End Sub

Private Sub cmdSave_Click()

Dim i As Integer
'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtDescription(SSTab1.Tab).Text) = vbNullString Then
MsgBar "Description must not be blank. Please fill-in the field."
txtDescription(SSTab1.Tab).SetFocus
Exit Sub
End If
End If
'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spTrainingEvaluation" & Trim(str(SSTab1.Tab + 1)) & "Operation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCourse", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTrainingCode.Text))
.Parameters.Append .CreateParameter("strOldDescription", adVarChar, adParamInput, 100,
Trim(MSFlexGrid1(SSTab1.Tab).TextArray(MSFlexGrid1(SSTab1.Tab).Row * MSFlexGrid1(SSTab1.Tab).Cols)))
.Parameters.Append .CreateParameter("strNewDescription", adVarChar, adParamInput, 100,
Trim(txtDescription(SSTab1.Tab).Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1(SSTab1.Tab)
intlastrow = 1

With MSFlexGrid1(SSTab1.Tab)
.Redraw = False
 intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 0
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1(SSTab1.Tab), intlastrow
.Col = 0: .Text = rsTemp.Fields("Description")
If txtDescription(SSTab1.Tab).Text = rsTemp.Fields("Description") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub Form_Load()

ReDim TrainingCourses_Search(1)
fraTrainingCourse.Top = FrameSet.FTop
fraTrainingCourse.Left = FrameSet.FLeft
fraTrainingCourse.Width = FrameSet.FWidth
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraTrainingCourse.Enabled = True
m_intOperation = BTN_FIND
GetTimeItem cboTime
Dim i As Integer
For i = MSFlexGrid1.UBound To 0 Step -1
txtDescription(i).Locked = True
SSTab1.Tab = i
InitGrid (i)
cmdSave_Click
MSFlexGrid1_Click i
Next i
DoEvents

End Sub

Private Sub MSFlexGrid1_Click(Index As Integer)

With MSFlexGrid1(Index)
txtDescription(Index).Text = Trim(.TextArray(.Row * .Cols + 0))
If m_intOperation = BTN_EDIT Then
SelectCtl txtDescription(Index)
End If
End With
MsgBar vbNullString
DoEvents

End Sub

Private Sub MSFlexGrid1_GotFocus(Index As Integer)

SSTab1.Tab = Index

End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
MSFlexGrid1_Click SSTab1.Tab
DoEvents

End Sub

Private Sub txtDescription_GotFocus(Index As Integer)

SSTab1.Tab = Index
SelectCtl txtDescription(Index)

End Sub

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer

CheckTrainingCoursesField
For i = MSFlexGrid1.UBound To 0 Step -1
SSTab1.Tab = i
cmdSave_Click
MSFlexGrid1_Click i
Next i
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
Dim strDays As String
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
End If

End Sub
'End of Pop-up Training Course

GUIDELINES

Option Explicit
Dim m_intOperation As Integer
Dim blnPrint As Boolean

Private Sub PrintReport()

Dim strCnn As String

If blnPrint Then Exit Sub

blnPrint = True
MsgBar "Generating Guidelines Report. Please wait..."
With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Guidelines'"
.WindowTitle = "Guidelines"
.ReportFileName = g_DirectoryReports & "GuideLines.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnEdit As Boolean, blnPrint As Boolean)

cmdOperation(1).Enabled = blnEdit
cmdOperation(3).Enabled = blnPrint

End Sub

Private Sub cmdCancel_Click()

m_intOperation = BTN_FIND
cmdSave_Click
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

m_intOperation = Index
Select Case Index
Case BTN_EDIT 'edit/1
MsgBar MSG_EDIT
fraGuidelines.Enabled = True
EnableOperation True, False
EnabledClose False
txtGuidelines.SetFocus
Case BTN_PRINT 'print/3
PrintReport
End Select

End Sub
Private Sub cmdSave_Click()
'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim strTemp As String
Dim strGuideline As String
Dim strGuideCont As String
Dim strGuideCont2 As String
Dim strGuideCont3 As String
On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
strTemp = Replace(Trim(txtGuidelines.Text), "'", "''")
strGuideline = Left(strTemp, 8000)
strGuideCont = Mid(strTemp, 8001, 16000)
strGuideCont2 = Mid(strTemp, 16001, 24000)
strGuideCont3 = Mid(strTemp, 24001)
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGuidelineOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGuideLine", adVarChar, adParamInput, 8000, strGuideline)
.Parameters.Append .CreateParameter("strGuideCont", adVarChar, adParamInput, 8000, strGuideCont)
.Parameters.Append .CreateParameter("strGuideCont2", adVarChar, adParamInput, 8000, strGuideCont2)
.Parameters.Append .CreateParameter("strGuideCont3", adVarChar, adParamInput, 8000, strGuideCont3)
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With
Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
txtGuidelines.Text = vbNullString
Do While Not rsTemp.EOF
txtGuidelines.Text = txtGuidelines.Text & Trim(rsTemp.Fields("Guidelines"))
rsTemp.MoveNext
Loop
EnableOperation True, True
EnabledClose True
fraGuidelines.Enabled = False
txtGuidelines.Locked = False
m_intOperation = BTN_FIND
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub Form_Load()

fraGuidelines.Top = FrameSet.FTop
fraGuidelines.Left = FrameSet.FLeft
fraGuidelines.Width = FrameSet.FWidth
EnableOperation True, True
EnabledClose True
fraGuidelines.Enabled = False
m_intOperation = BTN_FIND
cmdSave_Click
DoEvents

End Sub

ONLINE USERS

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
MSFlexGrid1.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean, blnFind As
Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint
cmdOperation(4).Enabled = blnFind

End Sub

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Dean/COO Code|^On-line User Name|<First Name|<Last Name|<Position|<Email Address|^Group
Code|<Group Name|<On-line Password"
.Rows = 2
.Cols = 9
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1440
.ColWidth(1) = 1665
.ColWidth(2) = 4005
.ColWidth(3) = 4005
.ColWidth(4) = 4005
.ColWidth(5) = 4005
.ColWidth(6) = 1100
.ColWidth(7) = 4005
.ColWidth(8) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

If blnPrint Then Exit Sub
blnPrint = True
MsgBar "Generating Dean/COO Reports. Please wait..."
With crptReport
.WindowState = crptMaximized
 .WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Dean/COO Reports'"
.WindowTitle = "Dean/COO Reports"
.ReportFileName = g_DirectoryReports & "OnlineUsers.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraOnlineUser.Enabled = False
txtDeanCode.Locked = False
txtUserName.Locked = False
m_intOperation = BTN_FIND
MSFlexGrid1_Click
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraOnlineUser.Enabled = True
EnableOperation m_blnRightsADD, False, False, False, False
EnabledClose False
ClearAllFields Me
txtDeanCode.Text = CreateSystemCode(C0D_ONLINE)
txtDeanCode.SetFocus
Case BTN_EDIT 'edit/1
If txtDeanCode <> vbNullString Then
MsgBar MSG_EDIT
fraOnlineUser.Enabled = True
txtDeanCode.Locked = True
txtUserName.Locked = True
EnableOperation False, m_blnRightsEDIT, False, False, False
EnabledClose False
txtFirstName.SetFocus
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_DELETE 'delete/2
If CheckIfCanBeDelete(C0D_ONLINE, Trim(txtDeanCode.Text)) Then
MsgBar MSG_CANTDELETE
m_intOperation = BTN_FIND
Exit Sub
End If
Dim strMsg As String
MsgBar MSG_DELETE
With MSFlexGrid1
 strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 2) & " " & .TextArray(.Row * .Cols + 3) & vbLf
&_
"Do you want to delete this record?"
End With
If txtDeanCode <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
Case BTN_FIND 'find/4
MsgBar MSG_FIND
fraOnlineUser.Enabled = True
EnableOperation False, False, False, False, True
cmdCancel.Enabled = True
ClearAllFields Me
txtDeanCode.SetFocus
End Select

End Sub

Private Sub cmdSave_Click()

'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtDeanCode.Text) = vbNullString Then
MsgBar "Trainee code must not be blank. Please fill-in the field."
txtDeanCode.SetFocus
Exit Sub
End If
If Trim(txtUserName.Text) = vbNullString Then
MsgBar "On-line User Name must not be blank. Please fill-in the field."
txtUserName.SetFocus
Exit Sub
End If
If Trim(txtFirstName.Text) = vbNullString Then
MsgBar "First name must not be blank. Please fill-in the field."
txtFirstName.SetFocus
Exit Sub
End If
If Trim(txtLastName.Text) = vbNullString Then
MsgBar "Last name must not be blank. Please fill-in the field."
txtLastName.SetFocus
Exit Sub
End If
If Trim(txtGroup.Text) = vbNullString Then
MsgBar "Group/Company must not be blank. Please fill-in the field."
txtGroup.SetFocus
Exit Sub
End If
If Trim(txtEmail.Text) <> vbNullString Then
If InStr(txtEmail.Text, "@") = 0 Or _
InStr(txtEmail.Text, ".") = 0 Or _
Len(txtEmail.Text) < 7 Then
MsgBar "Please specify a valid e-mail address! Please fill-in the field."
txtEmail.SetFocus
Exit Sub
End If
End If
End If
'auto generate password
If m_intOperation = BTN_ADD Then
txtPassword.Text = GeneratePassword(txtFirstName.Text, txtLastName.Text, txtUserName.Text, Now())
End If

'save and load data to grid

Dim cmdTemp As ADODB.Command
 Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spOnlineUserOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strDeanCode", adChar, adParamInput, GENERICCODE_LEN, Trim(txtDeanCode.Text))
.Parameters.Append .CreateParameter("strFirstName", adVarChar, adParamInput, 30, Trim(txtFirstName.Text))
.Parameters.Append .CreateParameter("strLastName", adVarChar, adParamInput, 30, Trim(txtLastName.Text))
.Parameters.Append .CreateParameter("strTitle", adVarChar, adParamInput, 30, Trim(cboTitle.Text))
.Parameters.Append .CreateParameter("strEmail", adVarChar, adParamInput, 50, Trim(txtEmail.Text))
.Parameters.Append .CreateParameter("strCompany", adVarChar, adParamInput, GENERICCODE_LEN, Trim(txtGroup.Text))
.Parameters.Append .CreateParameter("strUserName", adVarChar, adParamInput, USERID_LEN, Trim(txtUserName.Text))
.Parameters.Append .CreateParameter("strPassword", adVarChar, adParamInput, 40, Trim(txtPassword.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 2
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("OfflineID")
.Col = 1: .Text = rsTemp.Fields("OnlineID")
.Col = 2: .Text = rsTemp.Fields("FirstName")
.Col = 3: .Text = rsTemp.Fields("LastName")
.Col = 4: .Text = rsTemp.Fields("Title")
.Col = 5: .Text = rsTemp.Fields("Email")
.Col = 6: .Text = rsTemp.Fields("Company")
.Col = 7: .Text = rsTemp.Fields("CompanyName")
.Col = 8: .Text = rsTemp.Fields("Password")
If txtDeanCode.Text = rsTemp.Fields("OfflineID") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing
End Sub

Private Sub Form_Activate()

If g_strUserRole <> GROUP_ADMIN Then
txtUserName.Width = 6690
lblPassword.Visible = False
txtPassword.Visible = False
End If

End Sub

Private Sub Form_Load()

fraOnlineUser.Top = FrameSet.FTop
fraOnlineUser.Left = FrameSet.FLeft
fraOnlineUser.Width = FrameSet.FWidth
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraOnlineUser.Enabled = False
m_intOperation = BTN_FIND
GetDeanCOOTitle cboTitle
InitGrid
cmdSave_Click
MSFlexGrid1_Click
DoEvents

End Sub

Private Sub MSFlexGrid1_Click()

With MSFlexGrid1
txtDeanCode.Text = Trim(.TextArray(.Row * .Cols + 0))
txtUserName.Text = Trim(.TextArray(.Row * .Cols + 1))
txtFirstName.Text = Trim(.TextArray(.Row * .Cols + 2))
txtLastName.Text = Trim(.TextArray(.Row * .Cols + 3))
SetCurrentItem cboTitle, Trim(.TextArray(.Row * .Cols + 4))
txtEmail.Text = Trim(.TextArray(.Row * .Cols + 5))
txtGroup.Text = Trim(.TextArray(.Row * .Cols + 6))
lblGroupName.Caption = Trim(.TextArray(.Row * .Cols + 7))
txtPassword.Text = Trim(.TextArray(.Row * .Cols + 8))
If m_intOperation = BTN_EDIT Then
SelectCtl txtFirstName
End If
End With
MsgBar vbNullString

End Sub

Private Sub MSFlexGrid1_SelChange()

MSFlexGrid1_Click

End Sub

Private Sub txtDeanCode_GotFocus()

SelectCtl txtDeanCode

End Sub

Private Sub txtDeanCode_KeyPress(KeyAscii As Integer)

KeyAscii = CheckNumeric(KeyAscii, txtDeanCode)

End Sub

Private Sub txtDeanCode_LostFocus()

If m_intOperation <> BTN_FIND Then
txtDeanCode.Text = Format(txtDeanCode.Text, GENERICCODE_FORMAT)
End If

End Sub

Private Sub txtEmail_GotFocus()

SelectCtl txtEmail
End Sub

Private Sub txtFirstName_GotFocus()

SelectCtl txtFirstName

End Sub

Private Sub txtLastName_GotFocus()

SelectCtl txtLastName

End Sub

Private Sub txtLastName_LostFocus()

If m_intOperation = BTN_FIND Then
cmdSave_Click
End If

End Sub

Private Sub txtUserName_GotFocus()

SelectCtl txtUserName

End Sub

'Pop-up Clients
Private Sub txtGroup_GotFocus()
SelectCtl txtGroup

End Sub

Private Sub txtGroup_LostFocus()

CheckClientsField

End Sub

Private Sub txtGroup_Validate(Cancel As Boolean)

Cancel = ClientSearch(Me, txtGroup.Text)

End Sub

Private Sub cmdGroup_Click()

ClientSearch Me, vbNullString, True
CheckClientsField

End Sub

Private Sub CheckClientsField()

If Clients_Search(1).ClientCode <> vbNullString Then
txtGroup.Text = Clients_Search(1).ClientCode
lblGroupName.Caption = Clients_Search(1).ClientName
End If

End Sub
'End of Pop-up Clients

ROADMAP

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
 m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
MSFlexGrid1.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean, blnFind As
Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint

End Sub

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Course Code|<Course Name|^Pre-requisite|<Pre-requisite Name"
.Rows = 2
.Cols = 4
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

If blnPrint Then Exit Sub
blnPrint = True
MsgBar "Generating Roadmap (Prospectus) Reports. Please wait..."
With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Roadmap (Prospectus) Reports'"
.WindowTitle = "Roadmap (Prospectus) Reports"
.ReportFileName = g_DirectoryReports & "Roadmap.rpt"
.SelectionFormula = "{ROADMAP.GroupCode} = '" & g_strUserGroup & "'"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False
End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraRoadmap.Enabled = False
m_intOperation = BTN_FIND
MSFlexGrid1_Click
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraRoadmap.Enabled = True
EnableOperation m_blnRightsADD, False, False, False, False
EnabledClose False
ClearAllFields Me
txtCourseCode.SetFocus
Case BTN_EDIT 'edit/1
If txtCourseCode <> vbNullString Then
MsgBar MSG_EDIT
fraRoadmap.Enabled = True
EnableOperation False, m_blnRightsEDIT, False, False, False
EnabledClose False
txtCourseCode.SetFocus
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_DELETE 'delete/2
Dim strMsg As String
MsgBar MSG_DELETE
With MSFlexGrid1
strMsg = "Course: " & .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & vbLf & _
"Pre-requisite: " & .TextArray(.Row * .Cols + 2) & "-" & .TextArray(.Row * .Cols + 3) & vbLf & _
"Do you want to delete this record?"
End With
If txtCourseCode <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
End Select

End Sub

Private Sub cmdSave_Click()

'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtCourseCode.Text) = vbNullString Then
MsgBar "Course must not be blank. Please fill-in the field."
txtCourseCode.SetFocus
Exit Sub
End If
If Trim(txtRequisite.Text) = vbNullString Then
 MsgBar "Pre-requisite must not be blank. Please fill-in the field."
txtRequisite.SetFocus
Exit Sub
End If
If Trim(txtCourseCode.Text) = Trim(txtRequisite.Text) Then
MsgBar "Course must not be equal to Pre-requisite. Please correct the problem."
txtRequisite.SetFocus
Exit Sub
End If
End If

'save and load data to grid

Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spRoadmapOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strOldCourseCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(MSFlexGrid1.TextArray(MSFlexGrid1.Row * MSFlexGrid1.Cols + 0)))
.Parameters.Append .CreateParameter("strOldRequisite", adChar, adParamInput, GENERICCODE_LEN,
Trim(MSFlexGrid1.TextArray(MSFlexGrid1.Row * MSFlexGrid1.Cols + 2)))
.Parameters.Append .CreateParameter("strNewCourseCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtCourseCode.Text))
.Parameters.Append .CreateParameter("strNewRequisite", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtRequisite.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("CourseCode")
.Col = 1: .Text = rsTemp.Fields("CourseName")
.Col = 2: .Text = rsTemp.Fields("Prerequisite")
.Col = 3: .Text = rsTemp.Fields("RequisiteName")
If txtCourseCode.Text = rsTemp.Fields("CourseCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
 End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub Form_Load()

fraRoadmap.Top = FrameSet.FTop
fraRoadmap.Left = FrameSet.FLeft
fraRoadmap.Width = FrameSet.FWidth
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraRoadmap.Enabled = False
m_intOperation = BTN_FIND
InitGrid
cmdSave_Click
MSFlexGrid1_Click
DoEvents

End Sub

Private Sub MSFlexGrid1_Click()

With MSFlexGrid1
txtCourseCode.Text = Trim(.TextArray(.Row * .Cols + 0))
lblCourseName.Caption = Trim(.TextArray(.Row * .Cols + 1))
txtRequisite.Text = Trim(.TextArray(.Row * .Cols + 2))
lblRequisite.Caption = Trim(.TextArray(.Row * .Cols + 3))
If m_intOperation = BTN_EDIT Then
SelectCtl txtCourseCode
End If
End With
MsgBar vbNullString

End Sub

Private Sub MSFlexGrid1_SelChange()

MSFlexGrid1_Click

End Sub

'Pop-up Courses
Private Sub txtCourseCode_GotFocus()
SelectCtl txtCourseCode

End Sub

Private Sub txtCourseCode_LostFocus()

CheckCoursesField

End Sub

Private Sub txtCourseCode_Validate(Cancel As Boolean)

Cancel = CourseSearch(Me, txtCourseCode.Text)

End Sub

Private Sub cmdCourse_Click()

CourseSearch Me, vbNullString, True
CheckCoursesField

End Sub

Private Sub CheckCoursesField()

If Courses_Search(1).CourseCode <> vbNullString Then
txtCourseCode.Text = Courses_Search(1).CourseCode
 lblCourseName.Caption = Courses_Search(1).CourseName
End If

End Sub
'End of Pop-up Course

'Pop-up Pre-requisites
Private Sub txtRequisite_GotFocus()
SelectCtl txtRequisite

End Sub

Private Sub txtRequisite_LostFocus()

CheckRequisitesField

End Sub

Private Sub txtRequisite_Validate(Cancel As Boolean)

Cancel = RequisiteSearch(Me, txtRequisite.Text)

End Sub

Private Sub cmdRequisite_Click()

RequisiteSearch Me, vbNullString, True
CheckRequisitesField

End Sub

Private Sub CheckRequisitesField()

If Courses_Search(1).CourseCode <> vbNullString Then
txtRequisite.Text = Courses_Search(1).CourseCode
lblRequisite.Caption = Courses_Search(1).CourseName
End If

End Sub
'End of Pop-up Pre-Requisite

TRAINEE

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
MSFlexGrid1.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean, blnFind As
Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint
 cmdOperation(4).Enabled = blnFind

End Sub

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Trainee Code|<First Name|^MI|<Last Name|<Email Address|^Group Code|<Group Name"
.Rows = 2
.Cols = 7
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 375
.ColWidth(3) = 4005
.ColWidth(4) = 4005
.ColWidth(5) = 1100
.ColWidth(6) = 4005
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

If blnPrint Then Exit Sub
blnPrint = True
MsgBar "Generating Trainees Reports. Please wait..."
With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Trainees Reports'"
.WindowTitle = "Trainees Reports"
.ReportFileName = g_DirectoryReports & "Trainees.rpt"
.SelectionFormula = "{TRAINEES.GroupCode} = '" & g_strUserGroup & "'"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraTrainees.Enabled = False
txtTraineeCode.Locked = False
m_intOperation = BTN_FIND
MSFlexGrid1_Click
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

 MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraTrainees.Enabled = True
EnableOperation m_blnRightsADD, False, False, False, False
EnabledClose False
ClearAllFields Me
txtTraineeCode.Text = CreateSystemCode(C0D_TRAINEE)
txtTraineeCode.SetFocus
Case BTN_EDIT 'edit/1
If txtTraineeCode <> vbNullString Then
MsgBar MSG_EDIT
fraTrainees.Enabled = True
txtTraineeCode.Locked = True
EnableOperation False, m_blnRightsEDIT, False, False, False
EnabledClose False
txtFirstName.SetFocus
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_DELETE 'delete/2
If CheckIfCanBeDelete(C0D_TRAINEE, Trim(txtTraineeCode.Text)) Then
MsgBar MSG_CANTDELETE
m_intOperation = BTN_FIND
Exit Sub
End If
Dim strMsg As String
MsgBar MSG_DELETE
With MSFlexGrid1
strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & " " & .TextArray(.Row * .Cols + 3) & vbLf
&_
"Do you want to delete this record?"
End With
If txtTraineeCode <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
Case BTN_FIND 'find/4
MsgBar MSG_FIND
fraTrainees.Enabled = True
EnableOperation False, False, False, False, True
cmdCancel.Enabled = True
ClearAllFields Me
txtTraineeCode.SetFocus
End Select

End Sub

Private Sub cmdSave_Click()

'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtTraineeCode.Text) = vbNullString Then
MsgBar "Trainee code must not be blank. Please fill-in the field."
txtTraineeCode.SetFocus
Exit Sub
End If
If Trim(txtFirstName.Text) = vbNullString Then
 MsgBar "First name must not be blank. Please fill-in the field."
txtFirstName.SetFocus
Exit Sub
End If
If Trim(txtLastName.Text) = vbNullString Then
MsgBar "Last name must not be blank. Please fill-in the field."
txtLastName.SetFocus
Exit Sub
End If
If Trim(txtGroup.Text) = vbNullString Then
MsgBar "Group/Company must not be blank. Please fill-in the field."
txtGroup.SetFocus
Exit Sub
End If
If Trim(txtEmail.Text) <> vbNullString Then
If InStr(txtEmail.Text, "@") = 0 Or _
InStr(txtEmail.Text, ".") = 0 Or _
Len(txtEmail.Text) < 7 Then
MsgBar "Please specify a valid e-mail address! Please fill-in the field."
txtEmail.SetFocus
Exit Sub
End If
End If
End If

'save and load data to grid

Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spTraineeOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTraineeCode.Text))
.Parameters.Append .CreateParameter("strFirstName", adVarChar, adParamInput, 30, Trim(txtFirstName.Text))
.Parameters.Append .CreateParameter("strMidleInit", adVarChar, adParamInput, 3, Trim(txtMI.Text))
.Parameters.Append .CreateParameter("strLastName", adVarChar, adParamInput, 30, Trim(txtLastName.Text))
.Parameters.Append .CreateParameter("strEmail", adVarChar, adParamInput, 50, Trim(txtEmail.Text))
.Parameters.Append .CreateParameter("strCompany", adVarChar, adParamInput, GENERICCODE_LEN, Trim(txtGroup.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("TraineeCode")
.Col = 1: .Text = rsTemp.Fields("FirstName")
 .Col = 2: .Text = rsTemp.Fields("MidleInit")
.Col = 3: .Text = rsTemp.Fields("LastName")
.Col = 4: .Text = rsTemp.Fields("Email")
.Col = 5: .Text = rsTemp.Fields("Company")
.Col = 6: .Text = rsTemp.Fields("CompanyName")
If txtTraineeCode.Text = rsTemp.Fields("TraineeCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub Form_Load()

fraTrainees.Top = FrameSet.FTop
fraTrainees.Left = FrameSet.FLeft
fraTrainees.Width = FrameSet.FWidth
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraTrainees.Enabled = False
m_intOperation = BTN_FIND
InitGrid
cmdSave_Click
MSFlexGrid1_Click
DoEvents

End Sub

Private Sub MSFlexGrid1_Click()

With MSFlexGrid1
txtTraineeCode.Text = Trim(.TextArray(.Row * .Cols + 0))
txtFirstName.Text = Trim(.TextArray(.Row * .Cols + 1))
txtMI.Text = Trim(.TextArray(.Row * .Cols + 2))
txtLastName.Text = Trim(.TextArray(.Row * .Cols + 3))
txtEmail.Text = Trim(.TextArray(.Row * .Cols + 4))
txtGroup.Text = Trim(.TextArray(.Row * .Cols + 5))
lblGroupName.Caption = Trim(.TextArray(.Row * .Cols + 6))
If m_intOperation = BTN_EDIT Then
SelectCtl txtFirstName
End If
End With
MsgBar vbNullString

End Sub

Private Sub MSFlexGrid1_SelChange()

MSFlexGrid1_Click

End Sub

Private Sub txtEmail_GotFocus()

SelectCtl txtEmail

End Sub

Private Sub txtFirstName_GotFocus()

 SelectCtl txtFirstName

End Sub

Private Sub txtLastName_GotFocus()

SelectCtl txtLastName

End Sub

Private Sub txtLastName_LostFocus()

If m_intOperation = BTN_FIND Then
cmdSave_Click
End If

End Sub

Private Sub txtMI_GotFocus()

SelectCtl txtMI

End Sub

Private Sub txtTraineeCode_GotFocus()

SelectCtl txtTraineeCode

End Sub

Private Sub txtTraineeCode_KeyPress(KeyAscii As Integer)

KeyAscii = CheckNumeric(KeyAscii, txtTraineeCode)

End Sub

Private Sub txtTraineeCode_LostFocus()

If m_intOperation <> BTN_FIND Then
txtTraineeCode.Text = Format(txtTraineeCode.Text, GENERICCODE_FORMAT)
End If

End Sub

'Pop-up clients
Private Sub txtGroup_GotFocus()
SelectCtl txtGroup

End Sub

Private Sub txtGroup_LostFocus()

CheckClientsField

End Sub

Private Sub txtGroup_Validate(Cancel As Boolean)

Cancel = ClientSearch(Me, txtGroup.Text)

End Sub

Private Sub cmdGroup_Click()

ClientSearch Me, vbNullString, True
CheckClientsField

End Sub

Private Sub CheckClientsField()

If Clients_Search(1).ClientCode <> vbNullString Then
txtGroup.Text = Clients_Search(1).ClientCode
lblGroupName.Caption = Clients_Search(1).ClientName
End If

End Sub
'End of Pop-up clients
TRAINER

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
MSFlexGrid1.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean, blnFind As
Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint
cmdOperation(4).Enabled = blnFind

End Sub

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Trainer Code|<First Name|^MI|<Last Name|<Title|<Specialization|<Telephone No.|<Email Address"
.Rows = 2
.Cols = 8
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 500
.ColWidth(3) = 4005
.ColWidth(4) = 4005
.ColWidth(5) = 4005
.ColWidth(6) = 1590
.ColWidth(7) = 4005
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

If blnPrint Then Exit Sub
blnPrint = True
MsgBar "Generating Trainers Reports. Please wait..."
 With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Trainers Reports'"
.WindowTitle = "Trainers Reports"
.ReportFileName = g_DirectoryReports & "Trainers.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraTrainers.Enabled = False
txtTrainerCode.Locked = False
m_intOperation = BTN_FIND
MSFlexGrid1_Click
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraTrainers.Enabled = True
EnableOperation m_blnRightsADD, False, False, False, False
EnabledClose False
ClearAllFields Me
txtTrainerCode.Text = CreateSystemCode(C0D_TRAINER)
txtTrainerCode.SetFocus
Case BTN_EDIT 'edit/1
If txtTrainerCode <> vbNullString Then
MsgBar MSG_EDIT
fraTrainers.Enabled = True
txtTrainerCode.Locked = True
EnableOperation False, m_blnRightsEDIT, False, False, False
EnabledClose False
txtFirstName.SetFocus
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_DELETE 'delete/2
If CheckIfCanBeDelete(C0D_TRAINER, Trim(txtTrainerCode.Text)) Then
MsgBar MSG_CANTDELETE
m_intOperation = BTN_FIND
Exit Sub
End If
Dim strMsg As String
MsgBar MSG_DELETE
With MSFlexGrid1
 strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & " " & .TextArray(.Row * .Cols + 2) & vbLf
&_
"Do you want to delete this record?"
End With
If txtTrainerCode <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
Case BTN_FIND 'find/4
MsgBar MSG_FIND
fraTrainers.Enabled = True
EnableOperation False, False, False, False, True
cmdCancel.Enabled = True
ClearAllFields Me
txtTrainerCode.SetFocus
End Select

End Sub

Private Sub cmdSave_Click()

'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtTrainerCode.Text) = vbNullString Then
MsgBar "Trainer code must not be blank. Please fill-in the field."
txtTrainerCode.SetFocus
Exit Sub
End If
If Trim(txtFirstName.Text) = vbNullString Then
MsgBar "First name must not be blank. Please fill-in the field."
txtFirstName.SetFocus
Exit Sub
End If
If Trim(txtLastName.Text) = vbNullString Then
MsgBar "Last name must not be blank. Please fill-in the field."
txtLastName.SetFocus
Exit Sub
End If
If Trim(txtEMail.Text) <> vbNullString Then
If InStr(txtEMail.Text, "@") = 0 Or _
InStr(txtEMail.Text, ".") = 0 Or _
Len(txtEMail.Text) < 7 Then
MsgBar "Please specify a valid e-mail address! Please fill-in the field."
txtEMail.SetFocus
Exit Sub
End If
End If
End If

'save and load data to grid

Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spTrainerOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
 .Parameters.Append .CreateParameter("strTrainerCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTrainerCode.Text))
.Parameters.Append .CreateParameter("strFirstName", adVarChar, adParamInput, 30, Trim(txtFirstName.Text))
.Parameters.Append .CreateParameter("strMiddleInit", adVarChar, adParamInput, 3, Trim(txtMI.Text))
.Parameters.Append .CreateParameter("strLastName", adVarChar, adParamInput, 30, Trim(txtLastName.Text))
.Parameters.Append .CreateParameter("strTitle", adVarChar, adParamInput, 50, Trim(txtTitle.Text))
.Parameters.Append .CreateParameter("strSpecialized", adVarChar, adParamInput, 250, Trim(txtSpecialization.Text))
.Parameters.Append .CreateParameter("strTelNum", adVarChar, adParamInput, 50, Trim(txtTelNum.Text))
.Parameters.Append .CreateParameter("strEmail", adVarChar, adParamInput, 50, Trim(txtEMail.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("TrainerCode")
.Col = 1: .Text = rsTemp.Fields("FirstName")
.Col = 2: .Text = rsTemp.Fields("MiddleInit")
.Col = 3: .Text = rsTemp.Fields("LastName")
.Col = 4: .Text = rsTemp.Fields("Title")
.Col = 5: .Text = rsTemp.Fields("Specialized")
.Col = 6: .Text = rsTemp.Fields("TelNumber")
.Col = 7: .Text = rsTemp.Fields("Email")
If txtTrainerCode.Text = rsTemp.Fields("TrainerCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub Form_Load()

fraTrainers.Top = FrameSet.FTop
fraTrainers.Left = FrameSet.FLeft
fraTrainers.Width = FrameSet.FWidth
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraTrainers.Enabled = False
m_intOperation = BTN_FIND
InitGrid
cmdSave_Click
MSFlexGrid1_Click
DoEvents
End Sub

Private Sub MSFlexGrid1_Click()

With MSFlexGrid1
txtTrainerCode.Text = Trim(.TextArray(.Row * .Cols + 0))
txtFirstName.Text = Trim(.TextArray(.Row * .Cols + 1))
txtMI.Text = Trim(.TextArray(.Row * .Cols + 2))
txtLastName.Text = Trim(.TextArray(.Row * .Cols + 3))
txtTitle.Text = Trim(.TextArray(.Row * .Cols + 4))
txtSpecialization.Text = Trim(.TextArray(.Row * .Cols + 5))
txtTelNum.Text = Trim(.TextArray(.Row * .Cols + 6))
txtEMail.Text = Trim(.TextArray(.Row * .Cols + 7))
If m_intOperation = BTN_EDIT Then
SelectCtl txtFirstName
End If
End With
MsgBar vbNullString

End Sub

Private Sub MSFlexGrid1_SelChange()

MSFlexGrid1_Click

End Sub

Private Sub txtEmail_GotFocus()

SelectCtl txtEMail

End Sub

Private Sub txtFirstName_GotFocus()

SelectCtl txtFirstName

End Sub

Private Sub txtLastName_GotFocus()

SelectCtl txtLastName

End Sub

Private Sub txtLastName_LostFocus()

If m_intOperation = BTN_FIND Then
cmdSave_Click
End If

End Sub

Private Sub txtMI_GotFocus()

SelectCtl txtMI

End Sub

Private Sub txtSpecialization_GotFocus()

SelectCtl txtSpecialization

End Sub

Private Sub txtTelNum_GotFocus()

SelectCtl txtTelNum

End Sub

Private Sub txtTitle_GotFocus()

SelectCtl txtTitle

End Sub

Private Sub txtTrainerCode_GotFocus()

SelectCtl txtTrainerCode
End Sub

Private Sub txtTrainerCode_KeyPress(KeyAscii As Integer)

KeyAscii = CheckNumeric(KeyAscii, txtTrainerCode)

End Sub

Private Sub txtTrainerCode_LostFocus()

If m_intOperation <> BTN_FIND Then
txtTrainerCode.Text = Format(txtTrainerCode.Text, GENERICCODE_FORMAT)
End If

End Sub

TRAINING COURSES

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub CheckBoxDay()

'clear CheckBoxes...
Dim X As Integer
Dim y As Integer
For X = 1 To (chkDay.UBound)
chkDay(X).Enabled = False
Next X
'display CheckBoxes...
For X = 1 To (dtpToDate.value - dtpFrDate.value) + 1
For y = 1 To (chkDay.UBound)
If Format((dtpFrDate.value + X - 1), "dddd") = chkDay(y).Caption Then
chkDay(y).Enabled = True
End If
Next y
Next X
End Sub

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
MSFlexGrid1.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean, blnFind As
Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint
cmdOperation(4).Enabled = blnFind

End Sub
Private Sub InitGrid()
Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Training Code|<Training Name|^Course Code|<Course Name|^Venue Code|<Description|^Trainer
Code|<Trainer Name|^Training Status|^Trainee(s) per group|^From|^To|^Time|<Days"
.Rows = 2
.Cols = 16
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 1215
.ColWidth(1) = 4005
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.ColWidth(4) = 1100
.ColWidth(5) = 4005
.ColWidth(6) = 1215
.ColWidth(7) = 4005
.ColWidth(8) = 1380
.ColWidth(9) = 1890
.ColWidth(10) = 1100
.ColWidth(11) = 1100
.ColWidth(12) = 1620
.ColWidth(13) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

If blnPrint Then Exit Sub
blnPrint = True
MsgBar "Generating Training Courses Reports. Please wait..."
With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Training Courses Reports'"
.WindowTitle = "Training Courses Reports"
.ReportFileName = g_DirectoryReports & "TrainingCourses.rpt"
.SelectionFormula = "{vwM_TrainingCourses.GroupCode} = '" & g_strUserGroup & "'"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraTrainingCourse.Enabled = False
txtTrainingCourse.Locked = False
m_intOperation = BTN_FIND
MSFlexGrid1_Click
MsgBar vbNullString
End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraTrainingCourse.Enabled = True
EnableOperation m_blnRightsADD, False, False, False, False
EnabledClose False
ClearAllFields Me
dtpFrDate_Change
txtTrainingCourse.Text = CreateSystemCode(C0D_TRAINING)
txtTrainingCourse.SetFocus
Case BTN_EDIT 'edit/1
If txtTrainingCourse <> vbNullString Then
CheckBoxDay
MsgBar MSG_EDIT
fraTrainingCourse.Enabled = True
txtTrainingCourse.Locked = True
EnableOperation False, m_blnRightsEDIT, False, False, False
EnabledClose False
txtTrainingName.SetFocus
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_DELETE 'delete/2
If CheckIfCanBeDelete(C0D_TRAINING, Trim(txtTrainingCourse.Text)) Then
MsgBar MSG_CANTDELETE
m_intOperation = BTN_FIND
Exit Sub
End If
Dim strMsg As String
MsgBar MSG_DELETE
With MSFlexGrid1
strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & vbLf & _
"Do you want to delete this record?"
End With
If txtTrainingCourse <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
Case BTN_FIND 'find/4
MsgBar MSG_FIND
fraTrainingCourse.Enabled = True
EnableOperation False, False, False, False, True
cmdCancel.Enabled = True
ClearAllFields Me
txtTrainingCourse.SetFocus
End Select

End Sub

Private Sub cmdSave_Click()

'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtTrainingCourse.Text) = vbNullString Then
 MsgBar "Training Course must not be blank. Please fill-in the field."
txtTrainingCourse.SetFocus
Exit Sub
End If
If Trim(txtTrainingName.Text) = vbNullString Then
MsgBar "Training Name must not be blank. Please fill-in the field."
txtTrainingName.SetFocus
Exit Sub
End If
If Trim(txtCourseCode.Text) = vbNullString Then
MsgBar "Course must not be blank. Please fill-in the field."
txtCourseCode.SetFocus
Exit Sub
End If
If Trim(txtVenueCode.Text) = vbNullString Then
MsgBar "Venue must not be blank. Please fill-in the field."
txtVenueCode.SetFocus
Exit Sub
End If
If Trim(txtTrainerCode.Text) = vbNullString Then
MsgBar "Trainer must not be blank. Please fill-in the field."
txtTrainerCode.SetFocus
Exit Sub
End If
If Val(txtNoOfTrainee.Text) = 0 Then
MsgBar "No. of Trainees per school must not be zero. Please fill-in the field."
txtNoOfTrainee.SetFocus
Exit Sub
End If
If dtpFrDate.value > dtpToDate.value Then
MsgBar "Invalid Schedule dates. Please correct the problem."
dtpToDate.SetFocus
Exit Sub
End If
'check if trainer is blacklisted or not
If (m_intOperation = BTN_ADD Or m_intOperation = BTN_EDIT) Then
Dim rsBlacklist As ADODB.Recordset
Set rsBlacklist = New ADODB.Recordset
Set rsBlacklist = CheckBlacklisted("R", Trim(txtTrainerCode.Text))
If Not rsBlacklist.EOF Then
MsgBox rsBlacklist.Fields("TraineeCode") & " - " & rsBlacklist.Fields("TraineeName") & " is blacklisted until " &
Format(rsBlacklist.Fields("SanctionDate"), LONGDATE_FORMAT) & Chr(10) & _
"due to " & rsBlacklist.Fields("Reason"), vbCritical
Set rsBlacklist = Nothing
txtTrainerCode.SetFocus
Exit Sub
End If
Set rsBlacklist = Nothing
End If
End If
'get CheckBoxes...
Dim X As Integer
Dim strDays As String
For X = 1 To chkDay.UBound
strDays = strDays & chkDay(X)
Next X
'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spTrainingCourseOperation"
 .CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCourse", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTrainingCourse.Text))
.Parameters.Append .CreateParameter("strTrainingName", adVarChar, adParamInput, 50, Trim(txtTrainingName.Text))
.Parameters.Append .CreateParameter("strCourseCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtCourseCode.Text))
.Parameters.Append .CreateParameter("strVenueCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtVenueCode.Text))
.Parameters.Append .CreateParameter("strTrainerCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTrainerCode.Text))
.Parameters.Append .CreateParameter("strStatus", adVarChar, adParamInput, 25, Trim(cboTrainingStatus.Text))
.Parameters.Append .CreateParameter("intNoOfTrainee", adInteger, adParamInput, 2, Val(txtNoOfTrainee.Text))
.Parameters.Append .CreateParameter("strFrDate", adChar, adParamInput, 10, Format(dtpFrDate.value, DATE_FORMAT))
.Parameters.Append .CreateParameter("strToDate", adChar, adParamInput, 10, Format(dtpToDate.value, DATE_FORMAT))
.Parameters.Append .CreateParameter("strTime", adVarChar, adParamInput, 30, Trim(cboTime.Text))
.Parameters.Append .CreateParameter("strDays", adVarChar, adParamInput, 10, Trim(strDays))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("TrainingCode")
.Col = 1: .Text = rsTemp.Fields("TrainingName")
.Col = 2: .Text = rsTemp.Fields("CourseCode")
.Col = 3: .Text = rsTemp.Fields("CourseName")
.Col = 4: .Text = rsTemp.Fields("VenueCode")
.Col = 5: .Text = rsTemp.Fields("VenueName")
.Col = 6: .Text = rsTemp.Fields("TrainerCode")
.Col = 7: .Text = rsTemp.Fields("FirstName") & " " & rsTemp.Fields("LastName")
.Col = 8: .Text = rsTemp.Fields("Status")
.Col = 9: .Text = rsTemp.Fields("NoOfTrainee")
.Col = 10: .Text = Format(rsTemp.Fields("ScheduleFrom"), DATE_FORMAT)
.Col = 11: .Text = Format(rsTemp.Fields("ScheduleTo"), DATE_FORMAT)
.Col = 12: .Text = rsTemp.Fields("ScheduleTime")
.Col = 13: .Text = rsTemp.Fields("ScheduleDays")
If txtTrainingCourse.Text = rsTemp.Fields("TrainingCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing
End Sub

Private Sub dtpFrDate_Change()

If dtpFrDate.value > dtpToDate.value Then
dtpToDate.value = dtpFrDate.value
End If
'clear CheckBoxes...
Dim X As Integer
Dim y As Integer
For X = 1 To (chkDay.UBound)
chkDay(X) = 0
chkDay(X).Enabled = False
Next X
'display CheckBoxes...
For X = 1 To (dtpToDate.value - dtpFrDate.value) + 1
For y = 1 To (chkDay.UBound)
If Format((dtpFrDate.value + X - 1), "dddd") = chkDay(y).Caption Then
chkDay(y) = 1
chkDay(y).Enabled = True
End If
Next y
Next X
End Sub

Private Sub dtpToDate_Change()

If dtpFrDate.value > dtpToDate.value Then
dtpFrDate.value = dtpToDate.value
End If
'clear CheckBoxes...
Dim X As Integer
Dim y As Integer
For X = 1 To (chkDay.UBound)
chkDay(X) = 0
chkDay(X).Enabled = False
Next X
'display CheckBoxes...
For X = 1 To (dtpToDate.value - dtpFrDate.value) + 1
For y = 1 To (chkDay.UBound)
If Format((dtpFrDate.value + X - 1), "dddd") = chkDay(y).Caption Then
chkDay(y) = 1
chkDay(y).Enabled = True
End If
Next y
Next X

End Sub

Private Sub Form_Load()

fraTrainingCourse.Top = FrameSet.FTop
fraTrainingCourse.Left = FrameSet.FLeft
fraTrainingCourse.Width = FrameSet.FWidth
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraTrainingCourse.Enabled = False
m_intOperation = BTN_FIND
GetTrainingStatusItem cboTrainingStatus
GetTimeItem cboTime
InitGrid
cmdSave_Click
MSFlexGrid1_Click
DoEvents

End Sub

Private Sub MSFlexGrid1_Click()

With MSFlexGrid1
txtTrainingCourse.Text = Trim(.TextArray(.Row * .Cols + 0))
txtTrainingName.Text = Trim(.TextArray(.Row * .Cols + 1))
txtCourseCode.Text = Trim(.TextArray(.Row * .Cols + 2))
 lblCourseName.Caption = Trim(.TextArray(.Row * .Cols + 3))
txtVenueCode.Text = Trim(.TextArray(.Row * .Cols + 4))
lblVenueName.Caption = Trim(.TextArray(.Row * .Cols + 5))
txtTrainerCode.Text = Trim(.TextArray(.Row * .Cols + 6))
lblTrainerName.Caption = Trim(.TextArray(.Row * .Cols + 7))
SetCurrentItem cboTrainingStatus, Trim(.TextArray(.Row * .Cols + 8))
txtNoOfTrainee = Trim(.TextArray(.Row * .Cols + 9))
dtpFrDate.value = CheckDate(.TextArray(.Row * .Cols + 10))
dtpToDate.value = CheckDate(.TextArray(.Row * .Cols + 11))
SetCurrentItem cboTime, Trim(.TextArray(.Row * .Cols + 12))
'display CheckBoxes...
Dim X As Integer
Dim strDays As String
strDays = PadL(Trim(.TextArray(.Row * .Cols + 13)), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
chkDay(X).Enabled = chkDay(X)
Next X
If m_intOperation = BTN_EDIT Then
SelectCtl txtCourseCode
End If
End With
MsgBar vbNullString
DoEvents

End Sub

Private Sub MSFlexGrid1_SelChange()

MSFlexGrid1_Click

End Sub

'Pop-up Courses
Private Sub txtCourseCode_GotFocus()
SelectCtl txtCourseCode

End Sub

Private Sub txtCourseCode_LostFocus()

CheckCoursesField

End Sub

Private Sub txtCourseCode_Validate(Cancel As Boolean)

Cancel = CourseSearch(Me, txtCourseCode.Text)

End Sub

Private Sub cmdCourse_Click()

CourseSearch Me, vbNullString, True
CheckCoursesField

End Sub

Private Sub CheckCoursesField()

If Courses_Search(1).CourseCode <> vbNullString Then
txtCourseCode.Text = Courses_Search(1).CourseCode
lblCourseName.Caption = Courses_Search(1).CourseName
End If

End Sub
'End of Pop-up Course

Private Sub txtNoOfTrainee_GotFocus()

SelectCtl txtNoOfTrainee

End Sub

Private Sub txtNoOfTrainee_KeyPress(KeyAscii As Integer)

KeyAscii = CheckNumeric(KeyAscii, txtNoOfTrainee)
End Sub

'Pop-up Trainers
Private Sub txtTrainerCode_GotFocus()
SelectCtl txtTrainerCode

End Sub

Private Sub txtTrainerCode_LostFocus()

CheckTrainersField

End Sub

Private Sub txtTrainerCode_Validate(Cancel As Boolean)

Cancel = TrainerSearch(Me, txtTrainerCode.Text)

End Sub

Private Sub cmdTrainer_Click()

TrainerSearch Me, vbNullString, True
CheckTrainersField

End Sub

Private Sub CheckTrainersField()

If Trainers_Search(1).TrainerCode <> vbNullString Then
txtTrainerCode.Text = Trainers_Search(1).TrainerCode
lblTrainerName.Caption = Trainers_Search(1).TrainerName
End If

End Sub
'End of Pop-up Trainer

Private Sub txtTrainingCourse_GotFocus()

SelectCtl txtTrainingCourse

End Sub

Private Sub txtTrainingCourse_KeyPress(KeyAscii As Integer)

KeyAscii = CheckNumeric(KeyAscii, txtTrainingCourse)

End Sub

Private Sub txtTrainingCourse_LostFocus()

If m_intOperation <> BTN_FIND Then
txtTrainingCourse.Text = Format(txtTrainingCourse.Text, GENERICCODE_FORMAT)
End If

End Sub

Private Sub txtTrainingName_GotFocus()

SelectCtl txtTrainingName

End Sub

Private Sub txtTrainingName_LostFocus()

If m_intOperation = BTN_FIND Then
cmdSave_Click
End If

End Sub

'Pop-up venues
Private Sub txtVenueCode_GotFocus()
SelectCtl txtVenueCode

End Sub

Private Sub txtVenueCode_LostFocus()

 CheckVenuesField

End Sub

Private Sub txtVenueCode_Validate(Cancel As Boolean)

Cancel = VenueSearch(Me, txtVenueCode.Text)

End Sub

Private Sub cmdVenue_Click()

VenueSearch Me, vbNullString, True
CheckVenuesField

End Sub

Private Sub CheckVenuesField()

If Venues_Search(1).VenueCode <> vbNullString Then
txtVenueCode.Text = Venues_Search(1).VenueCode
lblVenueName.Caption = Venues_Search(1).VenueName
End If

End Sub
'End of Pop-up venue

VENUE

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
MSFlexGrid1.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean, blnFind As
Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint
cmdOperation(4).Enabled = blnFind

End Sub

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "^Venue Code|<Description|<Address|^No. of Seats"
.Rows = 2
.Cols = 4
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
 .SelectionMode = flexSelectionFree
.ColWidth(0) = 1100
.ColWidth(1) = 4005
.ColWidth(2) = 6000
.ColWidth(3) = 1100
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

If blnPrint Then Exit Sub
blnPrint = True
MsgBar "Generating Venue Reports. Please wait..."
With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Venue Reports'"
.WindowTitle = "Venue Reports"
.ReportFileName = g_DirectoryReports & "Venue.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraVenues.Enabled = False
txtVenueCode.Locked = False
m_intOperation = BTN_FIND
MSFlexGrid1_Click
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraVenues.Enabled = True
EnableOperation m_blnRightsADD, False, False, False, False
EnabledClose False
ClearAllFields Me
txtVenueCode.Text = CreateSystemCode(C0D_VENUE)
txtVenueCode.SetFocus
 Case BTN_EDIT 'edit/1
If txtVenueCode <> vbNullString Then
MsgBar MSG_EDIT
fraVenues.Enabled = True
txtVenueCode.Locked = True
EnableOperation False, m_blnRightsEDIT, False, False, False
EnabledClose False
txtVenueName.SetFocus
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_DELETE 'delete/2
If CheckIfCanBeDelete(C0D_VENUE, Trim(txtVenueCode.Text)) Then
MsgBar MSG_CANTDELETE
m_intOperation = BTN_FIND
Exit Sub
End If
Dim strMsg As String
MsgBar MSG_DELETE
With MSFlexGrid1
strMsg = .TextArray(.Row * .Cols + 0) & "-" & .TextArray(.Row * .Cols + 1) & vbLf & _
"Do you want to delete this record?"
End With
If txtVenueCode <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
Case BTN_FIND 'find/4
MsgBar MSG_FIND
fraVenues.Enabled = True
EnableOperation False, False, False, False, True
cmdCancel.Enabled = True
ClearAllFields Me
txtVenueCode.SetFocus
End Select

End Sub

Private Sub cmdSave_Click()

'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtVenueCode.Text) = vbNullString Then
MsgBar "Venue code must not be blank. Please fill-in the field."
txtVenueCode.SetFocus
Exit Sub
End If
If Trim(txtVenueName.Text) = vbNullString Then
MsgBar "Venue name must not be blank. Please fill-in the field."
txtVenueName.SetFocus
Exit Sub
End If
End If

'save and load data to grid

Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
 With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spVenueOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strVenueCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtVenueCode.Text))
.Parameters.Append .CreateParameter("strVenueName", adVarChar, adParamInput, 50, Trim(txtVenueName.Text))
.Parameters.Append .CreateParameter("strAddress", adVarChar, adParamInput, 100, Trim(txtAddress.Text))
.Parameters.Append .CreateParameter("intSeats", adInteger, adParamInput, 4, Val(txtSeats.Text))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("VenueCode")
.Col = 1: .Text = rsTemp.Fields("VenueName")
.Col = 2: .Text = rsTemp.Fields("Address")
.Col = 3: .Text = rsTemp.Fields("Seats")
If txtVenueCode.Text = rsTemp.Fields("VenueCode") Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub Form_Load()

fraVenues.Top = FrameSet.FTop
fraVenues.Left = FrameSet.FLeft
fraVenues.Width = FrameSet.FWidth
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraVenues.Enabled = False
m_intOperation = BTN_FIND
InitGrid
cmdSave_Click
MSFlexGrid1_Click
DoEvents

End Sub
Private Sub MSFlexGrid1_Click()
With MSFlexGrid1
txtVenueCode.Text = Trim(.TextArray(.Row * .Cols + 0))
txtVenueName.Text = Trim(.TextArray(.Row * .Cols + 1))
txtAddress.Text = Trim(.TextArray(.Row * .Cols + 2))
txtSeats.Text = Trim(.TextArray(.Row * .Cols + 3))
If m_intOperation = BTN_EDIT Then
SelectCtl txtVenueName
End If
End With
MsgBar vbNullString

End Sub

Private Sub MSFlexGrid1_SelChange()

MSFlexGrid1_Click

End Sub

Private Sub txtAddress_GotFocus()

SelectCtl txtAddress

End Sub

Private Sub txtSeats_GotFocus()

SelectCtl txtSeats

End Sub

Private Sub txtSeats_KeyPress(KeyAscii As Integer)

KeyAscii = CheckNumeric(KeyAscii, txtSeats)

End Sub

Private Sub txtVenueCode_GotFocus()

SelectCtl txtVenueCode

End Sub

Private Sub txtVenueCode_KeyPress(KeyAscii As Integer)

KeyAscii = CheckNumeric(KeyAscii, txtVenueCode)

End Sub

Private Sub txtVenueCode_LostFocus()

If m_intOperation <> BTN_FIND Then
txtVenueCode.Text = Format(txtVenueCode.Text, GENERICCODE_FORMAT)
End If

End Sub

Private Sub txtVenueName_GotFocus()

SelectCtl txtVenueName

End Sub

Private Sub txtVenueName_LostFocus()

If m_intOperation = BTN_FIND Then
cmdSave_Click
End If

End Sub

REPORTS CODES

ATTENDANCE

Option Explicit
Dim blnPrint As Boolean
Private Sub cmdClose_Click()
MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

Dim strX As String, strY As String
If Trim(txtTrainingCode.Text) = vbNullString Then
MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

blnPrint = True

MsgBar "Generating Grades Report. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.WindowTitle = "Grades Report"
.SelectionFormula = "{PreRegistration.GroupCode} = '" & g_strUserGroup & "' AND {PreRegistration.TrainingCode} = '" &
txtTrainingCode.Text & "'"
If (dtpToDate.value - dtpFrDate.value) + 1 > 5 Then
MsgBox "Out of range!"
Else
strX = (dtpToDate.value - dtpFrDate.value) + 1
End If
If cboTime.Text = "08:00AM-05:00PM" Then
strY = "2"
Else
strY = "1"
End If
.ReportFileName = g_DirectoryReports & "R_Attendance" & strX & strY & ".rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

GetTimeItem cboTime

End Sub

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer

CheckTrainingCoursesField
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

 Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
Dim strDays As String
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
End If

End Sub
'End of Pop-up Training Course

CERTIFICATE

Option Explicit
Dim blnPrint As Boolean
Dim m_strTrainingCode As String

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtTrainingCode.Text) = vbNullString Then
MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If
If txtGroup.Enabled And Trim(txtGroup.Text) = vbNullString Then
MsgBar "Group/Company code must not be blank. Please fill-in the field."
txtGroup.SetFocus
Exit Sub
End If
If txtTraineeCode.Enabled And Trim(txtTraineeCode.Text) = vbNullString Then
MsgBar "Trainee code must not be blank. Please fill-in the field."
txtTraineeCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

blnPrint = True

MsgBar "Generating Training Certificates. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
 .WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.WindowTitle = "Training Certificate"
If optPrintMode(0) Then
.SelectionFormula = "{Grades.GroupCode} = '" & g_strUserGroup & "' AND {Grades.TrainingCode} = '" &
txtTrainingCode.Text & "' AND {Trainees.Company} = '" & txtGroup.Text & "' AND {Grades.Pass} = '" & strYES & "'"
ElseIf optPrintMode(1) Then
.SelectionFormula = "{Grades.GroupCode} = '" & g_strUserGroup & "' AND {Grades.TrainingCode} = '" &
txtTrainingCode.Text & "' AND {Grades.TraineeCode} = '" & txtTraineeCode.Text & "' AND {Grades.Pass} = '" & strYES & "'"
Else
.SelectionFormula = "{Grades.GroupCode} = '" & g_strUserGroup & "' AND {Grades.TrainingCode} = '" &
txtTrainingCode.Text & "' AND {Grades.Pass} = '" & strYES & "'"
End If
.ReportFileName = g_DirectoryReports & "R_Certificate.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

optPrintMode_Click 0
GetTimeItem cboTime

End Sub

Private Sub optPrintMode_Click(Index As Integer)

If Index = 0 Then
lblGroup.Enabled = True
txtGroup.Enabled = True
cmdGroup.Enabled = True
lblTrainee.Enabled = False
txtTraineeCode.Enabled = False
cmdTrainee.Enabled = False
txtTraineeCode.Text = vbNullString
lblTraineeName.Caption = vbNullString
ElseIf Index = 1 Then
lblGroup.Enabled = False
txtGroup.Enabled = False
cmdGroup.Enabled = False
txtGroup.Text = vbNullString
lblGroupName.Caption = vbNullString
lblTrainee.Enabled = True
txtTraineeCode.Enabled = True
cmdTrainee.Enabled = True
ElseIf Index = 2 Then
lblGroup.Enabled = False
txtGroup.Enabled = False
cmdGroup.Enabled = False
txtGroup.Text = vbNullString
lblGroupName.Caption = vbNullString
lblTrainee.Enabled = False
txtTraineeCode.Enabled = False
cmdTrainee.Enabled = False
txtTraineeCode.Text = vbNullString
lblTraineeName.Caption = vbNullString
End If

End Sub

'Pop-up clients
Private Sub txtGroup_GotFocus()
SelectCtl txtGroup
End Sub

Private Sub txtGroup_LostFocus()

CheckClientsField

End Sub

Private Sub txtGroup_Validate(Cancel As Boolean)

Cancel = ClientSearch(Me, txtGroup.Text)

End Sub

Private Sub cmdGroup_Click()

ClientSearch Me, vbNullString, True
CheckClientsField

End Sub

Private Sub CheckClientsField()

If Clients_Search(1).ClientCode <> vbNullString Then
txtGroup.Text = Clients_Search(1).ClientCode
lblGroupName.Caption = Clients_Search(1).ClientName
End If

End Sub
'End of Pop-up clients

'Pop-up Trainees
Private Sub txtTraineeCode_GotFocus()
SelectCtl txtTraineeCode

End Sub

Private Sub txtTraineeCode_LostFocus()

CheckTraineesField

End Sub

Private Sub txtTraineeCode_Validate(Cancel As Boolean)

Cancel = FilteredTraineeSearch(Me, m_strTrainingCode, txtTraineeCode.Text)

End Sub

Private Sub cmdTrainee_Click()

FilteredTraineeSearch Me, m_strTrainingCode, vbNullString, True
CheckTraineesField

End Sub

Private Sub CheckTraineesField()

If Trainees_Search(1).TraineeCode <> vbNullString Then
txtTraineeCode.Text = Trainees_Search(1).TraineeCode
lblTraineeName.Caption = Trainees_Search(1).TraineeName
End If

End Sub
'End of Pop-up Trainee

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer

CheckTrainingCoursesField
DoEvents
End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
Dim strDays As String
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
'initialize other objects...
m_strTrainingCode = TrainingCourses_Search(1).TrainingCode
txtTraineeCode.Text = vbNullString
lblTraineeName.Caption = vbNullString
End If

End Sub
'End of Pop-up Training Course

EVALUATION RATING

Option Explicit
Dim blnPrint As Boolean
Dim strDays As String

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtTrainingCode.Text) = vbNullString Then
MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

blnPrint = True

Dim cmdTemp As ADODB.Command

Dim strNoOfRec As String

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
 .ActiveConnection = cnnServer
.CommandText = "spGetNoOfParticipants"
.CommandType = adCmdStoredProc
.CommandTimeout = 0
.Prepared = True
.Parameters.Append .CreateParameter("intReturn", adInteger, adParamOutput)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTrainingCode.Text))
.Execute , , adExecuteNoRecords
strNoOfRec = .Parameters("intReturn")
End With

MsgBar "Generating Evaluation Rating Report. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Evaluation Rating Report'"
.Formulas(2) = "_REPORT_TITLE2 = 'EVALUATION SUMMARY'"
.Formulas(3) = "_NOOFPARTICIPANTS = '" & strNoOfRec & "'"
.Formulas(4) = "Schedule = '" & GetSchedule(dtpFrDate.value, dtpToDate.value, strDays) & "; " & cboTime.Text & "'"
.WindowTitle = "Evaluation Rating Report"
.SelectionFormula = "{TrainingCourses.GroupCode} = '" & g_strUserGroup & "' AND {TrainingCourses.TrainingCode} = '" &
txtTrainingCode.Text & "'"
.ReportFileName = g_DirectoryReports & "R_EvaluationRating.rpt"
.Connect = cnnReport
.Action = 1
End With

ErrorHandler:
Set cmdTemp = Nothing
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

GetTimeItem cboTime

End Sub

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer

CheckTrainingCoursesField
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus
End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
End If

End Sub
'End of Pop-up Training Course

EVALUATION SUMMARY

Option Explicit
Dim blnPrint As Boolean
Dim strDays As String

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtTrainingCode.Text) = vbNullString Then
MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

blnPrint = True

Dim cmdTemp As ADODB.Command

Dim strNoOfRec As String

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetNoOfParticipants"
.CommandType = adCmdStoredProc
.CommandTimeout = 0
.Prepared = True
.Parameters.Append .CreateParameter("intReturn", adInteger, adParamOutput)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTrainingCode.Text))
.Execute , , adExecuteNoRecords
strNoOfRec = .Parameters("intReturn")
End With

MsgBar "Generating Evaluation Summary and Recommendation Report. Please wait..."

With crptReport
 .WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Evaluation Summary and Recommendation Report'"
.Formulas(2) = "_REPORT_TITLE2 = 'EVALUATION SUMMARY'"
.Formulas(3) = "_NOOFPARTICIPANTS = '" & strNoOfRec & "'"
.Formulas(4) = "Schedule = '" & GetSchedule(dtpFrDate.value, dtpToDate.value, strDays) & "; " & cboTime.Text & "'"
.WindowTitle = "Evaluation Summary and Recommendation Report"
.SelectionFormula = "{TrainingCourses.GroupCode} = '" & g_strUserGroup & "' AND {TrainingCourses.TrainingCode} = '" &
txtTrainingCode.Text & "'"
.ReportFileName = g_DirectoryReports & "R_EvaluationSummary.rpt"
.Connect = cnnReport
.Action = 1
End With

ErrorHandler:
Set cmdTemp = Nothing
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

GetTimeItem cboTime

End Sub

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer

CheckTrainingCoursesField
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
 Dim X As Integer
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
End If

End Sub
'End of Pop-up Training Course

GRADE REPORT

Option Explicit
Dim blnPrint As Boolean

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtTrainingCode.Text) = vbNullString Then
MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

blnPrint = True

MsgBar "Generating Grades Report. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Grades Report'"
.WindowTitle = "Grades Report"
.SelectionFormula = "{Grades.GroupCode} = '" & g_strUserGroup & "' AND {Grades.TrainingCode} = '" &
txtTrainingCode.Text & "'"
.ReportFileName = g_DirectoryReports & "R_Grades.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

GetTimeItem cboTime

End Sub

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer
 CheckTrainingCoursesField
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
Dim strDays As String
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
End If

End Sub
'End of Pop-up Training Course

PRIVATE EVALUATION

Option Explicit
Dim blnPrint As Boolean
Dim m_strTrainingCode As String

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtTrainingCode.Text) = vbNullString Then
MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If
If txtGroup.Enabled And Trim(txtGroup.Text) = vbNullString Then
MsgBar "Group/Company code must not be blank. Please fill-in the field."
txtGroup.SetFocus
Exit Sub
End If
If txtTraineeCode.Enabled And Trim(txtTraineeCode.Text) = vbNullString Then
MsgBar "Trainee code must not be blank. Please fill-in the field."
txtTraineeCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

 blnPrint = True

MsgBar "Generating {Private} Evaluation Form. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.WindowTitle = "{Private} Evaluation Form"
If optPrintMode(0) Then
.SelectionFormula = "{vwD_Registration.GroupCode} = '" & g_strUserGroup & "' AND {vwD_Registration.TrainingCode} =
'" & txtTrainingCode.Text & "' AND {vwD_Registration.CompanyCode} = '" & txtGroup.Text & "'"
ElseIf optPrintMode(1) Then
.SelectionFormula = "{vwD_Registration.GroupCode} = '" & g_strUserGroup & "' AND {vwD_Registration.TrainingCode} =
'" & txtTrainingCode.Text & "' AND {vwD_Registration.TraineeCode} = '" & txtTraineeCode.Text & "'"
Else
.SelectionFormula = "{vwD_Registration.GroupCode} = '" & g_strUserGroup & "' AND {vwD_Registration.TrainingCode} =
'" & txtTrainingCode.Text & "'"
End If
If dtpToDate.value < CDate(g_strCurrentDate) Then
.ReportFileName = g_DirectoryReports & "R_PvtEvaluationWData.rpt"
Else
.ReportFileName = g_DirectoryReports & "R_PvtEvaluation.rpt"
End If
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

optPrintMode_Click 0
GetTimeItem cboTime

End Sub

Private Sub optPrintMode_Click(Index As Integer)

If Index = 0 Then
lblGroup.Enabled = True
txtGroup.Enabled = True
cmdGroup.Enabled = True
lblTrainee.Enabled = False
txtTraineeCode.Enabled = False
cmdTrainee.Enabled = False
txtTraineeCode.Text = vbNullString
lblTraineeName.Caption = vbNullString
ElseIf Index = 1 Then
lblGroup.Enabled = False
txtGroup.Enabled = False
cmdGroup.Enabled = False
txtGroup.Text = vbNullString
lblGroupName.Caption = vbNullString
lblTrainee.Enabled = True
txtTraineeCode.Enabled = True
cmdTrainee.Enabled = True
ElseIf Index = 2 Then
lblGroup.Enabled = False
txtGroup.Enabled = False
cmdGroup.Enabled = False
txtGroup.Text = vbNullString
lblGroupName.Caption = vbNullString
lblTrainee.Enabled = False
txtTraineeCode.Enabled = False
cmdTrainee.Enabled = False
 txtTraineeCode.Text = vbNullString
lblTraineeName.Caption = vbNullString
End If

End Sub

'Pop-up clients
Private Sub txtGroup_GotFocus()
SelectCtl txtGroup

End Sub

Private Sub txtGroup_LostFocus()

CheckClientsField

End Sub

Private Sub txtGroup_Validate(Cancel As Boolean)

Cancel = ClientSearch(Me, txtGroup.Text)

End Sub

Private Sub cmdGroup_Click()

ClientSearch Me, vbNullString, True
CheckClientsField

End Sub

Private Sub CheckClientsField()

If Clients_Search(1).ClientCode <> vbNullString Then
txtGroup.Text = Clients_Search(1).ClientCode
lblGroupName.Caption = Clients_Search(1).ClientName
End If

End Sub
'End of Pop-up clients

'Pop-up Trainees
Private Sub txtTraineeCode_GotFocus()
SelectCtl txtTraineeCode

End Sub

Private Sub txtTraineeCode_LostFocus()

CheckTraineesField

End Sub

Private Sub txtTraineeCode_Validate(Cancel As Boolean)

Cancel = FilteredTraineeSearch(Me, m_strTrainingCode, txtTraineeCode.Text)

End Sub

Private Sub cmdTrainee_Click()

FilteredTraineeSearch Me, m_strTrainingCode, vbNullString, True
CheckTraineesField

End Sub

Private Sub CheckTraineesField()

If Trainees_Search(1).TraineeCode <> vbNullString Then
txtTraineeCode.Text = Trainees_Search(1).TraineeCode
lblTraineeName.Caption = Trainees_Search(1).TraineeName
End If

End Sub
'End of Pop-up Trainee

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
 SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer

CheckTrainingCoursesField
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
Dim strDays As String
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
'initialize other objects...
m_strTrainingCode = TrainingCourses_Search(1).TrainingCode
txtTraineeCode.Text = vbNullString
lblTraineeName.Caption = vbNullString
End If

End Sub
'End of Pop-up Training Course

REGISTRATION

Option Explicit
Dim blnPrint As Boolean

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

Dim str As String
If Trim(txtTrainingCode.Text) = vbNullString Then
MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If
 If blnPrint Then Exit Sub
blnPrint = True
If optPrintMode(0) Then
str = "Offsite"
Else
str = "Web"
End If

MsgBar "Generating " & str & " Registration Reports. Please wait..."
With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = '" & str & " Registration Reports'"
.WindowTitle = str & " Registration Reports"
If optPrintMode(0) Then
.SelectionFormula = "{vwD_Registration.GroupCode} = '" & g_strUserGroup & "' AND {vwD_Registration.TrainingCode} =
'" & txtTrainingCode.Text & "'"
.ReportFileName = g_DirectoryReports & "R_Registration.rpt"
Else
.SelectionFormula = "{vwWeb_Registration.GroupCode} = '" & g_strUserGroup & "' AND
{vwWeb_Registration.TrainingCode} = '" & txtTrainingCode.Text & "'"
.ReportFileName = g_DirectoryReports & "R_WebRegistration.rpt"
End If
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

GetTimeItem cboTime

End Sub

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer

CheckTrainingCoursesField
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
 txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
Dim strDays As String
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
End If

End Sub
'End of Pop-up Training Course

STI-HQ TRAINING EVALUATION

Option Explicit
Dim blnPrint As Boolean
Dim m_strTrainingCode As String

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtTrainingCode.Text) = vbNullString Then
MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If
If txtGroup.Enabled And Trim(txtGroup.Text) = vbNullString Then
MsgBar "Group/Company code must not be blank. Please fill-in the field."
txtGroup.SetFocus
Exit Sub
End If
If txtTraineeCode.Enabled And Trim(txtTraineeCode.Text) = vbNullString Then
MsgBar "Trainee code must not be blank. Please fill-in the field."
txtTraineeCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

blnPrint = True

MsgBar "Generating STI-HQ Training Evaluation Form. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.WindowTitle = "STI-HQ Training Evaluation Form"
If optPrintMode(0) Then
.SelectionFormula = "{vwD_Registration.GroupCode} = '" & g_strUserGroup & "' AND {vwD_Registration.TrainingCode} =
'" & txtTrainingCode.Text & "' AND {vwD_Registration.CompanyCode} = '" & txtGroup.Text & "'"
ElseIf optPrintMode(1) Then
 .SelectionFormula = "{vwD_Registration.GroupCode} = '" & g_strUserGroup & "' AND {vwD_Registration.TrainingCode} =
'" & txtTrainingCode.Text & "' AND {vwD_Registration.TraineeCode} = '" & txtTraineeCode.Text & "'"
Else
.SelectionFormula = "{vwD_Registration.GroupCode} = '" & g_strUserGroup & "' AND {vwD_Registration.TrainingCode} =
'" & txtTrainingCode.Text & "'"
End If
If dtpToDate.value < CDate(g_strCurrentDate) Then
.ReportFileName = g_DirectoryReports & "R_STIHQTrainingWData.rpt"
Else
.ReportFileName = g_DirectoryReports & "R_STIHQTraining.rpt"
End If
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

optPrintMode_Click 0
GetTimeItem cboTime

End Sub

Private Sub optPrintMode_Click(Index As Integer)

If Index = 0 Then
lblGroup.Enabled = True
txtGroup.Enabled = True
cmdGroup.Enabled = True
lblTrainee.Enabled = False
txtTraineeCode.Enabled = False
cmdTrainee.Enabled = False
txtTraineeCode.Text = vbNullString
lblTraineeName.Caption = vbNullString
ElseIf Index = 1 Then
lblGroup.Enabled = False
txtGroup.Enabled = False
cmdGroup.Enabled = False
txtGroup.Text = vbNullString
lblGroupName.Caption = vbNullString
lblTrainee.Enabled = True
txtTraineeCode.Enabled = True
cmdTrainee.Enabled = True
ElseIf Index = 2 Then
lblGroup.Enabled = False
txtGroup.Enabled = False
cmdGroup.Enabled = False
txtGroup.Text = vbNullString
lblGroupName.Caption = vbNullString
lblTrainee.Enabled = False
txtTraineeCode.Enabled = False
cmdTrainee.Enabled = False
txtTraineeCode.Text = vbNullString
lblTraineeName.Caption = vbNullString
End If

End Sub

'Pop-up clients
Private Sub txtGroup_GotFocus()
SelectCtl txtGroup

End Sub

Private Sub txtGroup_LostFocus()

CheckClientsField

End Sub
Private Sub txtGroup_Validate(Cancel As Boolean)
Cancel = ClientSearch(Me, txtGroup.Text)

End Sub

Private Sub cmdGroup_Click()

ClientSearch Me, vbNullString, True
CheckClientsField

End Sub

Private Sub CheckClientsField()

If Clients_Search(1).ClientCode <> vbNullString Then
txtGroup.Text = Clients_Search(1).ClientCode
lblGroupName.Caption = Clients_Search(1).ClientName
End If

End Sub
'End of Pop-up clients

'Pop-up Trainees
Private Sub txtTraineeCode_GotFocus()
SelectCtl txtTraineeCode

End Sub

Private Sub txtTraineeCode_LostFocus()

CheckTraineesField

End Sub

Private Sub txtTraineeCode_Validate(Cancel As Boolean)

Cancel = FilteredTraineeSearch(Me, m_strTrainingCode, txtTraineeCode.Text)

End Sub

Private Sub cmdTrainee_Click()

FilteredTraineeSearch Me, m_strTrainingCode, vbNullString, True
CheckTraineesField

End Sub

Private Sub CheckTraineesField()

If Trainees_Search(1).TraineeCode <> vbNullString Then
txtTraineeCode.Text = Trainees_Search(1).TraineeCode
lblTraineeName.Caption = Trainees_Search(1).TraineeName
End If

End Sub
'End of Pop-up Trainee

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer

CheckTrainingCoursesField
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub
Private Sub cmdTraining_Click()
TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
Dim strDays As String
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
'initialize other objects...
m_strTrainingCode = TrainingCourses_Search(1).TrainingCode
txtTraineeCode.Text = vbNullString
lblTraineeName.Caption = vbNullString
End If

End Sub
'End of Pop-up Training Course

TRAINEES COMMENTS

Option Explicit
Dim blnPrint As Boolean
Dim strDays As String

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtTrainingCode.Text) = vbNullString Then
MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

blnPrint = True

Dim cmdTemp As ADODB.Command

Dim strNoOfRec As String

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetNoOfParticipants"
.CommandType = adCmdStoredProc
.CommandTimeout = 0
.Prepared = True
.Parameters.Append .CreateParameter("intReturn", adInteger, adParamOutput)
 .Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTrainingCode.Text))
.Execute , , adExecuteNoRecords
strNoOfRec = .Parameters("intReturn")
End With

MsgBar "Generating Traine's Comments Report. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Evaluation Traine`s Comments Report'"
.Formulas(2) = "_REPORT_TITLE2 = 'EVALUATION SUMMARY'"
.Formulas(3) = "_NOOFPARTICIPANTS = '" & strNoOfRec & "'"
.Formulas(4) = "Schedule = '" & GetSchedule(dtpFrDate.value, dtpToDate.value, strDays) & "; " & cboTime.Text & "'"
.WindowTitle = "Evaluation Traine's Comments Report"
.SelectionFormula = "{TrainingCourses.GroupCode} = '" & g_strUserGroup & "' AND {TrainingCourses.TrainingCode} = '" &
txtTrainingCode.Text & "'"
.ReportFileName = g_DirectoryReports & "R_TraineesComments.rpt"
.Connect = cnnReport
.Action = 1
End With

ErrorHandler:
Set cmdTemp = Nothing
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

GetTimeItem cboTime

End Sub

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer

CheckTrainingCoursesField
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
 lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
End If

End Sub
'End of Pop-up Training Course

TRAINING COST

Option Explicit
Dim blnPrint As Boolean
Dim strDays As String

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtTrainingCode.Text) = vbNullString Then
MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

blnPrint = True

Dim cmdTemp As ADODB.Command

Dim strNoOfRec As String

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetNoOfParticipants"
.CommandType = adCmdStoredProc
.CommandTimeout = 0
.Prepared = True
.Parameters.Append .CreateParameter("intReturn", adInteger, adParamOutput)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTrainingCode.Text))
.Execute , , adExecuteNoRecords
strNoOfRec = .Parameters("intReturn")
End With

MsgBar "Generating Training Cost Report. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
 .ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Training Cost Report'"
.Formulas(2) = "_REPORT_TITLE2 = 'EVALUATION SUMMARY'"
.Formulas(3) = "_NOOFPARTICIPANTS = '" & strNoOfRec & "'"
.Formulas(4) = "Schedule = '" & GetSchedule(dtpFrDate.value, dtpToDate.value, strDays) & "; " & cboTime.Text & "'"
.WindowTitle = "Training Cost Report"
.SelectionFormula = "{TrainingCourses.GroupCode} = '" & g_strUserGroup & "' AND {TrainingCourses.TrainingCode} = '" &
txtTrainingCode.Text & "'"
.ReportFileName = g_DirectoryReports & "R_TrainingCost.rpt"
.Connect = cnnReport
.Action = 1
End With

ErrorHandler:
Set cmdTemp = Nothing
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

GetTimeItem cboTime

End Sub

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer

CheckTrainingCoursesField
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
End If
End Sub
'End of Pop-up Training Course

TRAINING GRADE

Option Explicit
Dim blnPrint As Boolean
Dim strDays As String

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

If Trim(txtTrainingCode.Text) = vbNullString Then
MsgBar "Training code must not be blank. Please fill-in the field."
txtTrainingCode.SetFocus
Exit Sub
End If

If blnPrint Then Exit Sub

blnPrint = True

Dim cmdTemp As ADODB.Command

Dim strNoOfRec As String

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetNoOfParticipants"
.CommandType = adCmdStoredProc
.CommandTimeout = 0
.Prepared = True
.Parameters.Append .CreateParameter("intReturn", adInteger, adParamOutput)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTrainingCode", adChar, adParamInput, GENERICCODE_LEN,
Trim(txtTrainingCode.Text))
.Execute , , adExecuteNoRecords
strNoOfRec = .Parameters("intReturn")
End With

MsgBar "Generating Training Grade Result Report. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Training Grade Result Report'"
.Formulas(2) = "_REPORT_TITLE2 = 'EVALUATION SUMMARY'"
.Formulas(3) = "_NOOFPARTICIPANTS = '" & strNoOfRec & "'"
.Formulas(4) = "Schedule = '" & GetSchedule(dtpFrDate.value, dtpToDate.value, strDays) & "; " & cboTime.Text & "'"
.WindowTitle = "Training Grade Result Report"
.SelectionFormula = "{TrainingCourses.GroupCode} = '" & g_strUserGroup & "' AND {TrainingCourses.TrainingCode} = '" &
txtTrainingCode.Text & "'"
.ReportFileName = g_DirectoryReports & "R_GradeResults.rpt"
.Connect = cnnReport
.Action = 1
End With

ErrorHandler:
Set cmdTemp = Nothing
 MsgBar vbNullString
blnPrint = False

End Sub

Private Sub Form_Load()

GetTimeItem cboTime

End Sub

'Pop-up Training Courses

Private Sub txtTrainingCode_GotFocus()
SelectCtl txtTrainingCode

End Sub

Private Sub txtTrainingCode_LostFocus()

Dim i As Integer

CheckTrainingCoursesField
DoEvents

End Sub

Private Sub txtTrainingCode_Validate(Cancel As Boolean)

Cancel = TrainingCourseSearch(Me, txtTrainingCode.Text)

End Sub

Private Sub cmdTraining_Click()

TrainingCourseSearch Me, vbNullString, True
txtTrainingCode_LostFocus

End Sub

Private Sub CheckTrainingCoursesField()

If TrainingCourses_Search(1).TrainingCode <> vbNullString Then
txtTrainingCode.Text = TrainingCourses_Search(1).TrainingCode
lblTrainingName.Caption = TrainingCourses_Search(1).TrainingName
lblCourseCode.Caption = TrainingCourses_Search(1).CourseCode
lblCourseName.Caption = TrainingCourses_Search(1).CourseName
lblTrainerCode.Caption = TrainingCourses_Search(1).TrainerCode
lblTrainerName.Caption = TrainingCourses_Search(1).TrainerName
dtpFrDate.value = TrainingCourses_Search(1).ScheduleFr
dtpToDate.value = TrainingCourses_Search(1).ScheduleTo
SetCurrentItem cboTime, TrainingCourses_Search(1).ScheduleTime
'display CheckBoxes...
Dim X As Integer
strDays = PadL(Trim(TrainingCourses_Search(1).Days), chkDay.UBound, "0")
For X = 1 To (chkDay.UBound)
chkDay(X) = Val(Mid(strDays, X, 1))
Next X
End If

End Sub
'End of Pop-up Training Course

TRAING SUMMARY

Option Explicit
Dim blnPrint As Boolean

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdPrint_Click()

Dim strFrYear, strFrMonth, strFrDay As String
Dim strToYear, strToMonth, strToDay As String

If blnPrint Then Exit Sub

blnPrint = True

strFrYear = Year(dtpFrInclusive.value)
strFrMonth = Month(dtpFrInclusive.value)
strFrDay = Day(dtpFrInclusive.value)
strToYear = Year(dtpToInclusive.value)
strToMonth = Month(dtpToInclusive.value)
strToDay = Day(dtpToInclusive.value)

MsgBar "Generating Training Summary Report. Please wait..."

With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'Training Summary'"
.Formulas(2) = "_REPORT_TITLE2 = 'From " & Format(dtpFrInclusive.value, LONGDATE_FORMAT) & " To " &
Format(dtpToInclusive.value, LONGDATE_FORMAT) & "'"
.WindowTitle = "Training Summary"
.SelectionFormula = "{spGetTrainingSummary;1.GroupCode} = '" & g_strUserGroup & "'" & _
" And {spGetTrainingSummary;1.ScheduleFrom} >= Date(" & strFrYear & "," & strFrMonth & "," & strFrDay &
")" & _
" And {spGetTrainingSummary;1.ScheduleTo} <= Date(" & strToYear & "," & strToMonth & "," & strToDay & ")"
.ReportFileName = g_DirectoryReports & "R_TrainingSummary.rpt"
.Connect = cnnReport
.Action = 1
End With

ErrorHandler:
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub dtpFrInclusive_Change()

If dtpFrInclusive.value > dtpToInclusive.value Then
dtpToInclusive.value = dtpFrInclusive.value
End If

End Sub

Private Sub dtpToInclusive_Change()

If dtpFrInclusive.value > dtpToInclusive.value Then
dtpFrInclusive.value = dtpToInclusive.value
End If

End Sub

UTILITIY CODES

ARCHIVING

Option Explicit
Private m_intOperation As Integer
Const COL_RESTORE = 13
Const COL_ARCHIVE = 12
Private Sub InitArchiveGrid()
Dim intCtr As Integer
With flgArchiveData
.FormatString = "^ |^Training Code|<Training Name|^Course Code|<Course Name|^Venue Code|<Description|^Trainer
Code|<Trainer Name|^From|^To|^Time"
.Rows = 2
 .Cols = COL_ARCHIVE + 1
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 570
.ColWidth(1) = 1215
.ColWidth(2) = 4005
.ColWidth(3) = 1215
.ColWidth(4) = 4005
.ColWidth(5) = 1100
.ColWidth(6) = 4005
.ColWidth(7) = 1215
.ColWidth(8) = 4005
.ColWidth(9) = 1100
.ColWidth(10) = 1100
.ColWidth(11) = 1620
.ColWidth(12) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadArchiveDataToGrid()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spArchiveDataOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strYear", adVarChar, adParamInput, 4, Trim(cboArchiveYear.Text))
.Parameters.Append .CreateParameter("strMonth", adVarChar, adParamInput, 15, Trim(cboArchiveMonth.Text))
.Parameters.Append .CreateParameter("strTrainingCourse", adChar, adParamInput, GENERICCODE_LEN, vbNullString)
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgArchiveData
intlastrow = 1

With flgArchiveData
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgArchiveData, intlastrow
.Col = 1: .Text = rsTemp.Fields("TrainingCode")
 .Col = 2: .Text = rsTemp.Fields("TrainingName")
.Col = 3: .Text = rsTemp.Fields("CourseCode")
.Col = 4: .Text = rsTemp.Fields("CourseName")
.Col = 5: .Text = rsTemp.Fields("VenueCode")
.Col = 6: .Text = rsTemp.Fields("VenueName")
.Col = 7: .Text = rsTemp.Fields("TrainerCode")
.Col = 8: .Text = rsTemp.Fields("FirstName") & " " & rsTemp.Fields("LastName")
.Col = 9: .Text = Format(rsTemp.Fields("ScheduleFrom"), DATE_FORMAT)
.Col = 10: .Text = Format(rsTemp.Fields("ScheduleTo"), DATE_FORMAT)
.Col = 11: .Text = rsTemp.Fields("ScheduleTime")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
m_intOperation = BTN_FIND
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub InitRestoreGrid()

Dim intCtr As Integer
With flgRestoreData
.FormatString = "^ |<Archive Date|^Training Code|<Training Name|^Course Code|<Course Name|^Venue
Code|<Description|^Trainer Code|<Trainer Name|^From|^To|^Time"
.Rows = 2
.Cols = COL_RESTORE + 1
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 570
.ColWidth(1) = 2010
.ColWidth(2) = 1215
.ColWidth(3) = 4005
.ColWidth(4) = 1215
.ColWidth(5) = 4005
.ColWidth(6) = 1100
.ColWidth(7) = 4005
.ColWidth(8) = 1215
.ColWidth(9) = 4005
.ColWidth(10) = 1100
.ColWidth(11) = 1100
.ColWidth(12) = 1620
.ColWidth(13) = 0
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub LoadRestoreDataToGrid()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
 Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spRestoreArchiveDataOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strYear", adVarChar, adParamInput, 4, Trim(cboRestoreYear.Text))
.Parameters.Append .CreateParameter("strMonth", adVarChar, adParamInput, 15, Trim(cboRestoreMonth.Text))
.Parameters.Append .CreateParameter("strTrainingCourse", adChar, adParamInput, GENERICCODE_LEN, vbNullString)
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents flgRestoreData
intlastrow = 1

With flgRestoreData
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow flgRestoreData, intlastrow
.Col = 1: .Text = Format(rsTemp.Fields("ArchiveDate"), DATETIMEAMPM_FORMAT)
.Col = 2: .Text = rsTemp.Fields("TrainingCode")
.Col = 3: .Text = rsTemp.Fields("TrainingName")
.Col = 4: .Text = rsTemp.Fields("CourseCode")
.Col = 5: .Text = rsTemp.Fields("CourseName")
.Col = 6: .Text = rsTemp.Fields("VenueCode")
.Col = 7: .Text = rsTemp.Fields("VenueName")
.Col = 8: .Text = rsTemp.Fields("TrainerCode")
.Col = 9: .Text = rsTemp.Fields("FirstName") & " " & rsTemp.Fields("LastName")
.Col = 10: .Text = Format(rsTemp.Fields("ScheduleFrom"), DATE_FORMAT)
.Col = 11: .Text = Format(rsTemp.Fields("ScheduleTo"), DATE_FORMAT)
.Col = 12: .Text = rsTemp.Fields("ScheduleTime")
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With
m_intOperation = BTN_FIND
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub cboArchiveMonth_Click()

cboArchiveYear_Click
End Sub

Private Sub cboArchiveYear_Click()

LoadArchiveDataToGrid
If chkArchiveAll Then
chkArchiveAll_Click
End If

End Sub

Private Sub cboRestoreMonth_Click()

cboRestoreYear_Click

End Sub

Private Sub cboRestoreYear_Click()

LoadRestoreDataToGrid
If chkRestoreAll Then
chkRestoreAll_Click
End If

End Sub

Private Sub chkArchiveAll_Click()

Dim i As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

With flgArchiveData
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
.Col = 0
For i = 1 To (.Rows - 2)
.Row = i
If chkArchiveAll.value Then
.TextArray(.Row * .Cols + COL_ARCHIVE) = "X"
Set .CellPicture = imgSelected.Picture
Else
.TextArray(.Row * .Cols + COL_ARCHIVE) = vbNullString
Set .CellPicture = LoadPicture
End If
.CellPictureAlignment = flexAlignCenterCenter
Next
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

End Sub

Private Sub chkRestoreAll_Click()

Dim i As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

With flgRestoreData
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
.Col = 0
For i = 1 To (.Rows - 2)
.Row = i
If chkRestoreAll.value Then
.TextArray(.Row * .Cols + COL_RESTORE) = "X"
Set .CellPicture = imgSelected.Picture
Else
.TextArray(.Row * .Cols + COL_RESTORE) = vbNullString
Set .CellPicture = LoadPicture
 End If
.CellPictureAlignment = flexAlignCenterCenter
Next
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
.Col = intCurrentCol
End With

End Sub

Private Sub cmdArchiveMode_Click(Index As Integer)

Dim cmdTemp As ADODB.Command
Dim strTrainingCourse As String
Dim i As Integer
Dim intCol As Integer

On Error GoTo ErrorHandler

m_intOperation = BTN_DELETE
If MsgBox("Have you backed-up your database?", vbQuestion + vbYesNo + vbDefaultButton2, "Archive Data") = vbNo Then
GoTo ErrorHandler
End If
If Index = 0 Then
If flgArchiveData.Rows <= 2 Then
MsgBar "No data to archive."
GoTo ErrorHandler
End If
For i = 1 To (flgArchiveData.Rows - 2)
flgArchiveData.Row = i
If flgArchiveData.TextArray(flgArchiveData.Row * flgArchiveData.Cols + COL_ARCHIVE) <> vbNullString Then
strTrainingCourse = flgArchiveData.TextArray(flgArchiveData.Row * flgArchiveData.Cols + 1)
Set cmdTemp = New ADODB.Command
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spArchiveDataOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strYear", adVarChar, adParamInput, 4, Trim(cboRestoreYear.Text))
.Parameters.Append .CreateParameter("strMonth", adVarChar, adParamInput, 15, Trim(cboRestoreMonth.Text))
.Parameters.Append .CreateParameter("strTrainingCourse", adChar, adParamInput, GENERICCODE_LEN,
Trim(strTrainingCourse))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
.Execute
End With
Set cmdTemp = Nothing
End If
Next
m_intOperation = BTN_FIND
MsgBox "The archive operation has been completed successfully.", vbOKOnly, "Archive Data"
LoadArchiveDataToGrid
ElseIf Index = 1 Then
If flgRestoreData.Rows <= 2 Then
MsgBar "No archive data to restore."
GoTo ErrorHandler
End If
For i = 1 To (flgRestoreData.Rows - 2)
flgRestoreData.Row = i
If flgRestoreData.TextArray(flgRestoreData.Row * flgRestoreData.Cols + COL_RESTORE) <> vbNullString Then
strTrainingCourse = flgRestoreData.TextArray(flgRestoreData.Row * flgRestoreData.Cols + 2)
Set cmdTemp = New ADODB.Command
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spRestoreArchiveDataOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strYear", adVarChar, adParamInput, 4, Trim(cboRestoreYear.Text))
 .Parameters.Append .CreateParameter("strMonth", adVarChar, adParamInput, 15, Trim(cboRestoreMonth.Text))
.Parameters.Append .CreateParameter("strTrainingCourse", adChar, adParamInput, GENERICCODE_LEN,
Trim(strTrainingCourse))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
.Execute
End With
Set cmdTemp = Nothing
End If
Next
m_intOperation = BTN_FIND
MsgBox "The restore operation has been completed successfully.", vbOKOnly, "Archive Data"
LoadRestoreDataToGrid
End If
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
m_intOperation = BTN_FIND
Set cmdTemp = Nothing

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub flgArchiveData_DblClick()

Dim i As Integer, nTmpRow As Integer
With flgArchiveData
nTmpRow = .Col
If (.Row = (.Rows - 1)) Then
Exit Sub
End If
If (nTmpRow = 0) Then
If chkArchiveAll.value <> 0 Then Exit Sub
If Trim(.TextArray(.Row * .Cols + COL_ARCHIVE)) = vbNullString Then
.TextArray(.Row * .Cols + COL_ARCHIVE) = "X"
.Col = nTmpRow: Set .CellPicture = imgSelected.Picture
Else
.TextArray(.Row * .Cols + COL_ARCHIVE) = vbNullString
.Col = nTmpRow: Set .CellPicture = LoadPicture
End If
.CellPictureAlignment = flexAlignCenterCenter
End If
End With

End Sub

Private Sub flgRestoreData_DblClick()

Dim i As Integer, nTmpRow As Integer
With flgRestoreData
nTmpRow = .Col
If (.Row = (.Rows - 1)) Then
Exit Sub
End If
If (nTmpRow = 0) Then
If chkRestoreAll.value <> 0 Then Exit Sub
If Trim(.TextArray(.Row * .Cols + COL_RESTORE)) = vbNullString Then
.TextArray(.Row * .Cols + COL_RESTORE) = "X"
.Col = nTmpRow: Set .CellPicture = imgSelected.Picture
Else
.TextArray(.Row * .Cols + COL_RESTORE) = vbNullString
.Col = nTmpRow: Set .CellPicture = LoadPicture
End If
.CellPictureAlignment = flexAlignCenterCenter
End If
End With
End Sub

Private Sub Form_Load()

GetMonth cboArchiveMonth
GetMonth cboRestoreMonth
GetYear cboArchiveYear
GetYear cboRestoreYear
InitArchiveGrid
InitRestoreGrid
m_intOperation = BTN_FIND
optArchiveMode_Click 0
DoEvents

End Sub

Sub GetMonth(ctl As Control)

Dim i As Integer
ctl.Clear
ctl.AddItem "ALL"
For i = 1 To 12
ctl.AddItem MonthName(i)
Next
ctl.ListIndex = 0

End Sub

Sub GetYear(ctl As Control)

Dim i As Integer
ctl.Clear
ctl.AddItem "ALL"
For i = BASE_YEAR To Year(Now)
ctl.AddItem i
Next
ctl.ListIndex = 0

End Sub

Private Sub optArchiveMode_Click(Index As Integer)

If Index = 0 Then
cmdArchiveMode(0).Visible = True
cmdArchiveMode(1).Visible = False
fraArchiveData.Visible = True
fraRestoreData.Visible = False
chkArchiveAll.value = 0
LoadArchiveDataToGrid
ElseIf Index = 1 Then
cmdArchiveMode(0).Visible = False
cmdArchiveMode(1).Visible = True
fraArchiveData.Visible = False
fraRestoreData.Visible = True
chkRestoreAll.value = 0
LoadRestoreDataToGrid
End If

End Sub

CHANGE PASSWORD

Option Explicit
Const MIN_PASSWORD_LEN = 7

Private Sub cmdChange_Click()

Dim rsUser As ADODB.Recordset
Dim strCurrent As String
Dim strNew As String
Dim strConfirm As String

On Error GoTo NotChanged

strCurrent = EncriptText(Trim(txtCurrent.Text))
 strNew = EncriptText(Trim(txtNew.Text))
strConfirm = EncriptText(Trim(txtConfirm.Text))
If strCurrent = vbNullString Then
SelectCtl txtCurrent
Exit Sub
End If
If strNew = vbNullString Then
SelectCtl txtNew
Exit Sub
End If
If strConfirm = vbNullString Then
SelectCtl txtConfirm
Exit Sub
End If

If Len(strNew) < (MIN_PASSWORD_LEN * 2) Then

MsgBox "The passwords you type have insufficient length. Please retype the new password in both boxes.", vbExclamation,
"Change Password"
SelectCtl txtNew
Exit Sub
End If
If strNew <> strConfirm Then
MsgBox "The passwords you typed do not match. Please retype the new password in both boxes.", vbExclamation, "Change
Password"
SelectCtl txtNew
Exit Sub
End If
'check if user is existing
Set rsUser = GetUserAndPassword(g_strUserID, strCurrent)
If rsUser.EOF Then
MsgBox "The passwords you typed is incorrect. Please retype your current password.", vbExclamation, "Change Password"
SelectCtl txtNew
Exit Sub
End If
If strNew = strCurrent Then
MsgBox "The passwords you typed is simillar with your current password. Please retype the new password in both boxes.",
vbExclamation, "Change Password"
SelectCtl txtNew
Exit Sub
End If
'change password
ChangePassword g_strUserID, strCurrent, strNew
Set rsUser = Nothing
cmdClose_Click
Exit Sub

NotChanged:
Set rsUser = Nothing

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub Form_Load()

fraChangePassword.Top = FrameSet.FTop
fraChangePassword.Left = FrameSet.FLeft
fraChangePassword.Width = FrameSet.FWidth

End Sub

Private Sub txtConfirm_GotFocus()

SelectCtl txtConfirm

End Sub

Private Sub txtCurrent_GotFocus()

 SelectCtl txtCurrent

End Sub

Private Sub txtNew_GotFocus()

SelectCtl txtNew

End Sub

DATA MAINTENANCE

Option Explicit

Private Sub cmdBackup_Click()

'Backup Database.
Dim cmdTemp As ADODB.Command
Dim clsCursor As New MousePointer

On Error GoTo ErrorHandler

clsCursor.ShowCursor ' show hour glass

Set cmdTemp = New ADODB.Command
If optMaintenanceMode(0) Then
MsgBar "Backup in progress. Please wait..."
With cmdTemp
.ActiveConnection = cnnServer
.CommandTimeout = 0
.CommandText = "xpBackupDatabase"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("intRetval", adInteger, adParamReturnValue, 4)
.Parameters.Append .CreateParameter("intBackUp", adInteger, adParamInput, 4, IIf(optBackUp(0), 0, 1))
.Parameters.Append .CreateParameter("strBackUpDir", adVarChar, adParamInput, 80, g_DirectoryBackUp & "STITES_" &
Format(Now, "yyyymmdd"))
.Execute adExecuteNoRecords
End With
End If
MsgBar vbNullString
clsCursor.ShowCursor vbArrow
MsgBox "The backup operation has been completed successfully.", vbOKOnly, "Manage Database"
Set cmdTemp = Nothing
Exit Sub

ErrorHandler:
MsgBar vbNullString
clsCursor.ShowCursor vbArrow
MsgBox "The backup operation has been failed!", vbCritical, "Manage Database"
Set cmdTemp = Nothing

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdRestore_Click()

Dim cnnMaster As ADODB.Connection
Dim clsCursor As New MousePointer

If optRestore(0) And Trim(fleList.FileName) = vbNullString Then

MsgBar "Please select a file to restore."
Exit Sub
End If
On Error GoTo ErrorHandler
clsCursor.ShowCursor ' show hour glass
'close connection every time it passes here
If cnnServer.State = adStateOpen Then
 cnnServer.Close
End If
Set cnnServer = Nothing
'close connection every time it passes here
If cnnReport.State = adStateOpen Then
cnnReport.Close
End If
Set cnnReport = Nothing

MsgBar "SQL Server is currently in process of restoring backup set"

'initialize connection to master database
Set cnnMaster = New ADODB.Connection
'close connection every time it passes here
If cnnMaster.State = adStateOpen Then
cnnMaster.Close
End If
'establishing connection to database
cnnMaster.CursorLocation = adUseClient
cnnMaster.Provider = g_ServerProvider
cnnMaster.Open "Data Source=" & g_ServerName & _
";Initial Catalog=master" & _
";", "sa", "E=mc2000"

Dim cmdMaster As ADODB.Command

Set cmdMaster = New ADODB.Command
With cmdMaster
.ActiveConnection = cnnMaster
.CommandTimeout = 0
If optRestore(0) Then
.CommandText = "RESTORE DATABASE [STITES] FROM DISK = '" & g_DirectoryBackUp & fleList.FileName & "'"
Else
.CommandText = "RESTORE DATABASE [STITES] FROM TAPE = '\\.\Tape0'"
End If
.CommandType = adCmdText
.Execute
End With
'initialize connection/recordset variable
Set cnnServer = New ADODB.Connection
'initialize connection/recordset variable
Set cnnReport = New ADODB.Connection

cnnReport = "Driver=" & g_ServerDriver & "; Server=" & g_ServerName & "; UID=sa; PWD=E=mc2000;Database=" &
g_ServerDatabase
'establishing connection to default database
cnnServer.CursorLocation = adUseClient
cnnServer.Provider = g_ServerProvider
cnnServer.Open "Data Source=" & g_ServerName & _
";Initial Catalog=" & g_ServerDatabase & _
";", "sa", "E=mc2000"
MsgBar vbNullString
clsCursor.ShowCursor vbArrow
MsgBox "Restore of database '" & g_ServerDatabase & "' completed successfully.", vbOKOnly, "Manage Database"
Exit Sub

ErrorHandler:
'initialize connection/recordset variable
Set cnnServer = New ADODB.Connection
'initialize connection/recordset variable
Set cnnReport = New ADODB.Connection

cnnReport = "Driver=" & g_ServerDriver & "; Server=" & g_ServerName & "; UID=sa; PWD=E=mc2000;Database=" &
g_ServerDatabase
'establishing connection to default database
cnnServer.CursorLocation = adUseClient
cnnServer.Provider = g_ServerProvider
cnnServer.Open "Data Source=" & g_ServerName & _
";Initial Catalog=" & g_ServerDatabase & _
";", "sa", "E=mc2000"
MsgBar vbNullString
clsCursor.ShowCursor vbArrow
 MsgBox "Exclusive access could not be obtained because the database is in use." & _
Chr(13) & "RESTORE DATABASE is terminating abnormally.", vbCritical, "Manage Database"

End Sub

Private Sub Form_Load()

fleList.FileName = g_DirectoryBackUp & "*.*"
optMaintenanceMode_Click 0
optBackUp_Click 0

End Sub

Private Sub optBackUp_Click(Index As Integer)

If Index = 0 Then
lblBackUpName = "STITES_" & Format(Now, "yyyymmdd")
ElseIf Index = 1 Then
lblBackUpName = "\\.\TAPE0"
End If
End Sub

Private Sub optMaintenanceMode_Click(Index As Integer)

fraMaintenance(Index).Visible = True
If Index = 0 Then
cmdBackup.Visible = True
cmdRestore.Visible = False
cmdClose.Top = 1890
fraMaintenance(1).Visible = False
ElseIf Index = 1 Then
cmdBackup.Visible = False
cmdRestore.Visible = True
cmdClose.Top = 4350
fraMaintenance(0).Visible = False
fleList.Refresh
End If

End Sub

Private Sub optRestore_Click(Index As Integer)

If Index = 0 Then
lblRestore.Visible = False
fleList.Visible = True
ElseIf Index = 1 Then
lblRestore.Visible = True
fleList.Visible = False
End If
End Sub

IMPORT DATA

Option Explicit

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "<Step Name|<Status"
.Rows = 2
.Cols = 2
.AllowUserResizing = flexResizeColumns
.ScrollBars = 2
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 6090
.ColWidth(1) = 2130
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
 .Col = 0
End With

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdImport_Click()

'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer
Dim blnSuccess As Boolean

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spImportData"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GENERICCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Downloading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

ProgressBar1.Min = 0
ProgressBar1.Max = rsTemp.RecordCount() + 1
'Set the Progress's Value to Min.
ProgressBar1.value = ProgressBar1.Min

With MSFlexGrid1
.Redraw = True
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 0: .Text = "No records to download!"
.Col = 1: .Text = "Failed!"
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = "Copying " & rsTemp.Fields("TrainingName") & "(" & rsTemp.Fields("Trainee") & ") from Web
Registration..."
ProgressBar1.value = intlastrow
.Col = 1: .Text = "Completed"
intlastrow = intlastrow + 1
rsTemp.MoveNext
Pause 100
blnSuccess = True
Loop
ProgressBar1.value = ProgressBar1.Max
If blnSuccess Then
MsgBox "Successfully copied " & .Row & " record(s) from On-Line Registration System."
End If
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
.LeftCol = intCurrentCol
 .Col = intCurrentCol
End With
MsgBar vbNullString

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub Form_Load()

InitGrid

End Sub

MANAGE USERS

Option Explicit
Private m_intOperation As Integer
Private m_blnRightsADD As Boolean
Private m_blnRightsEDIT As Boolean
Private m_blnRightsDELETE As Boolean
Private m_blnRigthsPRINT As Boolean
Dim blnPrint As Boolean

Public Property Let getRights(ByVal NewVal As String)

m_blnRightsADD = (Mid(NewVal, 1, 1) = 1)
m_blnRightsEDIT = (Mid(NewVal, 2, 1) = 1)
m_blnRightsDELETE = (Mid(NewVal, 3, 1) = 1)
m_blnRigthsPRINT = (Mid(NewVal, 4, 1) = 1)

End Property

Private Sub EnabledClose(ByVal blnVal As Boolean)

cmdSave.Enabled = Not blnVal
cmdCancel.Enabled = Not blnVal
cmdClose.Enabled = blnVal
MSFlexGrid1.Enabled = blnVal

End Sub

Private Sub EnableOperation(blnAdd As Boolean, blnEdit As Boolean, blnDelete As Boolean, blnPrint As Boolean, blnFind As
Boolean)
cmdOperation(0).Enabled = blnAdd
cmdOperation(1).Enabled = blnEdit
cmdOperation(2).Enabled = blnDelete
cmdOperation(3).Enabled = blnPrint
cmdOperation(4).Enabled = blnFind

End Sub

Private Sub InitGrid()

Dim intCtr As Integer
With MSFlexGrid1
.FormatString = "<First Name|<Last Name|<Address|<Telephone No.|^Gender|<Birth Date|^Group Code|<Group Name|<User
Name|<Password|^Expiry Date|^User Blocked"
.Rows = 2
.Cols = 12
.AllowUserResizing = flexResizeColumns
.ScrollBars = flexScrollBarBoth
.FocusRect = flexFocusNone
.SelectionMode = flexSelectionFree
.ColWidth(0) = 4005
.ColWidth(1) = 4005
.ColWidth(2) = 4005
.ColWidth(3) = 1590
.ColWidth(4) = 1215
 .ColWidth(5) = 1215
.ColWidth(6) = 1215
.ColWidth(7) = 4005
.ColWidth(8) = 1215
.ColWidth(9) = 0
.ColWidth(10) = 1215
.ColWidth(11) = 1215
.Row = 0
For intCtr = 0 To .Cols - 1 'make heading in bold face
.Col = intCtr
.CellFontBold = True
Next intCtr
.Row = 1
.Col = 0
End With

End Sub

Private Sub PrintReport()

If blnPrint Then Exit Sub
blnPrint = True
MsgBar "Generating User Profile Reports. Please wait..."
With crptReport
.WindowState = crptMaximized
.WindowShowProgressCtls = True
.WindowShowRefreshBtn = True
.WindowShowExportBtn = False
.WindowShowCloseBtn = True
.WindowControlBox = True
.DiscardSavedData = True
.ProgressDialog = True
.Formulas(0) = "_DEPARTMENT = '" & SYSTEM_COMPANY & "'"
.Formulas(1) = "_REPORT_TITLE = 'User Profile Reports'"
.WindowTitle = "User Profile Reports"
.ReportFileName = g_DirectoryReports & "SystemUsers.rpt"
.Connect = cnnReport
.Action = 1
End With
MsgBar vbNullString
blnPrint = False

End Sub

Private Sub cmdCancel_Click()

EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraUser.Enabled = False
txtUser.Locked = False
m_intOperation = BTN_FIND
MSFlexGrid1_Click
MsgBar vbNullString

End Sub

Private Sub cmdClose_Click()

MsgBar vbNullString
Unload Me

End Sub

Private Sub cmdOperation_Click(Index As Integer)

m_intOperation = Index
Select Case Index
Case BTN_ADD 'add/0
MsgBar MSG_ADD
fraUser.Enabled = True
EnableOperation m_blnRightsADD, False, False, False, False
EnabledClose False
ClearAllFields Me
dtpExpiry.value = CDate(g_strCurrentDate) + EXP_PERIOD
 txtFirstName.SetFocus
Case BTN_EDIT 'edit/1
If txtUser <> vbNullString Then
MsgBar MSG_EDIT
fraUser.Enabled = True
txtUser.Locked = True
EnableOperation False, m_blnRightsEDIT, False, False, False
EnabledClose False
txtFirstName.SetFocus
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_DELETE 'delete/2
Dim strMsg As String
MsgBar MSG_DELETE
With MSFlexGrid1
strMsg = .TextArray(.Row * .Cols + 8) & "-" & .TextArray(.Row * .Cols + 0) & " " & .TextArray(.Row * .Cols + 1) & vbLf
&_
"Do you want to delete this record?"
End With
If txtUser <> vbNullString Then
If MsgBox(strMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Delete current record") = vbYes Then
MsgBar MSG_DELETE
cmdSave_Click
End If
Else
MsgBar "No selected record! Select record from list."
End If
Case BTN_PRINT 'print/3
PrintReport
Case BTN_FIND 'find/4
MsgBar MSG_FIND
fraUser.Enabled = True
EnableOperation False, False, False, False, True
cmdCancel.Enabled = True
ClearAllFields Me
txtFirstName.SetFocus
End Select

End Sub

Private Sub cmdSave_Click()

'validate entries
If m_intOperation <> BTN_FIND Then
If Trim(txtUser.Text) = vbNullString Then
MsgBar "User name must not be blank. Please fill-in the field."
txtUser.SetFocus
Exit Sub
End If
If Trim(txtFirstName.Text) = vbNullString Then
MsgBar "First name must not be blank. Please fill-in the field."
txtFirstName.SetFocus
Exit Sub
End If
If Trim(txtLastName.Text) = vbNullString Then
MsgBar "Last name must not be blank. Please fill-in the field."
txtLastName.SetFocus
Exit Sub
End If
If Trim(txtGroup.Text) = vbNullString Then
MsgBar "Group/Company must not be blank. Please fill-in the field."
txtGroup.SetFocus
Exit Sub
End If
End If
'auto generate password
If m_intOperation = BTN_ADD Then
txtPassword.Text = GeneratePassword(txtFirstName.Text, txtLastName.Text, txtUser.Text, dtpBirthDate.value)
End If
 'save and load data to grid
Dim cmdTemp As ADODB.Command
Dim rsTemp As ADODB.Recordset
Dim erTemp As ADODB.Error
Dim intlastrow As Integer
Dim intCurrentRow As Integer, intCurrentCol As Integer

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rsTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spUserOperation"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(str(m_intOperation)))
.Parameters.Append .CreateParameter("strFirstName", adVarChar, adParamInput, 30, Trim(txtFirstName.Text))
.Parameters.Append .CreateParameter("strLastName", adVarChar, adParamInput, 30, Trim(txtLastName.Text))
.Parameters.Append .CreateParameter("strAddress", adVarChar, adParamInput, 100, Trim(txtAddress.Text))
.Parameters.Append .CreateParameter("strTelNum", adVarChar, adParamInput, 50, Trim(txtTelNum.Text))
.Parameters.Append .CreateParameter("intGender", adInteger, adParamInput, 4, IIf(cboGender.Text = strMALE, MALE,
FEMALE))
.Parameters.Append .CreateParameter("strBirthDay", adChar, adParamInput, DATE_LEN, Format(dtpBirthDate.value,
DATE_FORMAT))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, Trim(txtGroup.Text))
.Parameters.Append .CreateParameter("strUserID", adVarChar, adParamInput, USERID_LEN, Trim(txtUser.Text))
.Parameters.Append .CreateParameter("strPassword", adVarChar, adParamInput, 40, EncriptText(Trim(txtPassword.Text)))
.Parameters.Append .CreateParameter("strExpire", adChar, adParamInput, DATE_LEN, Format(dtpExpiry.value,
DATE_FORMAT))
.Parameters.Append .CreateParameter("intBlocked", adInteger, adParamInput, 4, IIf(cboBlocked.Text = strYES, YES, NO))
.Parameters.Append .CreateParameter("strUserTrail", adVarChar, adParamInput, USERID_LEN, g_strUserID)
Set rsTemp = .Execute
End With

Screen.MousePointer = vbHourglass
MsgBar "Loading data..."
ClearGridContents MSFlexGrid1
intlastrow = 1

With MSFlexGrid1
.Redraw = False
intCurrentRow = .Row
intCurrentCol = .Col
If rsTemp.EOF Then
.Col = 1
.Text = MSG_NORECORD
End If
Do While Not rsTemp.EOF
AddGridRow MSFlexGrid1, intlastrow
.Col = 0: .Text = rsTemp.Fields("FirstName")
.Col = 1: .Text = rsTemp.Fields("LastName")
.Col = 2: .Text = rsTemp.Fields("Address")
.Col = 3: .Text = rsTemp.Fields("TelNumber")
.Col = 4: .Text = IIf(rsTemp.Fields("Gender"), strMALE, strFEMALE)
.Col = 5: .Text = Format(rsTemp.Fields("BirthDay"), DATE_FORMAT)
.Col = 6: .Text = rsTemp.Fields("GroupCode")
.Col = 7: .Text = rsTemp.Fields("GroupName")
.Col = 8: .Text = Trim(rsTemp.Fields("UserID"))
.Col = 9: .Text = DecriptText(rsTemp.Fields("Password"))
.Col = 10: .Text = Format(rsTemp.Fields("Expire"), DATE_FORMAT)
.Col = 11: .Text = IIf(rsTemp.Fields("Blocked"), strYES, strNO)
If txtUser.Text = Trim(rsTemp.Fields("UserID")) Then
intCurrentRow = .Row
End If
intlastrow = intlastrow + 1
rsTemp.MoveNext
Loop
.Redraw = True
.TopRow = intCurrentRow
.Row = intCurrentRow
 .LeftCol = intCurrentCol
.Col = intCurrentCol
End With
cmdCancel_Click

ErrorHandler:
Screen.MousePointer = vbDefault
ErrorDisplay erTemp
Set cmdTemp = Nothing
Set rsTemp = Nothing

End Sub

Private Sub Form_Load()

fraUser.Top = FrameSet.FTop
fraUser.Left = FrameSet.FLeft
fraUser.Width = FrameSet.FWidth
EnableOperation m_blnRightsADD, m_blnRightsEDIT, m_blnRightsDELETE, m_blnRigthsPRINT, True
EnabledClose True
fraUser.Enabled = False
m_intOperation = BTN_FIND
GetGenderItem cboGender
GetYesNoItem cboBlocked
InitGrid
cmdSave_Click
MSFlexGrid1_Click
DoEvents

End Sub

Private Sub MSFlexGrid1_Click()

With MSFlexGrid1
txtFirstName.Text = Trim(.TextArray(.Row * .Cols + 0))
txtLastName.Text = Trim(.TextArray(.Row * .Cols + 1))
txtAddress.Text = Trim(.TextArray(.Row * .Cols + 2))
txtTelNum.Text = Trim(.TextArray(.Row * .Cols + 3))
SetCurrentItem cboGender, Trim(.TextArray(.Row * .Cols + 4))
dtpBirthDate.value = CheckDate(Trim(.TextArray(.Row * .Cols + 5)))
txtGroup.Text = Trim(.TextArray(.Row * .Cols + 6))
lblGroupName.Caption = Trim(.TextArray(.Row * .Cols + 7))
txtUser.Text = Trim(.TextArray(.Row * .Cols + 8))
txtPassword.Text = Trim(.TextArray(.Row * .Cols + 9))
dtpExpiry.value = CheckDate(Trim(.TextArray(.Row * .Cols + 10)))
SetCurrentItem cboBlocked, Trim(.TextArray(.Row * .Cols + 11))
If m_intOperation = BTN_EDIT Then
SelectCtl txtFirstName
End If
End With
MsgBar vbNullString

End Sub

Private Sub MSFlexGrid1_SelChange()

MSFlexGrid1_Click

End Sub

Private Sub txtLastName_LostFocus()

If m_intOperation = BTN_FIND Then
cmdSave_Click
End If

End Sub

Private Sub txtPassword_GotFocus()

SelectCtl txtPassword

End Sub

Private Sub txtTelNum_GotFocus()

 SelectCtl txtTelNum

End Sub

Private Sub txtAddress_GotFocus()

SelectCtl txtAddress

End Sub

Private Sub txtFirstName_GotFocus()

SelectCtl txtFirstName

End Sub

Private Sub txtLastName_GotFocus()

SelectCtl txtLastName

End Sub

Private Sub txtUser_GotFocus()

SelectCtl txtUser

End Sub

'Pop-up user groups

Private Sub txtGroup_GotFocus()
SelectCtl txtGroup

End Sub

Private Sub txtGroup_LostFocus()

CheckGroupsField

End Sub

Private Sub txtGroup_Validate(Cancel As Boolean)

Cancel = GroupSearch(Me, txtGroup.Text)

End Sub

Private Sub cmdGroup_Click()

GroupSearch Me, vbNullString, True
CheckGroupsField

End Sub

Private Sub CheckGroupsField()

If Groups_Search(1).GroupCode <> vbNullString Then
txtGroup.Text = Groups_Search(1).GroupCode
lblGroupName.Caption = Groups_Search(1).GroupName
End If

End Sub
'End of Pop-up clients

Function GroupSearch(frm As Form, ByVal strGroupCode As String, Optional blnDisplayAll As Boolean = False) As Boolean
ReDim Groups_Search(1)
If Trim(strGroupCode) <> vbNullString And Not blnDisplayAll Then
frmC_Groups.PassVariable = strGroupCode
If Not frmC_Groups.CodeExisting(strGroupCode) Then
frmC_Groups.Show vbModal
If Groups_Search(1).GroupCode = vbNullString Then
GroupSearch = True
End If
End If
ElseIf blnDisplayAll Then
frmC_Groups.PassVariable = vbNullString
frmC_Groups.Show vbModal
If Groups_Search(1).GroupCode = vbNullString Then
GroupSearch = True
 End If
Else
frm.lblGroupName.Caption = vbNullString
End If

End Function

MAIN MENU CODES

MAIN MENU

Option Explicit
Dim strNode As String

Private Sub MDIForm_Activate()

If g_strUserGroup = GROUP_ADMIN Then
frmLoginAdmin.Show vbModal
End If

End Sub

Private Sub MDIForm_Load()

Dim strUniqueKey As String
Dim strRelativeKey As String
Dim intIndex As Integer
Dim cmdTemp As ADODB.Command
Dim rstTemp As ADODB.Recordset
Dim mNode As Node 'Declare Node variable.

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandTimeout = 300 ' 5 mins.
.CommandType = adCmdStoredProc
.CommandText = "spGetUserMenu"
.Prepared = True
.Parameters.Append .CreateParameter("intRetval", adInteger, adParamReturnValue, 4)
.Parameters.Append .CreateParameter("strSystemCode", adChar, adParamInput, SYSTEMCODE_LEN, SYSTEM_CODE)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
Set rstTemp = .Execute
End With
Set cmdTemp = Nothing

If rstTemp.EOF Then
MsgBox "Your group's access rights has not been generated!" & Chr(10) & Chr(10) & _
"Contact your System Administrator.", vbCritical, "Generate Access Menu"
GoTo ErrorHandler
End If

With TreeView1
.ImageList = imgMenu
.LabelEdit = False
Set mNode = .Nodes.Add(, , "x" & rstTemp.Fields("MenuCode"), "Training Enrollment System", "title_menu")
Do Until rstTemp.EOF
strRelativeKey = "x" & rstTemp.Fields("MenuCode")
strUniqueKey = "x" & rstTemp.Fields("MenuCode") & rstTemp.Fields("MenuSeqNo")
Set mNode = .Nodes.Add(strRelativeKey, tvwChild)
mNode.Key = strUniqueKey
mNode.Text = rstTemp.Fields("MenuTitle")
mNode.Tag = rstTemp.Fields("TranCode") & _
SQLBooleanToVBBoolean(rstTemp.Fields("RightsADD")) & _
SQLBooleanToVBBoolean(rstTemp.Fields("RightsEDIT")) & _
SQLBooleanToVBBoolean(rstTemp.Fields("RightsDELETE")) & _
SQLBooleanToVBBoolean(rstTemp.Fields("RightsPRINT"))
mNode.Image = CheckImage(imgMenu, rstTemp.Fields("Icon"))
If SQLBooleanToVBBoolean(rstTemp.Fields("EnsureVisible")) Then
mNode.EnsureVisible
End If
 rstTemp.MoveNext
Loop
.Refresh
End With

ErrorHandler:
Set cmdTemp = Nothing
Set rstTemp = Nothing

End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)

If MsgBox(" Are you sure you want to EXIT? ", vbQuestion + vbYesNo + vbDefaultButton2, "Exit Program?") = vbNo Then
Cancel = True
Else
'update user log and user trail
UpdateUserLog strNO
End If

End Sub

Private Sub MDIForm_Resize()

Dim intH As Integer
imgSTILogo.Top = Me.ScaleHeight - imgSTILogo.Height - 15
intH = imgSTILogo.Top - 15
If intH > 0 Then
TreeView1.Height = intH
Else
TreeView1.Height = 0
End If
DoEvents

End Sub

Private Sub MDIForm_Unload(Cancel As Integer)

Set mdiMainMenu = Nothing
frmLogin.Show

End Sub

Private Sub mnu_FClose_Click()

'end of system...
End

End Sub

Private Sub mnu_HAbout_Click()

'display about...
frmAbout.Show vbModal

End Sub

Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)

Cancel = True

End Sub

Private Sub TreeView1_DblClick()

Select Case Left(strNode, 4)

'Login
Case "8888"
frmLogin.Show vbModal
Exit Sub
'Exit
Case "9999"
Unload Me
Exit Sub
'Data Entry
Case "0101"
 frmD_Registration.getRights = Mid(strNode, 5, 4)
frmD_Registration.SetFocus
Case "0102"
frmD_PrivateEvaluationList.getRights = Mid(strNode, 5, 4)
frmD_PrivateEvaluationList.SetFocus
Case "0103"
frmD_STIHQEvaluationList.getRights = Mid(strNode, 5, 4)
frmD_STIHQEvaluationList.SetFocus
Case "0104"
frmD_Grading.getRights = Mid(strNode, 5, 4)
frmD_Grading.SetFocus
Case "0105"
frmD_EvaluationSummary.getRights = Mid(strNode, 5, 4)
frmD_EvaluationSummary.SetFocus
Case "0106"
frmD_TrainingCost.getRights = Mid(strNode, 5, 4)
frmD_TrainingCost.SetFocus
Case "0107"
frmD_BlacklistTrainee.getRights = Mid(strNode, 5, 4)
frmD_BlacklistTrainee.SetFocus
Case "0108"
frmD_BlacklistTrainer.SetFocus
'Templates
Case "0201"
frmM_TrainingCourses.getRights = Mid(strNode, 5, 4)
frmM_TrainingCourses.SetFocus
Case "0202"
frmM_Evaluations.getRights = Mid(strNode, 5, 4)
frmM_Evaluations.SetFocus
'Maintenance
Case "0301"
frmM_Clients.getRights = Mid(strNode, 5, 4)
frmM_Clients.SetFocus
Case "0302"
frmM_Courses.getRights = Mid(strNode, 5, 4)
frmM_Courses.SetFocus
Case "0303"
frmM_Guidelines.SetFocus
Case "0304"
frmM_Trainer.getRights = Mid(strNode, 5, 4)
frmM_Trainer.SetFocus
Case "0305"
frmM_Venue.getRights = Mid(strNode, 5, 4)
frmM_Venue.SetFocus
Case "0306"
frmM_RoadMap.getRights = Mid(strNode, 5, 4)
frmM_RoadMap.SetFocus
Case "0307"
frmM_Trainee.getRights = Mid(strNode, 5, 4)
frmM_Trainee.SetFocus
Case "0308"
frmM_OnlineUser.getRights = Mid(strNode, 5, 4)
frmM_OnlineUser.SetFocus
'Report
Case "0401"
frmR_Registration.SetFocus
Case "0402"
frmR_Attendance.SetFocus
Case "0403"
frmR_GradeReport.SetFocus
Case "0405"
frmR_Certificate.SetFocus
Case "0406"
frmR_PrivateEvaluation.SetFocus
Case "0407"
frmR_STIHQTrainingEvaluation.SetFocus
Case "0408"
frmR_EvaluationSummary.SetFocus
Case "0409"
frmR_EvaluationRating.SetFocus
 Case "0410"
frmR_TrainingGrade.SetFocus
Case "0411"
frmR_TrainingCost.SetFocus
Case "0412"
frmR_TraineesComments.SetFocus
Case "0413"
frmR_TrainingSummary.SetFocus
'Utility
Case "0501"
frmU_ChangePassword.SetFocus
Case "0502"
frmU_ImportData.SetFocus
Case "0503"
If g_strUserRole = GROUP_ADMIN Then
frmU_ManageUser.getRights = Mid(strNode, 5, 4)
frmU_ManageUser.SetFocus
Else
MsgBox " User is not allowed to access this menu! ", vbCritical, SYSTEM_NAME
End If
Case "0504"
frmU_DataMaintenance.SetFocus
Case "0505"
frmU_Archiving.SetFocus
End Select

End Sub

Private Sub TreeView1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
TreeView1_DblClick
ElseIf KeyAscii >= 32 Then
KeyAscii = 0
End If

End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)

strNode = Node.Tag

End Sub

MODULES CODES

COMMON

Option Explicit

'Used by PAUSE sub.

Declare Function GetTickCount Lib "kernel32" () As Long

Sub Pause(lngHowLong As Long)

Dim u%, lngTick As Long

lngTick = GetTickCount()
Do
u% = DoEvents
Loop Until lngTick + lngHowLong < GetTickCount

End Sub

Sub RestoreWindow(lnghWnd As Long)

Dim currWinP As WINDOWPLACEMENT

If lnghWnd Then
'prepare the WINDOWPLACEMENT type
currWinP.Length = Len(currWinP)
 If GetWindowPlacement(lnghWnd, currWinP) > 0 Then
'determine the window state
If currWinP.showCmd = SW_SHOWMINIMIZED Then
'minimized, so restore
currWinP.Length = Len(currWinP)
currWinP.flags = 0&
currWinP.showCmd = SW_SHOWMAXIMIZED
Call SetWindowPlacement(lnghWnd, currWinP)
Else
'on screen, so assure visible
Call SetForegroundWindow(lnghWnd)
Call BringWindowToTop(lnghWnd)
End If
End If
End If

End Sub

Sub ErrorDisplay(objErr As ADODB.Error)

Dim strError As String
For Each objErr In cnnServer.Errors
If objErr.NativeError >= 50001 Then
MsgBar "NativeError: " & objErr.NativeError & " - " & objErr.Description
Else
strError = "Error #" & objErr.Number & vbCr & _
" " & objErr.Description & vbCr & _
" (Source: " & objErr.Source & ")" & vbCr & _
" (SQL State: " & objErr.SQLState & ")" & vbCr & _
" (NativeError: " & objErr.NativeError & ")" & vbCr
If objErr.HelpFile = "" Then
strError = strError & _
" No Help file available" & vbCr & vbCr
Else
strError = strError & _
" (HelpFile: " & objErr.HelpFile & ")" & vbCr & _
" (HelpContext: " & objErr.HelpContext & ")" & _
vbCr & vbCr
End If
MsgBox strError
End If

Next

End Sub

Sub SelectCtl(ctl As Control, Optional blnMaskedDate As Boolean)

If ctl.Enabled And ctl.Visible Then
ctl.SetFocus
ctl.SelStart = 0
'solution to problem of not highlighting all the text in masked date
blnMaskedDate = IIf(IsMissing(blnMaskedDate), False, blnMaskedDate)
If blnMaskedDate Then 'set focus includes the slashes of date
ctl.SelLength = Len(ctl.FormattedText)
Else
ctl.SelLength = Len(ctl)
End If
End If

End Sub

Sub SelectEnd(ctl As Control)

If ctl.Enabled And ctl.Visible Then
ctl.SelStart = 0
ctl.SelStart = Len(ctl)
End If

End Sub

Sub SetCurrentItem(CurrentCtl As Control, strGridContent)

Dim intCtr As Integer
 If Trim(strGridContent) <> vbNullString Then
With CurrentCtl
For intCtr = 0 To .ListCount
If Left(.List(intCtr), Len(strGridContent)) = strGridContent Then
CurrentCtl.ListIndex = intCtr
Exit Sub
End If
Next intCtr
End With
Else
CurrentCtl.ListIndex = -1
End If

End Sub

Sub ClearGridContents(flxgrd As Control)

With flxgrd
.Rows = 1 'heading will remain
.Rows = 2 'add new row after heading
End With

End Sub

Sub AddGridRow(flxgrd As Control, intlastrow)

With flxgrd
.Row = intlastrow
If .Row = .Rows - 1 Then 'current row = total rows - 1
.Rows = .Rows + 1 'total rows dynamically grow
End If
End With

End Sub

Sub ClearAllFields(ctrls As Form)

Dim ctl As Control
For Each ctl In ctrls
If TypeOf ctl Is TextBox And ctl.Tag <> "RYAN" Then
ctl.Text = vbNullString
ElseIf TypeOf ctl Is Label And ctl.Tag = "RYAN" Then
ctl.Caption = vbNullString
ElseIf TypeOf ctl Is ComboBox Then
ctl.ListIndex = 0
ElseIf TypeOf ctl Is CheckBox Then
ctl.value = 0
ElseIf TypeOf ctl Is DTPicker Then
ctl.value = Date
End If
Next

End Sub

Sub GetYesNoItem(CurrentCtl As Control)

With CurrentCtl
.AddItem strYES
.AddItem strNO
End With
CurrentCtl.ListIndex = 0

End Sub

Sub GetPassFailItem(CurrentCtl As Control)

With CurrentCtl
.AddItem strYES
.AddItem strINC
.AddItem strNO
End With
CurrentCtl.ListIndex = 0

End Sub
Sub GetTimeItem(CurrentCtl As Control)
With CurrentCtl
.AddItem "08:00AM-12:00PM"
.AddItem "01:00PM-05:00PM"
.AddItem "08:00AM-05:00PM"
End With
CurrentCtl.ListIndex = 0

End Sub

Sub GetTrainingStatusItem(CurrentCtl As Control)

With CurrentCtl
.AddItem "Open for Registration"
.AddItem "Re-Scheduled"
.AddItem "Done"
.AddItem "Full"
.AddItem "Cancelled"
End With
CurrentCtl.ListIndex = 0

End Sub

Sub GetGenderItem(CurrentCtl As Control)

With CurrentCtl
.AddItem strMALE
.AddItem strFEMALE
End With
CurrentCtl.ListIndex = 0

End Sub

Sub GetRegions(CurrentCtl As Control, CurrentCtl2 As Control)

Dim cmdTemp As ADODB.Command
Dim rstTemp As ADODB.Recordset
On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rstTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetRegions"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
Set rstTemp = .Execute
End With

CurrentCtl.Clear
CurrentCtl2.Clear
Do While Not rstTemp.EOF
CurrentCtl.AddItem rstTemp.Fields("RegionName")
CurrentCtl2.AddItem rstTemp.Fields("RegionCode")
rstTemp.MoveNext
Loop
CurrentCtl.ListIndex = 0
CurrentCtl2.ListIndex = 0

ErrorHandler:
Set cmdTemp = Nothing
Set rstTemp = Nothing
End Sub

Sub GetDeanCOOTitle(CurrentCtl As Control)

Dim cmdTemp As ADODB.Command
Dim rstTemp As ADODB.Recordset
On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

Set rstTemp = New ADODB.Recordset
With cmdTemp
.ActiveConnection = cnnServer
 .CommandText = "spGetDeanCOOTitle"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
Set rstTemp = .Execute
End With

CurrentCtl.Clear
Do While Not rstTemp.EOF
CurrentCtl.AddItem rstTemp.Fields("TitleDesc")
rstTemp.MoveNext
Loop
CurrentCtl.ListIndex = 0

ErrorHandler:
Set cmdTemp = Nothing
Set rstTemp = Nothing
End Sub

Sub MsgBar(strMsg As String)

If IsNull(strMsg) Or Len(strMsg) = 0 Then
mdiMainMenu.StatusBar1.Panels.Item(2).Text = vbNullString
Else
mdiMainMenu.StatusBar1.Panels.Item(2).Text = strMsg
End If
mdiMainMenu.StatusBar1.Refresh

End Sub

ENUMERATIONS

Option Explicit

Enum SystemButton
'Button Standart Color
BBackColor = "&H00FFC0C0"
End Enum

Enum FrameSet
FTop = 60
FLeft = 120
FWidth = 8715
End Enum

Enum FormSet
FormTop = 0
FormLeft = 0
FormHeight = 7485
FormWidth = 8940
End Enum

'----------------------------
' Array Table Declarations...
'----------------------------
Type Table_Clients_Search
ClientCode As String
ClientName As String
End Type
Global Clients_Search() As Table_Clients_Search

Type Table_Venues_Search
VenueCode As String
VenueName As String
End Type
Global Venues_Search() As Table_Venues_Search

Type Table_Courses_Search
CourseCode As String
CourseName As String
End Type
Global Courses_Search() As Table_Courses_Search

Type Table_Trainers_Search
TrainerCode As String
TrainerName As String
End Type
Global Trainers_Search() As Table_Trainers_Search

Type Table_Groups_Search
GroupCode As String
GroupName As String
End Type
Global Groups_Search() As Table_Groups_Search

Type Table_TrainingCourses_Search
TrainingCode As String
TrainingName As String
CourseCode As String
CourseName As String
TrainerCode As String
TrainerName As String
ScheduleFr As Date
ScheduleTo As Date
ScheduleTime As String
Days As String
End Type
Global TrainingCourses_Search() As Table_TrainingCourses_Search

Type Table_Trainees_Search
TraineeCode As String
TraineeName As String
End Type
Global Trainees_Search() As Table_Trainees_Search

Type Table_DeanCOO_Search
DeanCode As String
DeanName As String
GroupCode As String
GroupName As String
End Type
Global DeanCOO_Search() As Table_DeanCOO_Search

Type Table_OverAll_Temp
TrainingCode As String
TraineeCode As String
Description As String
Grade As Integer
Comments As String
End Type
Global OverAll_Table() As Table_OverAll_Temp

Type Table_PvtEvaluation_Temp
TrainingCode As String
TraineeCode As String
Description As String
Grade As Integer
End Type
Global PvtEvaluation_Table() As Table_PvtEvaluation_Temp

FUNCTION

Option Explicit

' use to get computer name

Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As String, nSize As Long) As Long

Function GetComputerName() As String

Dim sBuffer As String * 255
 If GetComputerNameA(sBuffer, 255&) <> 0 Then
GetComputerName = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End If
End Function

Function PadL(strVar As String, intVar As Integer, strChar As String) As String

'Pad String with define character
Dim X As Integer

PadL = strVar
For X = Len(strVar) To (intVar - 1)
PadL = strChar + PadL
Next X

End Function

Function SQLBooleanToVBBoolean(bValue As Boolean) As Long

If bValue Then
SQLBooleanToVBBoolean = 1
Else
SQLBooleanToVBBoolean = 0
End If

End Function

Function CheckImage(img As ImageList, strImageName) As String

Dim intCtr As Long
With img
For intCtr = 1 To .ListImages.Count
If strImageName = .ListImages.Item(intCtr).Key Then
CheckImage = strImageName
Exit For
Else
CheckImage = "default"
End If
Next intCtr
End With

End Function

Function CheckIfNull(value As Variant) As Variant

If IsNull(value) Then
CheckIfNull = vbNullString
Else
CheckIfNull = value
End If

End Function

Function CheckNumeric(intKeyPress As Integer, ctlTextBox As Control) As Integer

If intKeyPress = 8 Then ' backspace
If ctlTextBox.Text = vbNullString Then ' no need to backspace
CheckNumeric = 0
Exit Function
Else
If ctlTextBox.Locked = False Then
SendKeys "{END}"
ctlTextBox.Text = Mid(ctlTextBox.Text, 1, Len(ctlTextBox.Text) - 1)
End If
End If
ElseIf intKeyPress = 46 And InStr(1, ctlTextBox.Text, ".", vbBinaryCompare) > 0 Then
CheckNumeric = 0 'do not accept if not "." is already exist
ElseIf Not (intKeyPress = 46 Or (intKeyPress >= 48 And intKeyPress <= 57)) Then
CheckNumeric = 0 'do not accept if not "." or "0-9"
Else
CheckNumeric = intKeyPress
End If

End Function
Function RemoveComma(strString As String) As String
Dim strAmount As String, strFinalAmount As String
Dim intCtr As Integer

RemoveComma = vbNullString

If strString = vbNullString Then Exit Function

strAmount = Trim(strString)
For intCtr = 1 To Len(strAmount)
If Mid(strAmount, intCtr, 1) <> "," Then
strFinalAmount = strFinalAmount + Mid(strAmount, intCtr, 1)
End If
Next
RemoveComma = Trim(str(CheckCCur(strFinalAmount)))

End Function

Function CheckCCur(strAmount As String) As Currency

On Error Resume Next
If Trim(strAmount) = vbNullString Then
CheckCCur = 0
ElseIf Not IsNumeric(strAmount) Then
CheckCCur = 0
Else
CheckCCur = CCur(strAmount)
End If

End Function

Function FillWithSpaces(FieldData, FieldLen) As String

Dim filler$
If FieldData = vbNullString Then
FillWithSpaces = Space(FieldLen)
Else
filler =
"!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@" '@(100)
FillWithSpaces = Format$(FieldData, Left$(filler, FieldLen + 1))
End If

End Function

Function CheckDate(strDate As String) As Date

CheckDate = Date
If strDate <> vbNullString Then
CheckDate = CDate(strDate)
End If

End Function

Function CheckBlacklisted(strRem As String, strTraineeCode As String) As ADODB.Recordset

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spGetBlacklisted"
.CommandType = adCmdStoredProc
.CommandTimeout = 180 ' 3 mins.
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, strRem)
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strTraineeCode", adChar, adParamInput, GENERICCODE_LEN, strTraineeCode)
.Parameters.Append .CreateParameter("strSysDate", adChar, adParamInput, DATE_LEN, g_strCurrentDate)
Set CheckBlacklisted = .Execute
End With
ErrorHandler:
Set cmdTemp = Nothing

End Function

Function ClientSearch(frm As Form, ByVal strClientCode As String, Optional blnDisplayAll As Boolean = False) As Boolean
ReDim Clients_Search(1)
If Trim(strClientCode) <> vbNullString And Not blnDisplayAll Then
frmC_Clients.PassVariable = strClientCode
If Not frmC_Clients.CodeExisting(strClientCode) Then
frmC_Clients.Show vbModal
If Clients_Search(1).ClientCode = vbNullString Then
ClientSearch = True
End If
End If
ElseIf blnDisplayAll Then
frmC_Clients.PassVariable = vbNullString
frmC_Clients.Show vbModal
If Clients_Search(1).ClientCode = vbNullString Then
ClientSearch = True
End If
Else
frm.lblGroupName.Caption = vbNullString
End If

End Function

Function VenueSearch(frm As Form, ByVal strVenueCode As String, Optional blnDisplayAll As Boolean = False) As Boolean
ReDim Venues_Search(1)
If Trim(strVenueCode) <> vbNullString And Not blnDisplayAll Then
frmC_Venues.PassVariable = strVenueCode
If Not frmC_Venues.CodeExisting(strVenueCode) Then
frmC_Venues.Show vbModal
If Venues_Search(1).VenueCode = vbNullString Then
VenueSearch = True
End If
End If
ElseIf blnDisplayAll Then
frmC_Venues.PassVariable = vbNullString
frmC_Venues.Show vbModal
If Venues_Search(1).VenueCode = vbNullString Then
VenueSearch = True
End If
Else
frm.lblVenueName.Caption = vbNullString
End If

End Function

Function CourseSearch(frm As Form, ByVal strCourseCode As String, Optional blnDisplayAll As Boolean = False) As Boolean
ReDim Courses_Search(1)
If Trim(strCourseCode) <> vbNullString And Not blnDisplayAll Then
frmC_Courses.PassVariable = strCourseCode
If Not frmC_Courses.CodeExisting(strCourseCode) Then
frmC_Courses.Show vbModal
If Courses_Search(1).CourseCode = vbNullString Then
CourseSearch = True
End If
End If
ElseIf blnDisplayAll Then
frmC_Courses.PassVariable = vbNullString
frmC_Courses.Show vbModal
If Courses_Search(1).CourseCode = vbNullString Then
CourseSearch = True
End If
Else
frm.lblCourseName.Caption = vbNullString
End If

End Function
Function TrainerSearch(frm As Form, ByVal strTrainerCode As String, Optional blnDisplayAll As Boolean = False) As Boolean
ReDim Trainers_Search(1)
If Trim(strTrainerCode) <> vbNullString And Not blnDisplayAll Then
frmC_Trainers.PassVariable = strTrainerCode
If Not frmC_Trainers.CodeExisting(strTrainerCode) Then
frmC_Trainers.Show vbModal
If Trainers_Search(1).TrainerCode = vbNullString Then
TrainerSearch = True
End If
End If
ElseIf blnDisplayAll Then
frmC_Trainers.PassVariable = vbNullString
frmC_Trainers.Show vbModal
If Trainers_Search(1).TrainerCode = vbNullString Then
TrainerSearch = True
End If
Else
frm.lblTrainerName.Caption = vbNullString
End If

End Function

Function RequisiteSearch(frm As Form, ByVal strRequisiteCode As String, Optional blnDisplayAll As Boolean = False) As Boolean
ReDim Courses_Search(1)
If Trim(strRequisiteCode) <> vbNullString And Not blnDisplayAll Then
frmC_PreRequisite.PassVariable = strRequisiteCode
If Not frmC_PreRequisite.CodeExisting(strRequisiteCode) Then
frmC_PreRequisite.Show vbModal
If Courses_Search(1).CourseCode = vbNullString Then
RequisiteSearch = True
End If
End If
ElseIf blnDisplayAll Then
frmC_PreRequisite.PassVariable = vbNullString
frmC_PreRequisite.Show vbModal
If Courses_Search(1).CourseCode = vbNullString Then
RequisiteSearch = True
End If
Else
frm.lblRequisite.Caption = vbNullString
End If

End Function

Function TrainingCourseSearch(frm As Form, ByVal strTrainingCode As String, Optional blnDisplayAll As Boolean = False) As
Boolean
ReDim TrainingCourses_Search(1)
If Trim(strTrainingCode) <> vbNullString And Not blnDisplayAll Then
frmC_TrainingCourses.PassVariable = strTrainingCode
If Not frmC_TrainingCourses.CodeExisting(strTrainingCode) Then
frmC_TrainingCourses.Show vbModal
If TrainingCourses_Search(1).TrainingCode = vbNullString Then
TrainingCourseSearch = True
End If
End If
ElseIf blnDisplayAll Then
frmC_TrainingCourses.PassVariable = vbNullString
frmC_TrainingCourses.Show vbModal
If TrainingCourses_Search(1).TrainingCode = vbNullString Then
TrainingCourseSearch = True
End If
Else
frm.lblCourseName.Caption = vbNullString
End If

End Function

Function TraineeSearch(frm As Form, ByVal strTraineeCode As String, Optional blnDisplayAll As Boolean = False) As Boolean
ReDim Trainees_Search(1)
 If Trim(strTraineeCode) <> vbNullString And Not blnDisplayAll Then
frmC_Trainees.PassVariable = strTraineeCode
If Not frmC_Trainees.CodeExisting(strTraineeCode) Then
frmC_Trainees.Show vbModal
If Trainees_Search(1).TraineeCode = vbNullString Then
TraineeSearch = True
End If
End If
ElseIf blnDisplayAll Then
frmC_Trainees.PassVariable = vbNullString
frmC_Trainees.Show vbModal
If Trainees_Search(1).TraineeCode = vbNullString Then
TraineeSearch = True
End If
Else
frm.lblTraineeName.Caption = vbNullString
End If

End Function

Function FilteredTraineeSearch(frm As Form, strTrainingCode As String, ByVal strTraineeCode As String, Optional blnDisplayAll
As Boolean = False) As Boolean
ReDim Trainees_Search(1)
If Trim(strTraineeCode) <> vbNullString And Not blnDisplayAll Then
frmC_FilteredTrainees.PassVariable = strTraineeCode
frmC_FilteredTrainees.PassVariable2 = strTrainingCode
If Not frmC_FilteredTrainees.CodeExisting(strTrainingCode, strTraineeCode) Then
frmC_FilteredTrainees.Show vbModal
If Trainees_Search(1).TraineeCode = vbNullString Then
FilteredTraineeSearch = True
End If
End If
ElseIf blnDisplayAll Then
frmC_FilteredTrainees.PassVariable = vbNullString
frmC_FilteredTrainees.PassVariable2 = strTrainingCode
frmC_FilteredTrainees.Show vbModal
If Trainees_Search(1).TraineeCode = vbNullString Then
FilteredTraineeSearch = True
End If
Else
frm.lblTraineeName.Caption = vbNullString
End If

End Function

Function DeanSearch(frm As Form, ByVal strDeanCode As String, Optional blnDisplayAll As Boolean = False) As Boolean
ReDim DeanCOO_Search(1)
If Trim(strDeanCode) <> vbNullString And Not blnDisplayAll Then
frmC_OnlineUsers.PassVariable = strDeanCode
If Not frmC_OnlineUsers.CodeExisting(strDeanCode) Then
frmC_OnlineUsers.Show vbModal
If DeanCOO_Search(1).DeanCode = vbNullString Then
DeanSearch = True
End If
End If
ElseIf blnDisplayAll Then
frmC_OnlineUsers.PassVariable = vbNullString
frmC_OnlineUsers.Show vbModal
If DeanCOO_Search(1).DeanCode = vbNullString Then
DeanSearch = True
End If
Else
frm.lblEnrolledBy.Caption = vbNullString
End If

End Function

Function CreateSystemCode(strPar1 As String) As String

Dim cmdTemp As ADODB.Command
 On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spCreateSystemCode"
.CommandType = adCmdStoredProc
.CommandTimeout = 0
.Prepared = True
.Parameters.Append .CreateParameter("intReturn", adBigInt, adParamOutput)
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(strPar1))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Execute , , adExecuteNoRecords
CreateSystemCode = Format(.Parameters("intReturn"), GENERICCODE_FORMAT)
End With
MsgBar vbNullString

ErrorHandler:
Set cmdTemp = Nothing

End Function

Function GetSchedule(dteFr As Date, dteTo As Date, strDays As String) As String

Dim X As Integer
Dim y As Integer
Dim strDD As String
Dim intY As Integer
Dim arrWeeks As Variant
If (CCur(strDays) = 1 Or CCur(strDays) = 10 Or _
CCur(strDays) = 100 Or CCur(strDays) = 1000 Or _
CCur(strDays) = 10000 Or CCur(strDays) = 100000 Or _
CCur(strDays) = 100000) Then
GetSchedule = Format(dteFr, LONGDATE_FORMAT)
Exit Function
ElseIf (CCur(strDays) = 11 Or CCur(strDays) = 1100000 Or _
CCur(strDays) = 111 Or CCur(strDays) = 1110000 Or _
CCur(strDays) = 1111 Or CCur(strDays) = 1111000 Or _
CCur(strDays) = 11111 Or CCur(strDays) = 1111100 Or _
CCur(strDays) = 111111 Or CCur(strDays) = 1111110 Or _
CCur(strDays) = 1111111 Or CCur(strDays) = 1100 Or _
CCur(strDays) = 11100 Or CCur(strDays) = 111100) Then
GetSchedule = Format(dteFr, "Mmmm dd") & " - " & Format(dteTo, "dd, yyyy")
Exit Function
Else
arrWeeks = Array(0, 2, 3, 4, 5, 6, 7, 1)
For X = 1 To (dteTo - dteFr) + 1
For y = 1 To Len(strDays)
If Weekday(dteFr + X - 1) = arrWeeks(y) Then
If Mid(strDays, y, 1) = "1" Then
strDD = strDD & Day(dteFr + X - 1) & ", "
End If
End If
Next
Next
GetSchedule = MonthName(Month(dteFr)) & " " & strDD & Year(dteFr)
End If

End Function

Function CheckIfCanBeDelete(strPar1 As String, strPar2 As String) As Boolean

Dim cmdTemp As ADODB.Command

On Error GoTo ErrorHandler

Set cmdTemp = New ADODB.Command

With cmdTemp
.ActiveConnection = cnnServer
.CommandText = "spCheckIfCanBeDelete"
.CommandType = adCmdStoredProc
.CommandTimeout = 0
 .Prepared = True
.Parameters.Append .CreateParameter("intReturn", adBigInt, adParamReturnValue)
.Parameters.Append .CreateParameter("strOperation", adChar, adParamInput, 1, Trim(strPar1))
.Parameters.Append .CreateParameter("strGroupCode", adChar, adParamInput, GROUPCODE_LEN, g_strUserGroup)
.Parameters.Append .CreateParameter("strGenericCode", adChar, adParamInput, GENERICCODE_LEN, strPar2)
.Execute , , adExecuteNoRecords
CheckIfCanBeDelete = (.Parameters("intReturn") = 0)
End With
MsgBar vbNullString

ErrorHandler:
Set cmdTemp = Nothing

End Function

INI SETTING

Option Explicit

'ini file location

Global g_strIniFile As String
'Global variable from .ini file.
Global Const SERVER_SECTION = "ServerInfo"
'server information
Global g_ServerDriver As String
Global g_ServerProvider As String
Global g_ServerName As String
Global g_ServerDatabase As String

Global Const COMPANY_SECTION = "CompanyInfo"

'company information
Global g_CompanyName As String
Global g_CompanyDepartment As String

Global Const DIRECTORY_SECTION = "DirectoryInfo"

'folder information
Global g_DirectoryReports As String
Global g_DirectoryBackUp As String

Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String,
ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName
As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String,
ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Function WriteIniFile(ByVal sIniFileName As String, ByVal sSection As String, ByVal sItem As String, ByVal sText As String) As
Boolean
'Purpose: To write to an .ini file for a given Selection.
'Arguments: IniFileName - the name of the ini file (including .ini).
' if the path is not included, windows will put
' the file into the windows directory.
' sSection - name of the section heading (don't include [])
' sItem - The item heading (the item before the =)
' sText - text to write to the ini file.
'Returns: True/False
'Uses: WritePrivateProfileString
Dim i As Integer
On Error GoTo ErrorHandler

i = WritePrivateProfileString(sSection, sItem, sText, sIniFileName)

WriteIniFile = True

Exit Function

ErrorHandler:
WriteIniFile = False
End Function

Function ReadIniFile(ByVal sIniFileName As String, ByVal sSection As String, ByVal sItem As String, ByVal sDefault As String)
As String
'Purpose: Will read an .ini file for a given selection.
'Arguments: sIniFileName - the name of the ini file (including .ini).
' if the path is not included, windows will put
' the file into the windows directory.
' sSection - name of the section heading (don't include [])
' sItem - The item heading (the item before the =)
' sDefault - If the item, section, or the file doesn't
' exist, then this will be returned.
'Returns: the value of sItem, or sDefault if not found
'Uses: GetPrivateProfileString()
Dim iRetAmount As Integer 'the amount of characters returned
Dim sTemp As String

sTemp = String$(50, 0) 'fill with nulls

iRetAmount = GetPrivateProfileString(sSection, sItem, sDefault, sTemp, 50, sIniFileName)
sTemp = Left$(sTemp, iRetAmount)
ReadIniFile = sTemp

End Function

Function SetVariablesFromINI() As Boolean

'check if ini file exists...
If Dir(g_strIniFile) = vbNullString Then
CreateIniFile
End If

'initialize server information

g_ServerDriver = ReadIniFile(g_strIniFile, SERVER_SECTION, "Driver", "")
If Trim(g_ServerDriver) = vbNullString Then
Exit Function
End If
g_ServerProvider = ReadIniFile(g_strIniFile, SERVER_SECTION, "Provider", "")
If Trim(g_ServerProvider) = vbNullString Then
Exit Function
End If
g_ServerName = ReadIniFile(g_strIniFile, SERVER_SECTION, "ServerName", "")
If Trim(g_ServerName) = vbNullString Then
Exit Function
End If
g_ServerDatabase = ReadIniFile(g_strIniFile, SERVER_SECTION, "Database", "")
If Trim(g_ServerDatabase) = vbNullString Then
Exit Function
End If

'initialize directory information

g_DirectoryReports = ReadIniFile(g_strIniFile, DIRECTORY_SECTION, "Reports", "")
If Trim(g_DirectoryReports) = vbNullString Then
Exit Function
End If

g_DirectoryBackUp = ReadIniFile(g_strIniFile, DIRECTORY_SECTION, "Backup", "")

If Trim(g_DirectoryBackUp) = vbNullString Then
Exit Function
End If

SetVariablesFromINI = True

End Function

Public Sub CreateIniFile()

Dim fileNum As Integer

fileNum = FreeFile
Open (g_strIniFile) For Output As #fileNum
Print #fileNum, "[ServerInfo]"
Print #fileNum, " Driver={SQL Server}"
 Print #fileNum, " Provider=SQLOLEDB"
Print #fileNum, " ServerName=localpc"
Print #fileNum, " Database=STITES"
Print #fileNum, ""
Print #fileNum, "[DirectoryInfo]"
Print #fileNum, " Reports=D:\myThesis\STITESVB\Reports\"
Print #fileNum, " BackUp=D:\myThesis\STITESVB\BackUp\"
Close #fileNum

End Sub

SECURITY

Option Explicit

Function EncriptText(strPassword As String) As String

'Encript a Character String.
Dim strHexa As String
Dim X As Integer

'convert text to hexadecimal

For X = 1 To Len(strPassword)
strHexa = strHexa + PadL(Hex(Asc(Mid(strPassword, X, 1))), 2, "0")
Next X
'inverse the converted hexadecimal
For X = 1 To Len(strHexa)
EncriptText = Mid(strHexa, X, 1) + EncriptText
Next X

End Function

Function DecriptText(strPassword As String) As String

'Decript a Encripted String.
Dim strHexa As String
Dim X As Integer

'inverse the encripted text

For X = 1 To Len(strPassword)
strHexa = Mid(strPassword, X, 1) + strHexa
Next X
'convert hexadecimal to text
For X = 1 To Len(strHexa) Step 2
DecriptText = DecriptText + Chr("&H" & Mid(strHexa, X, 2))
Next X

End Function

Function GeneratePassword(str1 As String, str2 As String, str3 As String, dte1 As Date) As String
GeneratePassword = Right(Trim(str3), 1) & _
Right(Trim(str2), 1) & _
Right(Trim(str1), 1) & _
Left(Trim(str1), 1) & _
Left(Trim(str2), 1) & _
Left(Trim(str3), 1) & _
Right(Format((dte1), "dd"), 1)

End Function

Function GetUserAndPassword(strUserID As String, strPassword As String) As ADODB.Recordset

'Check for User and Password.
Dim cmdUser As ADODB.Command

On Error GoTo ErrorHandler

Set cmdUser = New ADODB.Command

With cmdUser
.ActiveConnection = cnnServer
.CommandTimeout = 0
.CommandText = "spGetUserAndPassword"
 .CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strUserID", adVarChar, adParamInput, USERID_LEN, strUserID)
.Parameters.Append .CreateParameter("strPassword", adVarChar, adParamInput, PASSWORD_LEN, strPassword)
Set GetUserAndPassword = .Execute
End With

ErrorHandler:
Set cmdUser = Nothing

End Function

Sub ChangePassword(strUserID As String, strCurrent As String, strNew As String)

'Check for User and Password.
Dim cmdUser As ADODB.Command

On Error GoTo ErrorHandler

Set cmdUser = New ADODB.Command

With cmdUser
.ActiveConnection = cnnServer
.CommandTimeout = 0
.CommandText = "spChangePassword"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("strUserID", adVarChar, adParamInput, USERID_LEN, strUserID)
.Parameters.Append .CreateParameter("strCurrent", adVarChar, adParamInput, PASSWORD_LEN, strCurrent)
.Parameters.Append .CreateParameter("strNew", adVarChar, adParamInput, PASSWORD_LEN, strNew)
.Execute adExecuteNoRecords
End With

ErrorHandler:
Set cmdUser = Nothing

End Sub

Function IsUserLog(strUserID As String) As Boolean

'Check if user already logged in.
Dim cmdUser As ADODB.Command

On Error GoTo ErrorHandler

Set cmdUser = New ADODB.Command

With cmdUser
.ActiveConnection = cnnServer
.CommandTimeout = 0
.CommandText = "spIsUserLog"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("intRetval", adInteger, adParamReturnValue, 4)
.Parameters.Append .CreateParameter("strSystemCode", adChar, adParamInput, SYSTEMCODE_LEN, SYSTEM_CODE)
.Parameters.Append .CreateParameter("strUserID", adVarChar, adParamInput, USERID_LEN, strUserID)
.Execute , , adExecuteNoRecords
IsUserLog = (.Parameters("intRetval") = YES)
End With

ErrorHandler:
Set cmdUser = Nothing

End Function

Function UpdateUserLog(strYESNO As String)

'Log User.
Dim cmdUser As ADODB.Command

On Error GoTo ErrorHandler

Set cmdUser = New ADODB.Command

With cmdUser
.ActiveConnection = cnnServer
.CommandTimeout = 0
.CommandText = "spUpdateUserLog"
.CommandType = adCmdStoredProc
 .Parameters.Append .CreateParameter("strJustLogged", adChar, adParamInput, 3, strYESNO)
.Parameters.Append .CreateParameter("strApplication", adChar, adParamInput, SYSTEMCODE_LEN, SYSTEM_CODE)
.Parameters.Append .CreateParameter("strUserID", adVarChar, adParamInput, USERID_LEN, Trim(g_strUserID))
.Parameters.Append .CreateParameter("strTimeIn", adChar, adParamInput, DATETIME_LEN, g_strLoginDate)
.Parameters.Append .CreateParameter("strTimeOut", adChar, adParamInput, DATETIME_LEN, Format(Now(),
DATETIME_FORMAT))
.Parameters.Append .CreateParameter("strComputer", adVarChar, adParamInput, COMPUTER_LEN, GetComputerName)
.Execute , , adExecuteNoRecords

End With

ErrorHandler:
Set cmdUser = Nothing

End Function

START UP

Option Explicit

'Server Connection variable.

Global cnnServer As ADODB.Connection
Global cnnReport As ADODB.Connection

Function ConnectionToServer(frm As Form) As Boolean

'Connect to Database Server.
On Error GoTo ErrorHandler

frm.Caption = "Connecting to " & UCase(g_ServerName) & "\" & UCase(g_ServerDatabase) & " Database..."
DoEvents
Pause 500

'initialize connection/recordset variable

Set cnnServer = New ADODB.Connection
'close connection every time it passes here
If cnnServer.State = adStateOpen Then
cnnServer.Close
End If
'initialize connection/recordset variable
Set cnnReport = New ADODB.Connection
'close connection every time it passes here
If cnnReport.State = adStateOpen Then
cnnReport.Close
End If

cnnReport = "Driver=" & g_ServerDriver & "; Server=" & g_ServerName & "; UID=sa; PWD=E=mc2000;Database=" &
g_ServerDatabase
'establishing connection to default database
cnnServer.CursorLocation = adUseClient
cnnServer.Provider = g_ServerProvider
cnnServer.Open "Data Source=" & g_ServerName & _
";Initial Catalog=" & g_ServerDatabase & _
";", "sa", "E=mc2000"

frm.Caption = "Connected to " & UCase(g_ServerName) & "\" & UCase(g_ServerDatabase) & " Database."
DoEvents
Pause 500
ConnectionToServer = True
Exit Function

ErrorHandler:
'NewErrorDisplay cnnServer
frm.Caption = "Unable to Connect " & UCase(g_ServerName) & "\" & UCase(g_ServerDatabase) & " Database."
DoEvents
Pause 1000

End Function

Sub Main()
 Dim frm As frmAbout
Dim clsCursor As New MousePointer
Dim lnghWnd As Long
Dim strTitleBar As String

On Error GoTo ErrorHandler

g_strIniFile = Environ$("windir") & "\STITES.Cfg"

'initialize gloval variable from INI files...
If Not SetVariablesFromINI Then
Exit Sub
End If

'check if program is running

strTitleBar = "Logon Information"
' check the logon menu
lnghWnd = FindWindow(vbNullString, strTitleBar)
If lnghWnd Then
Call RestoreWindow(lnghWnd)
Else
' if not maybe the main menu screen
lnghWnd = FindWindow(vbNullString, SYSTEM_NAME)
If lnghWnd Then
Call RestoreWindow(lnghWnd)
Else
' it's final that two mentioned title bar caption is not yet activated, so activate it
' toss up splash
Set frm = New frmAbout
With frm
.SplashMode = True
.Show
.Refresh
End With
clsCursor.ShowCursor ' show hour glass
If ConnectionToServer(frm) Then
Load frmLogin
frm.Hide ' hide splash screen
frmLogin.Show
Unload frm
Set frm = Nothing
Else
Unload frm
Set frm = Nothing
End ' stop execution right away
End If
End If
End If
Exit Sub

ErrorHandler:
End

End Sub

VARIABLE

'use in hide/show taskbar

Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetWindowPlacement Lib "user32" (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function SetWindowPlacement Lib "user32" (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As
String) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal y
As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Global Const SWP_HIDEWINDOW = &H80
Global Const SWP_SHOWWINDOW = &H40
Global Const conHwndTopmost = -1
Global Const conSwpNoActivate = &H10
Global Const conSwpShowWindow = &H40
Global Const HWND_BOTTOM = 1
Global Const SWP_NOSIZE = &H1
Global Const SWP_DRAWFRAME = &H20

' use in checking if application is already started

Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type POINTAPI
X As Long
y As Long
End Type
Public Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Public Const SW_SHOWNORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWNOACTIVATE = 4

'system variables
Global Const SYSTEM_COMPANY = "STI Education Training and Development"
Global Const SYSTEM_CODE = "01"
Global Const SYSTEM_NAME = "STI Training Enrollment System v1.00b"
Global Const GROUP_ADMIN = "00"
Global Const PASS_GRADE = 75
Global Const BASE_YEAR = 2003
Global g_strCurrentDate As String
Global g_strLoginDate As String
Global g_strUserID As String
Global g_strUserGroup As String
Global g_strUserRole As String
Global g_strUserFullName As String

'system expiration setup

Global Const EXP_PERIOD = 30
Global Const EXP_UNTIL = 15
Global Const MAX_TRY = 3

'field standard length

Global Const SYSTEMCODE_LEN = 2
Global Const GROUPCODE_LEN = 2
Global Const USERID_LEN = 15
Global Const PASSWORD_LEN = 40
Global Const GENERICCODE_LEN = 6
Global Const COMPUTER_LEN = 30
Global Const DATETIME_LEN = 20
Global Const DATE_LEN = 10

'Templates
Global Const TEMPLATE_SKILL = "1"
Global Const TEMPLATE_ITEM = "2"
Global Const TEMPLATE_RATING = "3"
Global Const TEMPLATE_ALL = "4"

'system logical variables

Global Const YES = 1
Global Const NO = 0
Global Const strYES = "YES"
Global Const strNO = "NO"
Global Const strINC = "INC"
'system male/female variables
Global Const MALE = 1
Global Const FEMALE = 0
Global Const strMALE = "MALE"
Global Const strFEMALE = "FEMALE"

'panels
Global Const P_USERID = 1
Global Const P_MESSAGE = 2
Global Const P_SYSTEMDATE = 3

'maintenance buttons
Global Const BTN_ADD = 0
Global Const BTN_EDIT = 1
Global Const BTN_DELETE = 2
Global Const BTN_PRINT = 3
Global Const BTN_FIND = 4

'global messages
Global Const MSG_ADD = "Add new record..."
Global Const MSG_EDIT = "Edit current record..."
Global Const MSG_DELETE = "Delete current record..."
Global Const MSG_FIND = "Search record..."
Global Const MSG_RATING = "5-Excellent / 4-Very Good / 3-Good / 2-Fair / 1-Poor"
Global Const MSG_NORECORD = "No records found!"
Global Const MSG_CANTDELETE = "Could not deleted this record because it is already used as reference."

'Blocklisting Remarks
Global Const REM_TRAINEE = "E"
Global Const REM_TRAINER = "R"

'Generating Codes
Global Const COD_CLIENT = "0"
Global Const C0D_COURSE = "1"
Global Const C0D_GUIDELINE = "2"
Global Const C0D_TRAINER = "3"
Global Const C0D_VENUE = "4"
Global Const C0D_TRAINING = "5"
Global Const C0D_TRAINEE = "6"
Global Const C0D_ONLINE = "7"

'field standard format

Global Const LONGDATE_FORMAT = "Mmmm dd, yyyy"
Global Const DATETIME_FORMAT = "mm/dd/yyyy hh:mm:ss"
Global Const DATETIMEAMPM_FORMAT = "mm/dd/yyyy hh:mm:ss AM/PM"
Global Const DATE_FORMAT = "mm/dd/yyyy"
Global Const AMOUNT_FORMAT = "###,###,###,##0.00"
Global Const GENERICCODE_FORMAT = "000000"

CLASS MODULES CODES

MOUSE POINTER

Option Explicit

Private m_nPointer As MousePointerConstants

Public Sub ShowCursor(Optional nPointer As MousePointerConstants = vbHourglass)

Screen.MousePointer = nPointer

End Sub

Private Sub Class_Initialize()

m_nPointer = Screen.MousePointer

End Sub
Private Sub Class_Terminate()
Screen.MousePointer = m_nPointer
End Sub