form1.frm

学生成绩分析系统

Attribute VB_Exposed = False
Option Explicit
Dim DBConn       '定义数据连接
Dim nodX As Node '目录树用


Private Sub ComboKEMU_Click()
Dim I
If ComboKEMU.Text = "显示全部课程" Then
    For I = 2 To TDBGrid1.Columns.Count - 1
     TDBGrid1.Columns(I).Visible = True
    Next I
 Else
   '==========================
    For I = 5 To TDBGrid1.Columns.Count - 1
       If Trim(TDBGrid1.Columns(I).Caption) = Trim(ComboKEMU.Text) Then
        TDBGrid1.Columns(I).Visible = True
        Else
        TDBGrid1.Columns(I).Visible = False
       End If
    Next I
End If
End Sub


Private Sub CommandAdd_Click()
On Error Resume Next
If T1.Text <> "" And T2.Text <> "" And T3.Text <> "" And T4.Text <> "" Then
'检测必添项目
      If Len(Trim(T1.Text)) = 4 And Len(Trim(T2.Text)) = 3 And Len(Trim(T3.Text)) = 3 Then
      '检测数据长度
            If IsNumeric(Trim(T1.Text)) And IsNumeric(Trim(T2.Text)) And IsNumeric(Trim(T3.Text)) Then
            '===============检测数据格式
                With Adodc1.Recordset
                .AddNew
                .Fields("年级") = Trim(T1.Text)
                .Fields("班级") = Trim(T2.Text)
                .Fields("编号") = Trim(T3.Text)
                .Fields("姓名") = Trim(T4.Text)
            
                .Update
                End With

                T3.Text = ""
                T4.Text = ""
                                
                Call FillTDBGrid(Left(TreeView1.SelectedItem.Text, 4), Right(TreeView1.SelectedItem.Text, 3))
                
                T3.SetFocus
            Else
                MsgBox "年级、班级、编号字段必须为 [数字] 格式！" & Chr(13) & Chr(10) & "请确认！", , " 格式 提示"
            End If
      Else
        MsgBox "所填字段的数据长度有错误,请参考如下示例填写：" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "年级-4  如：2005 " & Chr(13) & Chr(10) & "班级-3  如：001 " & Chr(13) & Chr(10) & "编号-3  如：001" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "请重新确认！", , " 长度 提示"
      End If
 Else
 MsgBox "年级、班级、编号、姓名为必添项目！", , "必添项目 - 提示"
End If
End Sub

'*******************************************
Public Sub FillTreeView()   '添加目录树项目
TreeView1.Nodes.Clear
Dim I, J
AdoT2.ConnectionString = DBConn
With AdoT1
.ConnectionString = DBConn
.RecordSource = "SELECT DISTINCT 年级 FROM 成绩 "
.Refresh

For I = 0 To .Recordset.RecordCount - 1
     Set nodX = TreeView1.Nodes.Add(, , "P" & I, .Recordset.Fields(0).Value & " 级")
       '客户树子显示筛选加入记录集 ===============================================
        AdoT2.RecordSource = "SELECT DISTINCT 班级 FROM 成绩 WHERE 年级 LIKE '" & .Recordset.Fields(0).Value & "'"
        AdoT2.Refresh
        AdoT2.Recordset.MoveFirst
        On Error Resume Next
          For J = 0 To AdoT2.Recordset.RecordCount - 1
           Set nodX = TreeView1.Nodes.Add("P" & I, tvwChild, "C" & I & J, .Recordset.Fields(0).Value & AdoT2.Recordset.Fields(0).Value)
           AdoT2.Recordset.MoveNext
          Next J
       '============================================================================
     .Recordset.MoveNext
  Next I
End With
'定义功能项目
 Set nodX = TreeView1.Nodes.Add(, , "A", "全部显示")
 
End Sub
'*********************************************************************
'附识 为 9999 999 即可显示所有记录
Public Sub FillTDBGrid(NJ As String, BJ As String)      ' 添加表格项目
Screen.MousePointer = 13
   '定义数据
    With Adodc1
 .ConnectionString = DBConn
If NJ = "9999" And BJ = "999" Then
    .RecordSource = "SELECT * FROM 成绩 ORDER BY 年级, 班级, 编号"

ElseIf NJ = "nnnn" And BJ = "nnn" Then
    .RecordSource = "SELECT * FROM 成绩 where 年级 LIKE '" & NJ & "' AND 班级 LIKE '" & BJ & "'  ORDER BY 年级, 班级, 编号"

Else
    .RecordSource = "SELECT * FROM 成绩 where 年级 LIKE '" & NJ & "' AND 班级 LIKE '" & BJ & "'  ORDER BY 年级, 班级, 编号"

End If
    .Refresh
    TDBGrid1.DataSource = Adodc1
    End With
'=============
With TDBGrid1
.Columns(0).Visible = False

.Columns(0).Locked = True     '&H00E0E0E0&
 .Columns(1).Locked = True
  .Columns(2).Locked = True
   .Columns(3).Locked = True
    .Columns(4).Locked = True
'.Columns(1).BackColor = &H8000000F
' .Columns(2).BackColor = &H8000000F
'  .Columns(3).BackColor = &H8000000F
'   .Columns(4).BackColor = &H8000000F
 .Columns(1).Width = 500
  .Columns(2).Width = 450
   .Columns(3).Width = 450
    .Columns(4).Width = 1000
    
    'Set the colors for the even and odd rows
    TDBGrid1.EvenRowStyle.BackColor = &HEEFEFE
    TDBGrid1.OddRowStyle.BackColor = &HFEFDF2
    TDBGrid1.AlternatingRowStyle = True
    
ComboKEMU_Click
'=============
Dim I

 For I = 5 To .Columns.Count - 1
  .Columns(I).Width = 1200
 Next I

End With
Screen.MousePointer = 0
End Sub
'***********************************************************
Public Sub FillCommboKEMU()                '填充科目 COMMBO
AdodcTemp.ConnectionString = DBConn
AdodcTemp.RecordSource = "SELECT top 1 * FROM 成绩"
AdodcTemp.Refresh
'=====
ComboKEMU.Clear
  ComboKEMU.AddItem "显示全部课程"
Dim I
 For I = 5 To AdodcTemp.Recordset.Fields.Count - 1
  ComboKEMU.AddItem AdodcTemp.Recordset.Fields(I).Name
 Next I
 
 ComboKEMU.ListIndex = 0
End Sub


Private Sub Form_Activate()
Me.Caption = "SV班级成绩分析 1.0 [青岛市商业中专]"
End Sub

Private Sub Form_Load()
Screen.MousePointer = 13
'以下定义了数据库连接内容        DBConn
DBConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\db\svdb.mdb;Persist Security Info=False"
FillCommboKEMU
FillTreeView
FillTDBGrid "nnnn", "nnn"

'========
TDBGrid1.MarqueeStyle = dbgHighlightCell
StatusBar1.Panels(1).Text = "sss"

Screen.MousePointer = 0
End Sub

Private Sub Form_Resize()
If Form1.ScaleHeight > 3000 And Form1.ScaleWidth > 6000 Then
    Dim MYCenter
    MYCenter = Form1.ScaleHeight - Toolbar1.Height - StatusBar1.Height
    TreeView1.Top = Toolbar1.Height + 80
    TDBGrid1.Top = Toolbar1.Height + 80
    TreeView1.Height = MYCenter - 80
    TDBGrid1.Height = MYCenter - Frame1.Height - 180
    TDBGrid1.Width = Form1.ScaleWidth - TreeView1.Width - 100
    Frame1.Top = TDBGrid1.Height + Toolbar1.Height + 180
    Frame1.Width = TDBGrid1.Width
    ComboKEMU.Left = Form1.ScaleWidth - ComboKEMU.Width - 50
End If
End Sub

Private Sub MNU_DATA_EXIT_Click()
Unload Me
End Sub

Private Sub MNU_DATA_SAVE_Click()
  On Error Resume Next
   Adodc1.Recordset.Update
   TDBGrid1.Update
   Form_Load
End Sub

Private Sub MNU_M_KEMU_Click()
  FormKEMUGL.Show 1
End Sub

Private Sub MNU_M_STU_Click()
  FormInputS.Show 1
End Sub

Private Sub MNU_OUTPUT_CJ_Click()
On Error Resume Next
   Adodc1.Recordset.Update
   Form2.Show 1
   
End Sub

Private Sub POPMNU_DEL_Click()
If MsgBox("确定删除选定记录吗?该操作不可逆!", vbCritical + vbYesNo, "提示") = vbYes Then
TDBGrid1.Delete
End If
End Sub

Private Sub POPMNU_RF_Click()
TDBGrid1.Refresh
End Sub

Private Sub T3_GotFocus()
T3.BackColor = &HFFFFC0
End Sub

Private Sub T3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
T4.SetFocus
KeyAscii = 0
End If
End Sub

Private Sub T3_LostFocus()
T3.BackColor = &H80000005
End Sub

Private Sub T4_GotFocus()
T4.BackColor = &HFFFFC0
End Sub

Private Sub T4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
CommandAdd.SetFocus
KeyAscii = 0
End If
End Sub
Private Sub T4_LostFocus()
T4.BackColor = &H80000005
End Sub

Private Sub TDBGrid1_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then Adodc1.Recordset.Update

If InStr("0123456789./" + vbBack, Chr(KeyAscii)) = 0 Then
      KeyAscii = 0
      Exit Sub
End If
End Sub

Private Sub TDBGrid1_LostFocus()
On Error Resume Next
Adodc1.Recordset.Update
End Sub

Private Sub TDBGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 And Adodc1.Recordset.RecordCount <> 0 Then
PopupMenu POPMNU
End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
 Case "学生管理"
  On Error Resume Next
   Adodc1.Recordset.Update
  FormInputS.Show 1
  
 Case "科目管理"
  On Error Resume Next
   Adodc1.Recordset.Update
  FormKEMUGL.Show 1
  
 Case "成绩分析"
  On Error Resume Next
   Adodc1.Recordset.Update
   Form2.Show 1
 Case "更改密码"
  On Error Resume Next
    frmLogin1.Show 1
 Case "保存数据"
  On Error Resume Next
   Adodc1.Recordset.Update
   TDBGrid1.Update
   Form_Load
 Case "关闭"
  On Error Resume Next
   Adodc1.Recordset.Update
  Unload Me
End Select
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
Screen.MousePointer = 13

Select Case Left(Node.Key, 1)
    Case "C"
        T1 = Left(Node.Text, 4)
        T2 = Right(Node.Text, 3)
        T3.SetFocus
        Call FillTDBGrid(Left(Node.Text, 4), Right(Node.Text, 3))
    Case "A"
        Call FillTDBGrid(9999, 999)
    Case Else
        Call FillTDBGrid("nnnn", "nnn")
End Select

Screen.MousePointer = 0
End Sub