coursescore.frm

对成绩的管理,很方便,也很实用,适合各种学校的管理

   Dim rs As New ADODB.Recordset
   Dim str
   str = "select avg(score) as avg_score, count(*) as count_score from score where courseid='" & sSerial & "'"
   rs.Open str, DataEnv.Con, adOpenStatic
   
   If Not rs.EOF Then
      txtSum.Text = FormatNumber(rs("count_score"), 0)
      txtAverage.Text = FormatNumber(rs("avg_score"), 2)
   End If
End Sub

''刷新课程编号为sSerial的成绩的网格控件grdScore
Sub RefreshScore(sSerial As String)
   With DataEnv.rssqlStudentScore
      If .State <> adStateClosed Then .Close
      Dim str
       If sSerial = "" Then
         str = "select student.serial,student.name, student.class, score.score " & _
                        " from student,score where score.studentid=student.serial"
       Else
         str = "select student.serial,student.name, student.class, score.score " & _
                       " from student,score where score.studentid=student.serial " & _
                            " and Score.courseid = '" & sSerial & "'"
       End If
      .Open str
      
      ''根据DataEnv.rssqlStudentScore的记录状态，来改变管理grdScore的各个按钮的状态
      If .BOF And .EOF Then
         cmdAdd.Enabled = True
         cmdEdit.Enabled = False
         cmdDelete.Enabled = False
         cmdReport.Enabled = False
      Else
         cmdAdd.Enabled = True
         cmdEdit.Enabled = True
         cmdDelete.Enabled = True
         cmdReport.Enabled = True
      End If
   End With
   grdScore.DataMember = "sqlStudentScore"
   grdScore.Caption = "课程编号：" & grdScan.Columns(0).CellText(grdScan.Bookmark) & _
                            "  课程名：" & grdScan.Columns(1).CellText(grdScan.Bookmark)
   grdScore.Refresh
   
   ''计算该课程的总成绩和平均成绩
   Call Calculate(grdScan.Columns(0).CellText(grdScan.Bookmark))
End Sub

Private Sub cmdAdd_Click()
   On Error GoTo errHandler
   
   With frmAddStudent
      Load frmAddStudent
      .Caption = "添加成绩信息"
      .Show vbModal
      
      ''如果用户没有点击确认按钮，则退出处理过程
      If Not .mbAdded Then
         Unload frmAddStudent
         Exit Sub
      End If
      
      ''添加成绩记录
      Dim str
      str = "insert into score(StudentID, CourseID, Score) values('"
      str = str & .dcbSerial.Text & "','" & grdScan.Columns(0).CellText(grdScan.Bookmark) & "','" & .txtScore.Text
      str = str & "')"
      DataEnv.Con.Execute str
      
      Unload frmAddStudent
   End With
   
   Unload frmAddStudent
   ''刷新整个网格控件
   Call RefreshScore(grdScan.Columns(0).CellText(grdScan.Bookmark))
   
   Exit Sub
  
errHandler:
   MsgBox Err.Description, vbCritical, "错误"
   
End Sub

Private Sub cmdClose_Click()
   Unload Me
End Sub

Private Sub cmdDelete_Click()
   On Error GoTo errHandler
   If MsgBox("确实要删除此成绩记录？", vbYesNo + vbQuestion + vbDefaultButton2, "确认") = vbYes Then
      Dim sSerial, stuSerial
      stuSerial = grdScore.Columns(0).CellText(grdScore.Bookmark)
      sSerial = grdScan.Columns(0).CellText(grdScan.Bookmark)
      Dim str
      str = "delete from score where studentid = '" & stuSerial & "' and courseid='" & sSerial & "'"
      ''使用con来删除所选的记录
      DataEnv.Con.Execute str
      DataEnv.rssqlStudentScore.Requery
      ''刷新grdScore控件
      grdScore.DataMember = "sqlStudentScore"
      grdScore.Refresh
      
      Call Calculate(grdScan.Columns(0).CellText(grdScan.Bookmark))
   End If
   Exit Sub

errHandler:
   MsgBox Err.Description, vbCritical, "错误"
End Sub

Private Sub cmdEdit_Click()
   ''修改当前所选的成绩信息
   On Error GoTo errHandler
   
   With frmAddStudent
      Load frmAddStudent
      .Caption = "修改成绩信息"
      ''将当前所定位的学号和姓名信息写入到frmAddStudent的dcbSerial和dcbName中
      .dcbSerial.Text = grdScore.Columns(0).CellText(grdScore.Bookmark)
      .dcbName.Text = .dcbSerial.BoundText
      ''将当前所定位的课程的成绩写入到frmScore.txtScore中
      .txtScore.Text = grdScore.Columns(grdScore.Columns.Count - 1).CellText(grdScore.Bookmark)
      .cmdOK.Enabled = True
      .Show vbModal
      
      ''如果用户没有点击确认按钮，则退出处理过程
      If Not .mbAdded Then
         Unload frmAddStudent
         Exit Sub
      End If
      
      ''添加成绩记录
      Dim str
      str = "update score set score=" & .txtScore.Text
      str = str & " where courseid='" & grdScan.Columns(0).CellText(grdScan.Bookmark) & "'"
      str = str & " and StudentID='" & .dcbSerial.Text & "'"
      DataEnv.Con.Execute str
      
      Unload frmAddStudent
   End With
   
   Unload frmAddStudent
   ''刷新整个网格控件
   Call RefreshScore(grdScan.Columns(0).CellText(grdScan.Bookmark))
   
   Exit Sub
  
