frmstudent.frm

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

  '查询某一学生基本信息
  strSql = "SELECT * FROM students WHERE StuId='" & StuID & "'"
  Rs.Open strSql, Conn, adOpenStatic, adLockReadOnly
  If Not Rs.EOF Then          '存在该学生，显示其基本信息
    Lbl_StuNo.Caption = IIf(IsNull(Rs!StuNo), "", Rs!StuNo)
    Lbl_StuName.Caption = IIf(IsNull(Rs!StuName), "", Rs!StuName)
    Lbl_Sex.Caption = IIf(IsNull(Rs!Sex), "", Rs!Sex)
    Lbl_Birth.Caption = IIf(IsNull(Rs!Birth), "", Rs!Birth)
    Lbl_Political_Party.Caption = IIf(IsNull(Rs!Political_Party), "", Rs!Political_Party)
    Lbl_Family_Place.Caption = IIf(IsNull(Rs!Family_Place), "", Rs!Family_Place)
    Lbl_Nationality.Caption = IIf(IsNull(Rs!Nationality), "", Rs!Nationality)
    Lbl_Id_Card.Caption = IIf(IsNull(Rs!Id_Card), "", Rs!Id_Card)
    Lbl_DormRoom.Caption = IIf(IsNull(Rs!DormRoom), "", Rs!DormRoom)
    Lbl_DormPhone.Caption = IIf(IsNull(Rs!DormRoom_phone), "", Rs!DormRoom_phone)
    Lbl_Mobile.Caption = IIf(IsNull(Rs!Mobile), "", Rs!Mobile)
    Lbl_Address.Caption = IIf(IsNull(Rs!Address), "", Rs!Address)
    Lbl_PostCard.Caption = IIf(IsNull(Rs!PostCard), "", Rs!PostCard)
    Lbl_Family_Phone.Caption = IIf(IsNull(Rs!Family_Phone), "", Rs!Family_Phone)
    Lbl_Duty.Caption = IIf(IsNull(Rs!Duty), "", Rs!Duty)
    Lbl_Memo.Caption = IIf(IsNull(Rs!Memo), "", Rs!Memo)

    If Rs.Fields("Photo").ActualSize > 0 Then   '存在照片
      TempFile = "tempfile.tmp"
      Call GetImage(TempFile, Rs, "Photo")    '字段->文件
      Image1.Picture = LoadPicture(TempFile)    '文件->Image1控件
      Kill (TempFile)             '删除临时文件
    Else
      Image1.Picture = LoadPicture()        '清除Image1控件中的图像
    End If
    Rs.Close
    Set Rs = Nothing
  Else
    Call ClearStuDetail         '调用过程，清空学生基本信息显示
  End If
End Sub

'根据学生内码显示其家庭成员信息，如果参数StuID ="0"，则表示清除
Private Sub RefreshFamilyData(StuID As String)
  Dim strSql As String

  '如果rsFamily对象已打开，则先关闭
  If rsFamily.State = adStateOpen Then rsFamily.Close
  '查询该学生家庭成员信息
  strSql = "SELECT * FROM Family where StuId='" & StuID & "'"
  rsFamily.Open strSql, Conn, adOpenStatic, adLockOptimistic
  '使用DataGrid显示学生家庭成员信息
  Set DataGrid1.DataSource = rsFamily
End Sub

Private Sub Form_Load()
  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

  '调用通用函数将所有班级或院系添加到TreeView1中
  Call Add_ClassToTree(TreeView1, "a0")
  '调用TreeView1控件的点击事件，主要功能是清除学生基本信息、家庭信息的显示
  Call TreeView1_Click

  Left = 0
  Top = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
  If rsFamily.State = adStateOpen Then rsFamily.Close
  Set rsFamily = Nothing
  
  Set FrmStudent = 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

  '清空ListView各项
  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
    '生成ListView1中当前节点的关键字
    Tmp_Key = "b" & Rs!StuID
    '将学生项（关键字，学号）加入ListView1中
    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              '调用控件ListView1的点击事件
  Else                '不存在学生
    Call ClearStuDetail               '调用过程，清空学生基本信息显示
    RefreshFamilyData ("0")           '调用过程，清除学生家庭成员信息显示
  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 ShowStuDetail(sStuID)        '调用过程，显示该学生的基本信息
    RefreshFamilyData (sStuID)      '调用过程，显示该学生家庭成员信息
  End If
