frmscore.frm

适用一般于毕业设计！ VB代码源加SQL 数据库 ··

      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "学生学号"
         Height          =   180
         Left            =   300
         TabIndex        =   11
         Top             =   480
         Width           =   720
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "学生姓名"
         Height          =   180
         Left            =   3480
         TabIndex        =   10
         Top             =   480
         Width           =   720
      End
   End
   Begin MSComctlLib.TreeView TreeView1 
      Height          =   2355
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2895
      _ExtentX        =   5106
      _ExtentY        =   4154
      _Version        =   393217
      HideSelection   =   0   'False
      LabelEdit       =   1
      Style           =   7
      ImageList       =   "ImageList1"
      Appearance      =   1
   End
   Begin VB.Label Label18 
      AutoSize        =   -1  'True
      Caption         =   "学期："
      Height          =   180
      Left            =   6960
      TabIndex        =   20
      Top             =   180
      Width           =   540
   End
   Begin VB.Label Label17 
      AutoSize        =   -1  'True
      Caption         =   "～"
      Height          =   180
      Left            =   5220
      TabIndex        =   19
      Top             =   180
      Width           =   180
   End
   Begin VB.Label Label16 
      AutoSize        =   -1  'True
      Caption         =   "学年："
      Height          =   180
      Left            =   3360
      TabIndex        =   17
      Top             =   180
      Width           =   540
   End
End
Attribute VB_Name = "FrmScore"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public m_ScoreID As String      '修改时保存当前测评记录的内码

Private Sub ClearScoreDetail()
  txtStuNo.Text = ""      '学号
  txtStuName.Text = ""      '姓名
  txtDate.Text = ""       '测评日期
  txtSMoral.Text = ""     '德育分数
  txtSMoralPer.Text = ""    '德育所占比例
  txtSMind.Text = ""      '智育分数
  txtSMindPer.Text = ""     '智育所占比例
  txtSGmy.Text = ""     '体育分数
  txtSGmyPer.Text = ""      '体育所占比例
  txtSTotal.Text = ""     '合计
  txtSOrder.Text = ""     '名次
  txtMemo.Text = ""     '备注
End Sub

Public Sub ShowScoreDetail(StuID As String)
  Dim strSql As String
  Dim Rs As New ADODB.Recordset
  
  '查询某一学生在某一学年（期）的测评记录
  strSql = "select * from Score " & _
         "where SYear1='" & CboYear1.Text & "' and SYear2='" & CboYear2.Text & _
         "' and STerm='" & CboTerm.Text & "' and StuID='" & StuID & "'"
  Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
  If Not Rs.EOF Then    '如果存在学年（期）的测评记录，显示
    txtDate.Text = IIf(IsNull(Rs!SDate), "", Rs!SDate)
    txtSMoral.Text = IIf(IsNull(Rs!SMoral), "", Rs!SMoral)
    txtSMoralPer.Text = IIf(IsNull(Rs!SMoralper), "", Rs!SMoralper)
    txtSMind.Text = IIf(IsNull(Rs!SMind), "", Rs!SMind)
    txtSMindPer.Text = IIf(IsNull(Rs!SMindper), "", Rs!SMindper)
    txtSGmy.Text = IIf(IsNull(Rs!SGmy), "", Rs!SGmy)
    txtSGmyPer.Text = IIf(IsNull(Rs!SGmyper), "", Rs!SGmyper)
    txtSTotal.Text = IIf(IsNull(Rs!STotal), "", Rs!STotal)
    txtSOrder.Text = IIf(IsNull(Rs!SOrder), "", Rs!SOrder)
    txtMemo.Text = IIf(IsNull(Rs!SMemo), "", Rs!SMemo)
  Else
    Call ClearScoreDetail     '调用过程，清空显示
  End If
  Rs.Close
  Set Rs = Nothing
  
  txtStuNo.Text = ListView1.SelectedItem.Text       '显示学生学号
  txtStuName.Text = ListView1.SelectedItem.SubItems(1)    '显示学生姓名
End Sub