errHandler:
   MsgBox Err.Description, vbCritical, "错误"
End Sub

Private Sub cmdFirst_Click()
    DataEnv.rssqlCourse.MoveFirst
'    DataEnv.rssqlCourse.MovePrevious
    Call ChangeBrowseState
End Sub

Private Sub cmdLast_Click()
  DataEnv.rssqlCourse.MoveLast
  Call ChangeBrowseState
End Sub

Private Sub cmdList_Click()
   ''针对所选的课程类型，列出中所有所属的课程信息
   Dim strSQL
   If cboType.ListIndex = 0 Then
      strSQL = "select course.serial, course.name, course.period, coursetype.name as typename " & _
                 " from course, coursetype where course.typeid=coursetype.id order by serial"
   Else
      strSQL = "select course.serial, course.name, course.period, coursetype.name as typename " & _
                " from course, coursetype where course.typeid=coursetype.id and course.typeid=" & _
                            cboType.ItemData(cboType.ListIndex) & " order by serial"
   End If
   
   With DataEnv.rssqlCourse
     If .State = adStateOpen Then .Close
     .Open strSQL, DataEnv.Con, adOpenStatic, adLockOptimistic
   End With
   
   ''刷新网格控件
   Call RefreshGrid
   Call ChangeBrowseState
   
   Call grdScan_Change
End Sub

Private Sub cmdNext_Click()
   DataEnv.rssqlCourse.MoveNext
   
   Call ChangeBrowseState
End Sub

Private Sub cmdPrevious_Click()
    DataEnv.rssqlCourse.MovePrevious
    Call ChangeBrowseState
End Sub

Private Sub cmdReport_Click()
  On Error Resume Next
  Dim rpt As New rptCourseScore
    Load rpt
  rpt.Caption = "课程" & grdScan.Columns(1).CellText(grdScan.Bookmark) & "的成绩列表"
  rpt.Show 1
End Sub

Private Sub cmdSeek_Click()
   With frmFind
      Dim i As Integer
      '显示查找窗口
      Load frmFind
      
      ''填充查找窗体的字段列表框
      .lstFields.Clear
      For i = 0 To DataEnv.rsCourse.Fields.Count - 1
        .lstFields.AddItem (DataEnv.rsCourse(i).Name)
      Next i
      .lstFields.ListIndex = 0
      .Show 1
      
      If .mbFindFailed Then Exit Sub
      
      Dim sTemp As String
      If LCase(.msFindOp) = "like" Then
          sTemp = .msFindField & " " & .msFindOp & " '%" & .msFindExpr & "%'"
      Else
          sTemp = .msFindField & " " & .msFindOp & " '" & .msFindExpr & "'"
      End If
      sTemp = "select * from course where " & sTemp & " order by serial"
      
      Unload frmFind
   End With
    
   ''查找数据，并刷新用以导航的网格控件
    DataEnv.rssqlCourse.Close
    DataEnv.rssqlCourse.Open sTemp
    Call RefreshGrid
            
    Exit Sub
    
errHandler:
    MsgBox "没有符合条件的纪录！", vbExclamation, "确认"
End Sub

Private Sub Form_Load()

   With DataEnv.rsCourse_type
     ''从CourseType表中读取数据，填充到cboType复合框中
     cboType.Clear
     cboType.AddItem "全部"
     cboType.ItemData(cboType.ListCount - 1) = 0
     If .State <> adStateOpen Then .Open
     .MoveFirst
     While Not .EOF
        cboType.AddItem DataEnv.rsCourse_type("Name")
        cboType.ItemData(cboType.ListCount - 1) = DataEnv.rsCourse_type("id")
        .MoveNext
     Wend
   End With
   cboType.ListIndex = 0
   
   cmdList.Value = True     ''点击“列出>>”

   fraManage.Enabled = True
   fraBrowse.Enabled = True
   fraSeek.Enabled = True
   grdScan.Enabled = True
   
   Call grdScan_Change
End Sub

Private Sub grdScan_Change()
   If grdScan.ApproxCount > 0 Then
      Call RefreshScore(grdScan.Columns(0).CellText(grdScan.Bookmark))
   End If
End Sub

Private Sub grdScan_DblClick()
    sstMain.Tab = 1
End Sub

Private Sub grdScan_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
   ''当前行改变，则动态改变所要显示的记录
   If LastRow <> grdScan.Bookmark Then
      If grdScan.ApproxCount > 0 Then
         Call RefreshScore(grdScan.Columns(0).CellText(grdScan.Bookmark))
      End If
   End If
End Sub