End Sub

Private Sub cmdAdd_Click()
  '未选择班级（可能当前选择是学校或院系），要求重新选择
  If TreeView1.SelectedItem.Key = "a0" Or TreeView1.SelectedItem.Children > 0 Then
    MsgBox "请选择所属班级", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If

  ModifyFlag = 0                '以添加记录方式，打开学生信息编辑窗体
  FrmStudentUpdate.Show 1
End Sub

Private Sub cmdEdit_Click()
  If ListView1.ListItems.Count = 0 Then
    MsgBox "没有可修改的记录", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If
  If ListView1.SelectedItem.Selected = False Then
    MsgBox "请选择要修改的学生", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If
  
  ModifyFlag = 1          '以修改记录方式，打开学生信息编辑窗体
  FrmStudentUpdate.Show 1
End Sub

Private Sub cmdDel_Click()
  On Error GoTo ErrorHandle
  Dim sStuID As String
  Dim blnState As Boolean   '标志变量：True-事务未全部完成，False-全部完成

  If ListView1.ListItems.Count = 0 Then
    MsgBox "没有可删除的记录", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If
  If ListView1.SelectedItem.Selected = False Then
    MsgBox "请选择要删除的学生", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If
  
  '再次确认删除
  If MsgBox("确实要删除学生 " & ListView1.SelectedItem.SubItems(1) & " 的信息吗？", _
              vbQuestion + vbYesNo, "操作提示") = vbNo Then
    Exit Sub
  End If
  '开始正式删除（需要删除与该学生相关的所有其它表中的信息）
  '获取该学生内码
  sStuID = Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1)
  Conn.BeginTrans   '开始事务
  blnState = True     '设置标志状态
  '删除该学生家庭成员信息
  Conn.Execute "Delete FROM Family WHERE StuId='" & sStuID & "'"
  '删除该学生奖励信息
  Conn.Execute "Delete FROM Prize WHERE StuId='" & sStuID & "'"
  '删除该学生惩罚信息
  Conn.Execute "Delete FROM Punish WHERE StuId='" & sStuID & "'"
  '删除该学生考级信息
  Conn.Execute "Delete FROM Grade WHERE StuId='" & sStuID & "'"
  '删除该学生测评信息
  Conn.Execute "Delete FROM Score WHERE StuId='" & sStuID & "'"
  '删除该学生信息
  Conn.Execute "Delete FROM students WHERE StuId='" & sStuID & "'"
  Conn.CommitTrans    '提交事务
  blnState = False      '取消标志状态
  
  '把该学生信息从控件ListView1中移除
  ListView1.ListItems.Remove ListView1.SelectedItem.Index
  '如果该班级还存在学生，显示下一个学生的基本信息
  If ListView1.ListItems.Count > 0 Then
    ListView1.SelectedItem.Selected = True
    Call ListView1_Click
  Else
    Call ClearStuDetail
    RefreshFamilyData ("0")
  End If

  On Error GoTo 0
  Exit Sub

ErrorHandle:
  If blnState = True Then Conn.RollbackTrans    '在事务中发生错误，回滚事务
  MsgBox Error(Err.Number), vbExclamation + vbOKOnly, "操作提示"
End Sub

''添加学生家庭成员记录
Private Sub cmdFamAdd_Click()
  If ListView1.ListItems.Count = 0 Then
    MsgBox "没有学生信息", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If
  If ListView1.SelectedItem.Selected = False Then
    MsgBox "请先选择学生", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If

  ModifyFlag = 0                ''以添加记录方式，打开学生家庭成员编辑窗体
  FrmFamilyUpdate.Show 1
End Sub

'修改学生家庭成员记录
Private Sub cmdFamEdit_Click()
  If rsFamily.RecordCount = 0 Then
    MsgBox "没有可修改的记录", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If
  
  ModifyFlag = 1                '以修改记录方式，打开学生家庭成员编辑窗体
  FrmFamilyUpdate.Show 1
End Sub

'删除学生家庭成员记录
Private Sub cmdFamDel_Click()
  If rsFamily.RecordCount = 0 Then
    MsgBox "没有可删除的记录", vbExclamation + vbOKOnly, "操作提示"
    Exit Sub
  End If
  '再次确认删除
  If MsgBox("确实要删除当前记录吗?", vbQuestion + vbYesNo, "操作提示") = vbNo Then
    Exit Sub
  End If
  '开始正式删除
  rsFamily.Delete
  If rsFamily.RecordCount > 0 Then
    rsFamily.MoveNext
    If rsFamily.EOF Then
      rsFamily.MoveLast
    End If
  End If
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, _
                                X As Single, Y As Single)
  '没有学生，照片框Image1上点击无意义，退出本过程
  If ListView1.ListItems.Count = 0 Then
    Exit Sub
  End If
  '没有选择学生，照片框Image1上点击无意义，退出本过程
  If ListView1.SelectedItem.Selected = False Then
    Exit Sub
  End If
  '如果单击右键，弹出照片管理快捷菜单（实际是显示图片框pic_Menu）
  If Button = 2 Then
    Pic_Menu.Left = Image1.Left + X
    Pic_Menu.Top = Image1.Top + Y
    Pic_Menu.Visible = True
  Else      '否则，隐藏照片管理快捷菜单
    Pic_Menu.Visible = False
  End If
End Sub

Private Sub Lbl_SetPhoto_Click()
  On Error GoTo ErrorHandle
  Dim sStuID As String
  Dim strSql As String
  Dim Rs As New ADODB.Recordset

  Pic_Menu.Visible = False
  '使用CommonDialog控件读取图像文件
  CommonDialog1.FileName = ""
  CommonDialog1.Filter = "BMP文件(*.bmp)|*.bmp|JPEG文件(*.jpg)|*.jpg|" & _
                         "GIF文件(*.gif)|*.gif"
  CommonDialog1.ShowOpen
  '未获得正确文件名，退出本过程
  If CommonDialog1.FileName = "" Then
    Exit Sub
  End If

  '存储并显示照片
  '获取学生内码
  sStuID = Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1)
  '获得该学生信息记录集
  strSql = "SELECT StuId,Photo FROM students WHERE StuId='" & sStuID & "'"
  Rs.Open strSql, Conn, adOpenStatic, adLockOptimistic
  If Not Rs.EOF Then
    '调用SaveImage()过程存储，图像从文件->记录集image字段
    Call SaveImage(CommonDialog1.FileName, Rs, "Photo")
    '显示照片，图像从文件->图像框
    Image1.Picture = LoadPicture(CommonDialog1.FileName)
  End If
  Rs.Close
  Set Rs = Nothing

  On Error GoTo 0
  Exit Sub

ErrorHandle:
  MsgBox Error(Err.Number), vbExclamation + vbOKOnly, "操作提示"
End Sub

Private Sub Lbl_DelPhoto_Click()
  On Error GoTo ErrorHandle
  Dim sStuID As String
  Dim strSql As String
  Dim Rs As New ADODB.Recordset

  Pic_Menu.Visible = False
  '获取学生内码
  sStuID = Right(ListView1.SelectedItem.Key, Len(ListView1.SelectedItem.Key) - 1)
  '获得该学生信息记录集
  strSql = "SELECT StuId,Photo FROM students WHERE StuId='" & sStuID & "'"
  Rs.Open strSql, Conn, adOpenStatic, adLockOptimistic
  If Not Rs.EOF Then
    Rs!Photo = Null         '清空照片字段
    Rs.Update           '更新记录集
    Image1.Picture = LoadPicture("")    '清除照片框
  End If
  Rs.Close
  Set Rs = Nothing

  On Error GoTo 0
  Exit Sub

ErrorHandle:
  MsgBox Error(Err.Number), vbExclamation + vbOKOnly, "操作提示"
End Sub

Private Sub Lbl_SetPhoto_MouseMove(Button As Integer, Shift As Integer, _
                                      X As Single, Y As Single)
  Lbl_SetPhoto.Font.Bold = True
  Lbl_DelPhoto.Font.Bold = False
End Sub

Private Sub Lbl_DelPhoto_MouseMove(Button As Integer, Shift As Integer, _
                                      X As Single, Y As Single)
  Lbl_SetPhoto.Font.Bold = False
  Lbl_DelPhoto.Font.Bold = True
End Sub