frmlesnifm.frm

基于vb的程序管理系统

    With lsvLesnIfm.ColumnHeaders
        .Add , , "课程号", 2100
        .Add , , "课程名称", 1800
        .Add , , "教材名称", 2000
        .Add , , "任课老师", 2100
    End With
    lsvLesnIfm.View = lvwReport
End Sub

Private Sub lsvLesnIfm_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Call ListToEdit
End Sub

Private Sub tbrLesnIfm_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "新建"
            Call NewData
            Call ListToEdit
        Case "保存"
            If Not lsvLesnIfm.SelectedItem Is Nothing Then
                If lsvLesnIfm.SelectedItem.Text <> "" And lsvLesnIfm.SelectedItem.SubItems(1) <> "" Then Call SaveData
            End If
        Case "删除"
            If Not lsvLesnIfm.SelectedItem Is Nothing Then
                Call DelData
                Call ListToEdit
            End If
        Case "刷新"
            Call Refurbish
        Case "全部显示"
            Call DataToList
            Call ListToEdit
        Case "查找"
        SeltFrom = 1
            frmFindLesn.Show 1
            Call ListToEdit
        Case "清空"
            lsvLesnIfm.ListItems.Clear
            Call ListToEdit
        Case "退出"
            Unload Me
    End Select
End Sub
'单击新建时发生，在列表中加一项，如果新增的一条记录中课程号或者课程名有一个为空时再新建焦点只会落在原来那一条上
Private Sub NewData()
    Dim mLItem As ListItem
    Dim i As Long
    With lsvLesnIfm.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
    txtLesnNum.SetFocus
End Sub
'从课程表读取数据到列表中
Private Sub DataToList()
On Error GoTo mErr
    Dim mRst As New ADODB.Recordset
    Dim mLItem As ListItem
    lsvLesnIfm.ListItems.Clear
    mRst.Open "SELECT * FROM tblLesson ORDER BY 课程号", mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
    Do Until mRst.EOF
        Set mLItem = lsvLesnIfm.ListItems.Add(, , mRst("课程号"))
        With mLItem
            .SubItems(1) = mRst("课程名称")
            .SubItems(2) = mRst("教材名称")
            .SubItems(3) = 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 ListToEdit()
    If Not lsvLesnIfm.SelectedItem Is Nothing Then
        With lsvLesnIfm.SelectedItem
            txtLesnNum.Text = .Text
            txtLesnName.Text = .SubItems(1)
            txtBookName.Text = .SubItems(2)
            txtTeacher.Text = .SubItems(3)
        End With
    Else
        txtLesnNum.Text = ""
        txtLesnName.Text = ""
        txtBookName.Text = ""
        txtTeacher.Text = ""
    End If
End Sub
'保存数据，如果记录项中的课程号或者课程名为空时，该项不被保存，数据库中tblLesson表的设置：课程号字段类型是数字，
'是必填字段且不允许重复，课程名字段为必填，且不允许空串，所以当输入相同课程号或不填写课程名该记录都不被保存
Private Sub SaveData()
On Error GoTo mErr
    Dim mRst As New ADODB.Recordset
    Dim mLItem As ListItem
    Dim i As Long
    For i = 1 To lsvLesnIfm.ListItems.Count
        Set mLItem = lsvLesnIfm.ListItems(i)
        With mLItem
            If Trim(.Text) <> "" And Trim(.SubItems(1)) <> "" Then
                If .Tag = "" Then .Tag = "0"
                mRst.Open "SELECT * FROM tblLesson WHERE 课程ID=" & CLng(.Tag), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
                If mRst.RecordCount = 0 Then
                    mRst.AddNew
                End If
                mRst("课程号") = .Text
                mRst("课程名称") = Trim(.SubItems(1))
                mRst("教材名称") = Trim(.SubItems(2))
                mRst("任课老师") = Trim(.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
'删除tblLesson中的对应项，以及删除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 = lsvLesnIfm.SelectedItem
    Answer = MsgBox("确定要删除吗？", vbYesNo + vbExclamation + vbDefaultButton2, "警告")
    If Answer <> 6 Then Exit Sub
    x = lsvLesnIfm.SelectedItem.Index
    If mLItem.Tag = "" Then mLItem.Tag = "0"
    With mRst
        .Open "SELECT * FROM tblLesson WHERE 课程ID=" & CLng(mLItem.Tag), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
        If .RecordCount <> 0 Then
            .Delete
            .Close
            .Open "SELECT * FROM tblScore WHERE 课程ID=" & CLng(mLItem.Tag), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
            Do Until mRst.EOF
                .Delete
                .MoveNext
            Loop
        End If
        .Close
    End With
    Set mRst = Nothing
    With lsvLesnIfm.ListItems
        .Remove (x)
        If .Count > 1 Then
            If x = 1 Then
                .Item(1).Selected = True
            Else
                .Item(x - 1).Selected = True
                lsvLesnIfm.SelectedItem.EnsureVisible
            End If
        Else
            If .Count = 1 Then
                .Item(1).Selected = True
                lsvLesnIfm.SelectedItem.EnsureVisible
            End If
        End If
    End With
End Sub
'刷新列表中的各项，去除列表中不存在于tblLesson表的项
Private Sub Refurbish()
On Error GoTo mErr
    Dim mLItem As ListItem
    Dim mRst As New ADODB.Recordset
    Dim i As Long
    i = 1
    Do Until i > lsvLesnIfm.ListItems.Count
        Set mLItem = lsvLesnIfm.ListItems(i)
        With mLItem
            If .Tag = "" Then .Tag = "0"
            mRst.Open "SELECT * FROM tblLesson WHERE 课程ID=" & CLng(.Tag), mCnnString, adOpenKeyset, adLockPessimistic, adCmdText
            If mRst.RecordCount = 0 Then
                lsvLesnIfm.ListItems.Remove (i)
            Else
                .Text = mRst("课程号")
                .SubItems(1) = mRst("课程名称")
                .SubItems(2) = mRst("教材名称")
                .SubItems(3) = mRst("任课老师")
                .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 txtLesnNum_Change()
    If Not lsvLesnIfm.SelectedItem Is Nothing Then lsvLesnIfm.SelectedItem.Text = txtLesnNum.Text
End Sub

Private Sub txtLesnName_Change()
    If Not lsvLesnIfm.SelectedItem Is Nothing Then lsvLesnIfm.SelectedItem.SubItems(1) = txtLesnName.Text
End Sub

Private Sub txtBookName_Change()
    If Not lsvLesnIfm.SelectedItem Is Nothing Then lsvLesnIfm.SelectedItem.SubItems(2) = txtBookName.Text
End Sub

Private Sub txtTeacher_Change()
    If Not lsvLesnIfm.SelectedItem Is Nothing Then lsvLesnIfm.SelectedItem.SubItems(3) = txtTeacher.Text
End Sub

Private Sub Form_Resize()
    If frmLesnIfm.WindowState <> 1 Then
        lsvLesnIfm.Move lsvLesnIfm.Left, lsvLesnIfm.Top, Me.ScaleWidth - lsvLesnIfm.Left - 100, Me.ScaleHeight - lsvLesnIfm.Top - 100
    End If
End Sub

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

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

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

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