Private Sub Form_Load()
  Dim i As Integer
  Dim TmpNode As Node

  ''加入根结点（学校）
  Set TmpNode = TreeView1.Nodes.Add(, , "a0", "长沙环境保护职业技术学院", "imgGlobalFolder")
  TmpNode.Selected = True
  TmpNode.Expanded = True
  TreeView1.LabelEdit = tvwManual
  TreeView1.HideSelection = False

  ''设置ListView控件列（增加列标题，显示格式等）
  ListView1.ColumnHeaders.Add , , "学号", ListView1.Width / 2
  ListView1.ColumnHeaders.Add , , "姓名", ListView1.Width / 2
  ListView1.View = lvwReport              '设置外观为报表样式
  ListView1.LabelEdit = lvwManual
  ListView1.FullRowSelect = True
  ListView1.HideSelection = False

  '初始化Combo控件（学年、学期）
  CboYear1.Clear
  CboYear2.Clear
  CboTerm.Clear
  For i = 2000 To 2015
    CboYear1.AddItem CStr(i)
    CboYear2.AddItem CStr(i)
  Next i
  CboTerm.AddItem "一"
  CboTerm.AddItem "二"
  '根据系统当前日期，设置默认学年（期）
  If Month(Date) > 8 Then
    CboYear1.Text = CStr(Year(Date))
    CboYear2.Text = CStr(Year(Date) + 1)
    CboTerm.Text = "一"
  Else
    CboYear1.Text = CStr(Year(Date) - 1)
    CboYear2.Text = CStr(Year(Date))
    CboTerm.Text = "二"
  End If

  '调用通用函数将所有班级或院系添加到TreeView1中
  Call Add_ClassToTree(TreeView1, "a0")
  Call TreeView1_Click

  Left = 0
  Top = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set FrmScore = Nothing
End Sub

Private Sub TreeView1_Click()
  Dim sClassID As String
  Dim strSql As String
  Dim Rs As New ADODB.Recordset
  Dim itmX As ListItem
  Dim Tmp_Key As String

  ListView1.ListItems.Clear
  sClassID = Right(TreeView1.SelectedItem.Key, Len(TreeView1.SelectedItem.Key) - 1)
  strSql = "SELECT StuID, StuNo, StuName FROM students " & _
           "WHERE ClassId='" & sClassID & "' order by StuNo"
  Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
  '遍历该班级所有学生，将学生数据加入ListView1中
  Do Until Rs.EOF
    Tmp_Key = "b" & Rs!StuID
    Set itmX = ListView1.ListItems.Add(, Tmp_Key, Rs!StuNo)
    itmX.SubItems(1) = Rs!StuName
    
    Rs.MoveNext
  Loop
  Rs.Close
  Set Rs = Nothing
    
  If ListView1.ListItems.Count > 0 Then
    ListView1.SelectedItem.Selected = True
    Call ListView1_Click
  Else
    Call ClearScoreDetail
  End If
End Sub

Private Sub ListView1_Click()
  Dim sStuID As String

  If ListView1.ListItems.Count > 0 Then
    sStuID = Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1)
    Call ShowScoreDetail(sStuID)  '显示该生当前所选学年（期）的测评信息
  End If
End Sub

Private Sub CboYear1_Click()
  If CboYear1.ListIndex = -1 Then Exit Sub
  If CboYear2.ListIndex = -1 Then Exit Sub
  If CboTerm.ListIndex = -1 Then Exit Sub
  
  Call ListView1_Click
End Sub

Private Sub CboYear2_Click()
  Call CboYear1_Click       '调用CboYear1_Click事件过程
End Sub

Private Sub CboTerm_Click()
  Call CboYear1_Click       '调用CboYear1_Click事件过程
End Sub

Private Sub cmdOrder_Click()
  Dim sClassID As String
  Dim sStuID As String
  Dim strSql As String
  Dim Rs As New ADODB.Recordset
  Dim i As Integer
  
  If ListView1.ListItems.Count = 0 Then
    MsgBox "没有学生记录", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If
  
  '确认重新计算
  If MsgBox("确实要重新计算名次吗？", _
              vbQuestion + vbYesNo, "操作提示") = vbNo Then
    Exit Sub
  End If
  '开始计算
  '指定学年（期）查询某一班级所有学生的测评记录内码，按总分降序排列
  sClassID = Right(TreeView1.SelectedItem.Key, Len(TreeView1.SelectedItem.Key) - 1)
  strSql = "select Score.ID from Score,Students where Score.StuID=Students.StuID " & _
           "and Score.SYear1='" & CboYear1.Text & _
           "' and Score.SYear2='" & CboYear2.Text & _
           "' and Score.STerm='" & CboTerm.Text & _
           "' and Students.ClassID='" & sClassID & "'" & "order by STotal desc,StuNo"
  Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
  i = 1
  Do Until Rs.EOF
    '使用i（计数器）更新Score表中的SOrder（名次）字段
    Conn.Execute "update Score set SOrder=" & CStr(i) & " where ID='" & Rs!ID & "'"
  
    i = i + 1
    Rs.MoveNext
  Loop
  Rs.Close
  Set Rs = Nothing
  
  '刷新测评信息
  sStuID = Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1)
  Call ShowScoreDetail(sStuID)    '显示该生当前学年（期）的测评记录
  MsgBox "计算名次完成！", vbInformation + vbOKOnly, "操作提示"
