studentscore.frm

简单的小程序

Sub RefreshScore(sSerial As String)
   With DataEnv.rsOneScore
      If .State <> adStateClosed Then .Close
      Dim str
       If sSerial = "" Then
         str = "select course.*, score.score from score, course where course.serial=Score.courseid"
       Else
         str = "select course.*, score.score from score, course where course.serial=Score.courseid " & _
                        " and Score.studentid = '" & sSerial & "'"
       End If
      .Open str
      
      ''根据DataEnv.rsOneScore的记录状态，来改变管理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 = "oneScore"
   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 cboDep_Click()
    Dim rsClass As New ADODB.Recordset
    Dim strSQL
    If cboDep.ItemData(cboDep.ListIndex) = 0 Then   ''在所在系中选择了全部
        strSQL = "select * from class"
    Else ''选择了某一个具体的系
        strSQL = "select * from class where dept_id=" & cboDep.ItemData(cboDep.ListIndex)
    End If
    
    rsClass.Open strSQL, DataEnv.Con
'MsgBox strSQL
    cboClass.Clear
    cboClass.AddItem "全部"
    While Not rsClass.EOF
        cboClass.AddItem rsClass("Name")
        rsClass.MoveNext
    Wend
    cboClass.ListIndex = 0
    
    rsClass.Close
    Set rsClass = Nothing
End Sub

Private Sub cmdAdd_Click()
   On Error GoTo errHandler
   
   With frmAddCourse
      Load frmAddCourse
      .Caption = "添加成绩信息"
      .Show vbModal
      
      ''如果用户没有点击确认按钮，则退出处理过程
      If Not .mbAdded Then
         Unload frmAddCourse
         Exit Sub
      End If
      
      ''添加成绩记录
      Dim str
      str = "insert into score(StudentID, CourseID, Score) values('"
      str = str & grdScan.Columns(0).CellText(grdScan.Bookmark) & "','" & .dcbSerial.Text & "','" & .txtScore.Text
      str = str & "')"
      DataEnv.Con.Execute str
      
      Unload frmAddCourse
   End With
   
   Unload frmAddCourse
   ''刷新整个网格控件
   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
      sSerial = grdScore.Columns(0).CellText(grdScore.Bookmark)
      Dim stuSerial
      stuSerial = grdScan.Columns(0).CellText(grdScan.Bookmark)
      Dim str
      str = "delete from score where studentid = '" & stuSerial & "' and courseid='" & sSerial & "'"
      ''使用con来删除所选的记录
      DataEnv.Con.Execute str
      DataEnv.rsOneScore.Requery
      ''刷新grdScore控件
      grdScore.DataMember = "OneScore"
      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 frmAddCourse
      Load frmAddCourse
      .Caption = "修改成绩信息"
      ''将当前所定位的课程信息写入到frmAddCourse的dcbSerial和dcbName控件中
      .dcbSerial.Text = grdScore.Columns(0).CellText(grdScore.Bookmark)
      .dcbName.Text = .dcbSerial.BoundText
      ''将当前所定位的课程的成绩写入到frsScore.txtScore中
      .txtScore.Text = grdScore.Columns(grdScore.Columns.Count - 1).CellText(grdScore.Bookmark)
      .cmdOK.Enabled = True
      .Show vbModal
      
      ''如果用户没有点击确认按钮，则退出处理过程
      If Not .mbAdded Then
         Unload frmAddCourse
         Exit Sub
      End If
      
      ''添加成绩记录
      Dim str
      str = "update score set score=" & .txtScore.Text
      str = str & " where studentid='" & grdScan.Columns(0).CellText(grdScan.Bookmark) & "'"
      str = str & " and courseID='" & .dcbSerial.Text & "'"
      DataEnv.Con.Execute str
      
      Unload frmAddCourse
   End With
   
   Unload frmAddCourse
   ''刷新整个网格控件
   Call RefreshScore(grdScan.Columns(0).CellText(grdScan.Bookmark))
   
   Exit Sub
  
errHandler:
   MsgBox Err.Description, vbCritical, "错误"
End Sub

Private Sub cmdFirst_Click()
    DataEnv.rssqlStudent.MoveFirst

    Call ChangeBrowseState
End Sub

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

Private Sub cmdList_Click()
   '   On Error Resume Next
   ''针对所选的班级，列出班级中所有的学籍信息
   Dim strSQL
   If cboClass.Text = "全部" Then
      strSQL = " from student order by serial"
   Else
      strSQL = " from student where class='" & cboClass & "' order by serial"
   End If

   DataEnv.rssqlStudent.Close
   DataEnv.rssqlStudent.Open "select * " & strSQL
   
   ''刷新网格控件
   Call RefreshGrid
   Call ChangeBrowseState
   
   Call grdScan_Change
End Sub

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

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

Private Sub cmdReport_Click()
  On Error Resume Next
  Dim rpt As New rptStudentScore
  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.rsStudent.Fields.Count - 1
        .lstFields.AddItem (DataEnv.rsStudent(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 student where " & sTemp & " order by serial"
      
      Unload frmFind
   End With
    
   ''查找数据，并刷新用以导航的网格控件
    DataEnv.rssqlStudent.Close
    DataEnv.rssqlStudent.Open sTemp
    Call RefreshGrid
            
    Exit Sub
    
errHandler:
    MsgBox "没有符合条件的纪录！", vbExclamation, "确认"
End Sub

Private Sub Form_Load()
'   On Error Resume Next
   
   Dim rsDep As New ADODB.Recordset, rsClass As New ADODB.Recordset
   Set rsDep = DataEnv.rsDepartment
   Set rsClass = DataEnv.rsClass
   
   ''从Department表中读取数据，填充cboDep复合框到中
   If rsDep.State = adStateOpen Then rsDep.Close
   rsDep.Open
   cboDep.Clear
   cboDep.AddItem "全部"
   ''将各个系的id号作为ItemData附加到复合框中
   cboDep.ItemData(0) = 0
   While Not rsDep.EOF
       cboDep.AddItem rsDep("Name")
       cboDep.ItemData(cboDep.ListCount - 1) = rsDep("id")
       rsDep.MoveNext
   Wend
   cboDep.ListIndex = 0
   
   '''从class中读取数据，填充到cboClass复合框中
   If rsClass.State = adStateClosed Then rsClass.Open
   cboClass.Clear
   cboClass.AddItem "全部"
   While Not rsClass.EOF
       cboClass.AddItem rsClass("Name")
       rsClass.MoveNext
   Wend
   cboClass.ListIndex = 0
   
   cmdList.Value = True
      
   If gnUserType = 0 Then       ''教师身份登录
      fraManage.Enabled = True
      fraBrowse.Enabled = True
      fraSeek.Enabled = True
      grdScan.Enabled = True
   Else                         ''学生身份登录
      fraManage.Enabled = False
      fraBrowse.Enabled = False
      fraSeek.Enabled = False
      If DataEnv.rssqlStudent.State = adStateOpen Then DataEnv.rssqlStudent.Close
      DataEnv.rssqlStudent.Open "select * from student where serial ='" & gsUserName & "'"
      grdScan.DataMember = "sqlStudent"
      grdScan.Refresh
   End If

   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