mainform.frm

评语管理系统源代码

Private Sub Command10_Click()
If selstu = True Then
Command1.Enabled = True
Command2.Enabled = True
Command7.Enabled = True
Command8.Enabled = True
Command14.Enabled = True
Combo1.Enabled = True
SSTab1.TabEnabled(1) = True
Command10.Enabled = False
List1.Enabled = False
SSTab1.Tab = 1
Else
   MsgBox "请选择学生！", vbOKOnly + vbExclamation, ""
End If
End Sub

Private Sub Command11_Click()
Dim answer As String
Dim delxm As String
Dim table As New table
Dim ind As Integer
If TreeView1.SelectedItem.Children > 0 Then
delxm = TreeView1.SelectedItem.Text
answer = MsgBox("确定要删除这一项吗？", vbYesNo, "")
If answer = vbYes Then
   cat.Tables.Delete (delxm)
   ind = TreeView1.SelectedItem.Index
   TreeView1.Nodes.Remove (ind)
Else
   Exit Sub
End If
Else
   MsgBox "请选择要删除的项目！而不是项目分类！", vbOKOnly, ""
   Exit Sub
End If
Exit Sub
End Sub

Private Sub Command12_Click()
Dim flname As String
Dim tbl As table
Dim sql As String
Dim rs As New ADODB.Recordset
Dim xmname As String
Dim ind As Integer
Dim nod As Node
Set nod = TreeView1.SelectedItem
If InStr(TreeView1.SelectedItem.FullPath, "\") = 0 Then
   flname = InputBox("输入项目分类名称", "增加项目分类")
   If flname = "" Then
      MsgBox "分类名称不能为空！", vbOKOnly, ""
      Exit Sub
   Else
      xmname = TreeView1.SelectedItem.Text
      ind = TreeView1.SelectedItem.Index
      cat.Tables(xmname).Columns.Append flname, adVarWChar, 255
      Set mnode = TreeView1.Nodes.Add(ind, tvwChild)
      mnode.Text = flname
   End If
Else
   MsgBox "只能在项目中添加分类，请单击要添加分类的项目名称！", vbOKOnly, ""
End If
End Sub

Private Sub Command13_Click()
Dim flname As String
Dim answer As String
Dim xmname As String
Dim ind As Integer
If InStr(TreeView1.SelectedItem.FullPath, "\") = 0 Then
   MsgBox "请选择要删除的项目分类！而不是项目名称！", vbOKOnly, ""
   Exit Sub
Else
   xmname = TreeView1.SelectedItem.Parent.Text
   ind = TreeView1.SelectedItem.Index
   flname = TreeView1.SelectedItem.Text
   answer = MsgBox("确定要删除这一项吗？", vbYesNo, "删除项目分类")
   If answer = vbYes Then
      cat.Tables(xmname).Columns.Delete flname
      TreeView1.Nodes.Remove ind
   End If
End If
Exit Sub
End Sub

Private Sub Command14_Click()
Text1(1).Text = ""
End Sub

Private Sub Command15_Click()
List1.Clear
Dim refreshstu As New ADODB.Recordset
Dim sql As String
refreshstu.CursorLocation = adUseClient
sql = "select * from 学生管理 order by 学号"   '打开学生管理数据表，在列表框中显示所有的学生
refreshstu.Open sql, conn, adOpenKeyset, adLockPessimistic
While refreshstu.EOF = False
    List1.AddItem refreshstu.Fields(1) & "         " & refreshstu.Fields(0)
    refreshstu.MoveNext
Wend
refreshstu.Close
End Sub

Private Sub Command2_Click()
xing = InputBox("输入老师姓或姓名：")
Text1(1).Text = Text1(1).Text & vbCrLf & Space(12) & xing & "老师"
End Sub

Private Sub Command3_Click()
Dim i As Integer
i = List2.ListIndex
If Text1(1).Text = "" Then
Text1(1).Text = Space(2) & Text1(1).Text & List2.Text
Else
  Text1(1).Text = Text1(1).Text & List2.Text
End If
End Sub

Private Sub Command4_Click()
Dim rs As New ADODB.Recordset
Dim sql As String
Dim str As String                  '记录用户输入
Dim prompt As String               '函数参数
prompt = "在“" + str1 + "”中的“" + str2 + "”类别中添加新的评语："
str = InputBox(prompt, "添加新评语")
List2.AddItem (str)
sql = "select " & str2 & " from " & str1
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
rs.AddNew
rs.Fields(str2) = str
rs.Update
rs.Close
End Sub

Private Sub Command5_Click()
Dim rs As New ADODB.Recordset
Dim sql As String
Dim i As Integer
Dim str As String                  '记录用户输入
Dim prompt As String               '函数参数
prompt = "修改“" + str1 + "”中的“" + str2 + "”类别评语：" & List2.Text
str = InputBox(prompt, "修改评语")
If str = "" Then
   Exit Sub
Else
i = List2.ListIndex
List2.RemoveItem (List2.ListIndex)
List2.AddItem str
sql = "select " & str2 & " from " & str1
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
rs.Move i
rs.Fields(str2) = str
rs.Update
rs.Close
End If
End Sub

Private Sub Command6_Click()
Dim rs As New ADODB.Recordset
Dim sql As String
Dim i As Integer
Dim answer As String               '记录用户输入
Dim prompt As String               '函数参数
prompt = "确实要删除此条评语吗？"
answer = MsgBox(prompt, vbYesNo, "删除评语")
If answer = vbYes Then
   i = List2.ListIndex
   List2.RemoveItem (List2.ListIndex)
   sql = "select " & str2 & " from " & str1
   rs.Open sql, conn, adOpenKeyset, adLockPessimistic
   rs.Move i
   rs.Delete
   rs.Update
   rs.Close
End If
End Sub

Private Sub Command7_Click()
Dim rs As New ADODB.Recordset
Dim sql As String
rs.CursorLocation = adUseClient
sql = "select * from 学生操行 where 学号='" & ID_num & "'" & "order by 学期"
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
Dim cx As String
rs.AddNew
rs.Fields(0) = ID_num
rs.Fields(1) = xq + 1
rs.Fields(3) = Date
rs.Fields(4) = xing + "老师"
cx = Replace(Text1(1).Text, Date, "")
cx = Replace(cx, xing + "老师", "")
rs.Fields(2) = cx
rs.Update
rs.Close
Command1.Enabled = False
Command2.Enabled = False
Command7.Enabled = False
Command8.Enabled = False
Command14.Enabled = False
Combo1.Enabled = False
SSTab1.TabEnabled(1) = False
Command10.Enabled = True
List1.Enabled = True
End Sub

Private Sub Command8_Click()
List1.Enabled = True
Command10.Enabled = True
Command1.Enabled = False
Command2.Enabled = False
Command7.Enabled = False
Command8.Enabled = False
Command14.Enabled = False
Combo1.Enabled = False
End Sub

Private Sub Command9_Click()
Dim xmname As String
Dim rs As New ADODB.Recordset
Dim table As New table
Dim tbl As table
Dim field As String
Dim str As String
On Error GoTo adderror
xmname = InputBox("输入新评语项目名称", "添加评语项目")
If xmname = "" Then
   MsgBox "项目名称不能为空！", vbOKOnly, ""
   Exit Sub
Else
  If Right(xmname, 2) = "评语" Then
   table.Name = xmname
  Else
   table.Name = xmname + "评语"
  End If
   cat.Tables.Append table
   TreeView1.Nodes.Clear
   For Each tbl In cat.Tables
    str = tbl.Name
    If Right(str, 2) = "评语" Then
       Set mnode = TreeView1.Nodes.Add()
       mnode.Text = str
       Dim i As Integer
       Dim nodeindex As Integer
       nodeindex = mnode.Index
       For i = 0 To tbl.Columns.Count - 1
           Set mnode = TreeView1.Nodes.Add(nodeindex, tvwChild)
           mnode.Text = tbl.Columns.Item(i).Name
       Next
    End If
Next
End If
Exit Sub
adderror:
    MsgBox Err.Description, vbOKOnly + vbExclamation, ""
End Sub

Private Sub delpy_Click()
Command6_Click
End Sub

Private Sub delstudent_Click()
Dim answer As String
Dim i As Integer
Dim ID As String
Dim sql As String
Dim rsdelstu As New ADODB.Recordset
ID = Label4.Caption
i = List1.ListIndex
If selstu = True Then
   answer = MsgBox("确定要删除此学生吗？", vbYesNo, "")
   If answer = vbYes Then
      sql = "select * from 学生管理 where 学号='" & ID & "'"
      rsdelstu.CursorLocation = adUseClient
      rsdelstu.Open sql, conn, adOpenKeyset, adLockPessimistic
      rsdelstu.Delete
      rsdelstu.Update
      rsdelstu.Close
      List1.RemoveItem i
   End If
Else
   MsgBox "请选择要删除的学生！", vbOKOnly + vbExclamation, ""
End If
Exit Sub
End Sub

Private Sub delxmfl_Click()
Command13_Click
End Sub

Private Sub exitsys_Click()
Unload Me
End Sub

Private Sub findstudent_Click()
Form2.Show
End Sub

Private Sub Form_Load()
Dim connectionstring As String
Dim sql As String
On Error GoTo openerror
rs1.CursorLocation = adUseClient
sql = "select * from 学生管理 order by 学号"   '打开学生管理数据表，在列表框中显示所有的学生
rs1.Open sql, conn, adOpenKeyset, adLockPessimistic
While rs1.EOF = False
    List1.AddItem rs1.Fields(1) & "         " & rs1.Fields(0)
    rs1.MoveNext
Wend
Combo1.AddItem "优"
Combo1.AddItem "良"
Combo1.AddItem "中"
Combo1.AddItem "差"
pymanage.Enabled = False
weihupy.Enabled = False
list2state = False
setcommandstate
SSTab1.TabEnabled(1) = False
Command1.Enabled = False
Command2.Enabled = False
Command8.Enabled = False
Command7.Enabled = False
Command14.Enabled = False
Combo1.Enabled = False
selstu = False
'selxm = False
Command9.Enabled = False
Command11.Enabled = False
Command13.Enabled = False
Command12.Enabled = False
Dim str As String
Set cat.ActiveConnection = conn
TreeView1.LabelEdit = tvwManual
For Each tbl In cat.Tables
    str = tbl.Name
    If Right(str, 2) = "评语" Then
       Set mnode = TreeView1.Nodes.Add()
       mnode.Text = str
       Dim i As Integer
       Dim nodeindex As Integer
       nodeindex = mnode.Index
       For i = 0 To tbl.Columns.Count - 1
           Set mnode = TreeView1.Nodes.Add(nodeindex, tvwChild)
           mnode.Text = tbl.Columns.Item(i).Name
       Next
    End If
Next
Exit Sub
openerror:
   MsgBox Err.Description
End Sub

Private Sub List1_Click()
Dim i As Long
rs1.Requery
rs1.MoveFirst
i = CLng(List1.ListIndex)
rs1.Move i
ID_num = rs1.Fields(0)
selstu = True
displaystudent
displaypy
End Sub

Public Sub displaystudent()
Label2.Caption = rs1.Fields(1)
Label4.Caption = rs1.Fields(0)
Label6.Caption = rs1.Fields(2)
End Sub

Public Sub displaypy()
Dim rs As New ADODB.Recordset
Dim sql As String
Dim cnt As Integer
Dim i As Integer
On Error GoTo displaypyerror
rs.CursorLocation = adUseClient
sql = "select * from 学生操行 where 学号='" & ID_num & "'" & "order by 学期"
rs.Open sql, conn, adOpenKeyset, adLockPessimistic
If rs.EOF = False Then
   rs.MoveFirst
Else
   MsgBox "该生没有评语！", vbOKOnly + vbExclamation, ""
   Exit Sub
End If
Text1(0).Text = ""                  '文本框清空
While rs.EOF = False
   Text1(0).Text = Text1(0).Text & vbCrLf & "第" & rs.Fields(1) & "学期" & vbCrLf & Space(2) & _
   rs.Fields(2) & vbCrLf & Space(10) & rs.Fields(3) & Space(2) & rs.Fields(4)
   rs.MoveNext
Wend
rs.MovePrevious
xq = rs.Fields(1)
rs.Close
Exit Sub
displaypyerror:
    MsgBox Err.Description
End Sub

Private Sub List2_Click()
weihupy.Enabled = True
End Sub

Private Sub modifypyxm_Click()
Command11_Click
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo clickerror
Dim i As Integer
Dim rs As New ADODB.Recordset
Dim sql As String
i = TreeView1.SelectedItem.Index
pymanage.Enabled = True
Dim a As Integer
Command9.Enabled = True
Command11.Enabled = True
Command12.Enabled = True
Command13.Enabled = True
If TreeView1.SelectedItem.Children > 0 Then
   txttbl = TreeView1.SelectedItem.Text
   If TreeView1.SelectedItem.Expanded = True Then
       TreeView1.SelectedItem.Expanded = False
   Else
       TreeView1.SelectedItem.Expanded = True
   End If
Else
 If InStr(TreeView1.SelectedItem.FullPath, "\") <> 0 Then
   txttbl = TreeView1.SelectedItem.Parent.Text
   txtfield = TreeView1.SelectedItem.Text
   str1 = txttbl
   str2 = txtfield
   sql = "select " & txtfield & " from " & txttbl
   rs.Open sql, conn, adOpenKeyset, adLockPessimistic
   If rs.EOF = False Then
   rs.MoveFirst
   List2.Clear
   While rs.EOF = False
       If Not IsNull(rs.Fields(txtfield)) Then
         List2.AddItem rs.Fields(txtfield)
       End If
         rs.MoveNext
   Wend
   rs.Close
   Else
      MsgBox "没有任何评语！", vbOKOnly
         Command4.Enabled = True
      Exit Sub
   End If
   list2state = True
   setcommandstate
 Else
   MsgBox "没有分类！", vbOKOnly + vbExclamation, ""
   Exit Sub
 End If
End If
Exit Sub
clickerror:
    MsgBox Err.Description
End Sub

Public Sub setcommandstate()
If list2state = False Then
    Command3.Enabled = False
    Command4.Enabled = False
    Command5.Enabled = False
    Command6.Enabled = False
Else
    Command3.Enabled = True
    Command4.Enabled = True
    Command5.Enabled = True
    Command6.Enabled = True
End If
End Sub

Private Sub xgpy_Click()
Command5_Click
End Sub