End Sub

Private Sub cmdAdd_Click()
  Dim sStuID As String
  Dim strSql As String
  Dim Rs As New ADODB.Recordset
  
  If ListView1.ListItems.Count = 0 Then
    MsgBox "没有学生记录", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If
  '如果学年设置错误（标准是间隔1年），则不能添加测评信息
  If CInt(Val(CboYear2.Text)) - CInt(Val(CboYear1.Text)) <> 1 Then
    MsgBox "学年设置错误，请重新设置", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If
  
  '查询该生当前学年（期）的测评记录是否存在，如果存在，则不能重复添加
  sStuID = Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1)
  strSql = "select count(*) as s_count from Score " & _
         "where SYear1='" & CboYear1.Text & "' and SYear2='" & CboYear2.Text & _
         "' and STerm='" & CboTerm.Text & "' and StuID='" & sStuID & "'"
  Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
  If Rs!s_count > 0 Then
    MsgBox "当前学生的测评记录已经存在，不能再次添加", _
              vbExclamation + vbOKOnly, "操作提示"
    Rs.Close
    Exit Sub
  End If
  Rs.Close
  Set Rs = Nothing
  
  ModifyFlag = 0          '以添加记录方式，打开测评信息编辑窗体
  FrmScoreUpdate.Show 1
End Sub

Private Sub cmdEdit_Click()
  Dim sStuID As String
  Dim strSql As String
  Dim Rs As New ADODB.Recordset
  
  If ListView1.ListItems.Count = 0 Then
    MsgBox "没有学生记录", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If
    
  '查询所选择学生当前学年（期）的测评记录，仅返回该记录的内码
  sStuID = Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1)
  strSql = "select ID from Score " & _
         "where SYear1='" & CboYear1.Text & "' and SYear2='" & CboYear2.Text & _
         "' and STerm='" & CboTerm.Text & "' and StuID='" & sStuID & "'"
  Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
  If Rs.EOF Then    '如果未查到测评记录，则提示不能修改
    MsgBox "当前学生尚无测评记录，不能修改", _
              vbExclamation + vbOKOnly, "操作提示"
    Rs.Close
    Exit Sub
  End If

  m_ScoreID = Rs!ID   '使用全局变量m_ScoreID保存需要修改测评记录的内码
  Rs.Close
  Set Rs = Nothing
  
  ModifyFlag = 1                '以修改记录方式，打开测评信息编辑窗体
  FrmScoreUpdate.Show 1
End Sub

Private Sub cmdDel_Click()
  Dim sID As String
  Dim sStuID As String
  Dim strSql As String
  Dim Rs As New ADODB.Recordset
  
  If ListView1.ListItems.Count = 0 Then
    MsgBox "没有学生记录", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If
    
  '查询所选择学生当前学年（期）的测评记录，仅返回该记录的内码
  sStuID = Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1)
  strSql = "select ID from Score " & _
         "where SYear1='" & CboYear1.Text & "' and SYear2='" & CboYear2.Text & _
         "' and STerm='" & CboTerm.Text & "' and StuID='" & sStuID & "'"
  Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
  If Rs.EOF Then    '如果未查到测评记录，则提示不能删除
    MsgBox "当前学生尚无测评记录，不能删除", _
              vbExclamation + vbOKOnly, "操作提示"
    Rs.Close
    Exit Sub
  End If
  sID = Rs!ID     '保存需要删除测评记录的内码
  Rs.Close
  Set Rs = Nothing
  
  '确认删除
  If MsgBox("确实要删除当前的测评记录吗？", _
              vbQuestion + vbYesNo, "操作提示") = vbNo Then
    Exit Sub
  End If
  '正式删除
  '使用连接对象从Score表中删除当前测评记录
  Conn.Execute "delete from Score where ID='" & sID & "'"
  Call ClearScoreDetail     '清空显示
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub