frmmodscore.frm

基于vb的程序管理系统

      BorderStyle     =   1
   End
End
Attribute VB_Name = "frmModscore"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
    Unload frmFindLesn
    Unload frmFindStu
    Unload frmLesnIfm
    Unload frmStuPlace
    Unload frmStuIfm
    Dim mCItem As ComboItem
    Call HeadList
    lsvStuIfm0.ListItems.Clear
    txtStuNO.Text = ""
    txtStuName.Text = ""
    txtsexfm.Text = ""
    With txtsexfm.ComboItems
        Set mCItem = .Add(, , "男")
        Set mCItem = .Add(, , "女")
    End With
End Sub
'列表头
Private Sub HeadList()
    With lsvStuIfm0.ColumnHeaders
        .Add , , "学生学号", 1200
        .Add , , "学生姓名", 1200
        .Add , , "性别", 600
        .Add , , "入学日期", 2500
        .Add , , "班级", 980
        .Add , , "院系", 980
        .Add , , "成绩", 980
        .Add , , "科目", 980
    End With
    lsvStuIfm0.View = lvwReport
End Sub

Private Sub dtpBeginTerm_LostFocus()
    If Not lsvStuIfm0.SelectedItem Is Nothing Then
        lsvStuIfm0.SelectedItem.SubItems(3) = Format((dtpBeginTerm.Value), "yyyy年mm月dd日")
    End If
End Sub

Private Sub dtpBeginTerm_Change()
    If Not lsvStuIfm0.SelectedItem Is Nothing Then
        lsvStuIfm0.SelectedItem.SubItems(3) = Format((dtpBeginTerm.Value), "yyyy年mm月dd日")
    End If
End Sub
'把tblStudent表中的相应记录显示在列表中
Private Sub DataToList()
On Error GoTo mErr
    Dim mRst As ADODB.Recordset
    Dim mLItem As ListItem
    Set mRst = New ADODB.Recordset
    lsvStuIfm0.ListItems.Clear
    mRst.Open "SELECT * FROM tblStudent ORDER BY 学生学号", mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
    Do Until mRst.EOF
        Set mLItem = lsvStuIfm0.ListItems.Add(, , mRst("学生学号"))
        With mLItem
            .SubItems(1) = mRst("学生姓名")
            .SubItems(2) = mRst("性别")
            .SubItems(3) = Format(mRst("入学日期"), "yyyy年mm月dd日")
            .SubItems(4) = mRst("班级")
            .SubItems(5) = mRst("院系")
            .SubItems(6) = mRst("成绩")
            .SubItems(7) = mRst("科目")
        
            .Tag = mRst("学生ID")
         End With
        mRst.MoveNext
    Loop
    mRst.Close
    Set mRst = Nothing
    Exit Sub
mErr:
    MsgBox Err.Number & "," & Err.Description, vbCritical + vbOKOnly, mTitle
    End
End Sub

Private Sub lsvStuIfm00_BeforeLabelEdit(Cancel As Integer)

End Sub

Private Sub txtsexfm_Change()
    If Not lsvStuIfm0.SelectedItem Is Nothing Then
        lsvStuIfm0.SelectedItem.SubItems(2) = txtsexfm.Text
    End If
End Sub

Private Sub txtsexfm_Click()
    If Not lsvStuIfm0.SelectedItem Is Nothing Then
        lsvStuIfm0.SelectedItem.SubItems(2) = txtsexfm.Text
    End If
End Sub
'当单击列表中某一项时，把相应项内容显示在各个编辑框中
Private Sub lsvStuIfm0_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Call ListToEdit
End Sub
'把相应项内容显示在各个编辑框中
Private Sub ListToEdit()
    If Not lsvStuIfm0.SelectedItem Is Nothing Then
        With lsvStuIfm0.SelectedItem
            If .SubItems(3) <> "" Then
                dtpBeginTerm.Value = .SubItems(3)
            End If
            txtStuNO.Text = .Text
            txtStuName.Text = .SubItems(1)
            txtsexfm.Text = .SubItems(2)
            
        End With
    Else
        txtStuNO.Text = ""
        txtStuName.Text = ""
        txtsexfm.Text = ""
    End If
End Sub

Private Sub tbrStuIfm_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "新建"
            Call NewData
            Call ListToEdit
        Case "保存"
            If Not lsvStuIfm0.SelectedItem Is Nothing Then
                Call SaveData
            End If
        Case "删除"
            If Not lsvStuIfm0.SelectedItem Is Nothing Then
                Call DelData
                Call ListToEdit
            End If
        Case "刷新"
            Call Refurbish
        Case "全部显示"
            Call DataToList
            Call ListToEdit
        Case "查找"
            'SeltFrom = 1
            frmFindStu.Show '1
            Call ListToEdit
        Case "清空"
            lsvStuIfm0.ListItems.Clear
            Call ListToEdit
        Case "退出"
            Unload Me
    End Select
End Sub

Private Sub txtStuName_Change()
    If Not lsvStuIfm0.SelectedItem Is Nothing Then lsvStuIfm0.SelectedItem.SubItems(1) = txtStuName.Text
End Sub

Private Sub txtStuNO_Change()
    If Not lsvStuIfm0.SelectedItem Is Nothing Then lsvStuIfm0.SelectedItem.Text = txtStuNO.Text
End Sub
'单击新建时发生，在列表中加一项，如果新增的一条记录中学生学号或者学生姓名有一个为空时再新建焦点只会落在原来那
'一条上
Private Sub NewData()
    Dim mLItem As ListItem
    Dim i As Long
    With lsvStuIfm0.ListItems
        i = .Count
        If i = 0 Then
            Set mLItem = .Add(, , "")
            mLItem.Selected = True
        Else
            If Trim(.Item(i).Text) = "" Or Trim(.Item(i).SubItems(1)) = "" Then
                .Item(i).Selected = True
                .Item(i).EnsureVisible
            Else
                Set mLItem = .Add(, , "")
                mLItem.Selected = True
                mLItem.EnsureVisible
            End If
        End If
    End With
    txtStuNO.SetFocus
End Sub
'保存数据，如果记录项中的学生学号或者学生姓名为空时不被保存，数据库中tblStudent表的设置：学生学号字段类型是数字，
'是必填字段且不允许重复，学生姓名字段为必填，且不允许空串，所以当输入相同学生学号或不填写学生姓名时，该记录都
'不被保存
Private Sub SaveData()
On Error GoTo mErr
    Dim mRst As ADODB.Recordset
    Dim mLItem As ListItem
    Dim i As Long
    Set mRst = New ADODB.Recordset
    For i = 1 To lsvStuIfm0.ListItems.Count
        Set mLItem = lsvStuIfm0.ListItems(i)
        With mLItem
            If Trim(.Text) <> "" And Trim(.SubItems(1)) <> "" Then
                If .Tag = "" Then .Tag = "0"
                mRst.Open "SELECT * FROM tblStudent WHERE 学生ID=" & CLng(mLItem.Tag), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
                If mRst.RecordCount = 0 Then
                    mRst.AddNew
                    If .SubItems(3) = "" Then .SubItems(3) = Format(dtpBeginTerm.Value, "yyyy年mm月dd日")
                End If
                mRst("学生学号") = .Text
                mRst("学生姓名") = Trim(.SubItems(1))
                mRst("性别") = .SubItems(2)
                mRst("入学日期") = .SubItems(3)
                mRst.Update
                .Tag = mRst("学生ID")
                mRst.Close
            End If
        End With
    Next i
    Set mRst = Nothing
    Exit Sub
mErr:
    MsgBox Err.Number & "," & Err.Description, vbCritical + vbOKOnly, mTitle
    End
End Sub
'删除tblStudent中的对应项，以及删除tblScore中所有有关该学生成绩的记录
Private Sub DelData()
On Error Resume Next
    Dim mRst As New ADODB.Recordset
    Dim mLItem As ListItem
    Dim Answer As Integer
    Dim x As Long
    Set mLItem = lsvStuIfm0.SelectedItem
    Answer = MsgBox("确定要删除吗？", vbYesNo + vbExclamation + vbDefaultButton2, "警告")
    If Answer <> 6 Then Exit Sub
    With mLItem
        If .Tag = "" Then .Tag = "0"
        mRst.Open "SELECT * FROM tblStudent WHERE 学生ID=" & CLng(.Tag), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
        If mRst.RecordCount <> 0 Then
            x = lsvStuIfm0.SelectedItem.Index
            mRst.Delete
            mRst.Close
            mRst.Open "SELECT * FROM tblScore WHERE 学生ID=" & CLng(.Tag), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
            Do Until mRst.EOF
                mRst.Delete
                mRst.MoveNext
            Loop
        End If
    End With
    mRst.Close
    x = lsvStuIfm0.SelectedItem.Index
    Set mRst = Nothing
    With lsvStuIfm0.ListItems
        .Remove (x)
        If .Count > 1 Then
            If x = 1 Then
                .Item(1).Selected = True
            Else
                .Item(x - 1).Selected = True
                lsvStuIfm0.SelectedItem.EnsureVisible
            End If
        Else
            If .Count = 1 Then
                .Item(1).Selected = True
                lsvStuIfm0.SelectedItem.EnsureVisible
            End If
        End If
    End With
End Sub
'刷新列表中的各项，去除列表中不存在于tblStudent表的项
Private Sub Refurbish()
On Error GoTo mErr
    Dim mRst As New ADODB.Recordset
    Dim mLItem As ListItem
    Dim i As Long
    i = 1
    Do Until i > lsvStuIfm0.ListItems.Count
        Set mLItem = lsvStuIfm0.ListItems(i)
        With mLItem
            If .Tag = "" Then .Tag = "0"
            mRst.Open "SELECT * FROM tblStudent WHERE 学生ID=" & CLng(.Tag), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
            If mRst.RecordCount = 0 Then
                lsvStuIfm0.ListItems.Remove (i)
            Else
                 .Text = mRst("学生学号")
                .SubItems(1) = mRst("学生姓名")
                .SubItems(2) = mRst("性别")
                .SubItems(3) = Format(mRst("入学日期"), "yyyy年mm月dd日")
                .Tag = mRst("学生ID")
                i = i + 1
            End If
        End With
        mRst.Close
    Loop
    Call ListToEdit
    Exit Sub
mErr:
    MsgBox Err.Number & "," & Err.Description, vbCritical + vbOKOnly, mTitle
    End
End Sub

Private Sub Form_Resize()
    If frmStuIfm.WindowState <> 1 Then
        lsvStuIfm0.Move lsvStuIfm0.Left, lsvStuIfm0.Top, Me.ScaleWidth - lsvStuIfm0.Left - 100, Me.ScaleHeight - lsvStuIfm0.Top - 100
    End If
End Sub
'Private Sub txtStuName_KeyDown(KeyCode As Integer, Shift As Integer)
'    If KeyCode = 13 Then SendKeys "{Tab}"
'End Sub

'Private Sub txtsexfm_KeyDown(KeyCode As Integer, Shift As Integer)
'    If KeyCode = 13 Then SendKeys "{Tab}"
'End Sub

'Private Sub txtStuNO_KeyDown(KeyCode As Integer, Shift As Integer)
'    If KeyCode = 13 Then SendKeys "{Tab}"
'End Sub