frmkcap.frm

毕业设计的学生成绩管理

      Top             =   1080
      Width           =   7455
      Begin VB.ComboBox Combo4 
         Height          =   300
         Index           =   0
         ItemData        =   "FrmKcap.frx":0386
         Left            =   3960
         List            =   "FrmKcap.frx":0396
         Style           =   2  'Dropdown List
         TabIndex        =   6
         Top             =   360
         Width           =   3255
      End
      Begin VB.ComboBox Combo3 
         Height          =   300
         Index           =   0
         Left            =   240
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   360
         Width           =   3375
      End
   End
End
Attribute VB_Name = "FrmKcap"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command3_Click()
    Dim bFlag As Boolean
    Set objRs = objCon.Execute("Select * From " & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text))
    If Not objRs.EOF Then
        If MsgBox("成绩库中已经有数据，删除课程安排将同时删除成绩，您是否继续？", vbYesNo, "系统信息") = vbYes Then
            bFlag = True
        Else
            bFlag = False
        End If
    Else
        If MsgBox("您确认要删除该课程安排吗？", vbYesNo, "系统信息") = vbYes Then
            bFlag = True
        Else
            bFlag = False
        End If
    End If
    objRs.Close
    If bFlag Then
        objCon.Execute ("Delete * From  XKQKB Where kcbmc='" & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text) & "'")
        objCon.Execute ("drop Table " & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text))
        Command2.Enabled = False        '删除后不允许更新
        Command3.Enabled = False
    End If
End Sub

'***************************************************************************************
'  过程：Command2_Click
'  功能：保存修改的课程信息，更新成绩表
'***************************************************************************************

Private Sub Command2_Click()
    Dim numI As Integer
'SQL语句字符串
    Dim strExec As String, strExec1 As String
'流程控制标志
    Dim bFlag As Boolean
    If Combo1.Text = "" Or Combo2.Text = "" Or Len(Text1.Text) <> 4 Or Combo5.Text = "" Or ( _
        Combo3(0).Text = "" And Combo3(1).Text = "" And Combo3(2).Text = "" And Combo3(3).Text = "" And Combo3(4).Text = "" And _
        Combo3(5).Text = "" And Combo3(6).Text = "" And Combo3(7).Text = "" And Combo3(8).Text = "" And Combo3(9).Text = "") Or ( _
        Combo4(0).Text = "" And Combo4(1).Text = "" And Combo4(2).Text = "" And Combo4(3).Text = "" And Combo4(4).Text = "" And _
        Combo4(5).Text = "" And Combo4(6).Text = "" And Combo4(7).Text = "" And Combo4(8).Text = "" And Combo4(9).Text = "") Then
        MsgBox "信息不全，请重新填写！", vbCritical, "错误信息"
    Else
'查找已经安排的课程信息
        Set objRs = objCon.Execute("Select * From " & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text))
        If Not objRs.EOF Then
            If MsgBox("成绩库中已经有数据，更新课程安排将丢失所有数据，您是否继续？", vbYesNo, "系统信息") = vbYes Then
                bFlag = True
            Else
                bfglag = False
                MsgBox "数据更新已经被放弃。", , "系统信息"
            End If
        Else
            If MsgBox("您确认要更新课程安排吗？", vbYesNo, "系统信息") = vbYes Then
                bFlag = True
            Else
                bFlag = False
            End If
        End If
        objRs.Close
        If bFlag Then
            strExec = "Update XKQKB Set "
            strExec1 = "Create Table " & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text) & _
                "(xh char(16) CONSTRAINT PK_" & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text) & " PRIMARY KEY,"
            For numI = 0 To 9       '形成字段名字符串
                If Combo3(numI).Text <> "" And Combo4(numI).Text <> "" Then
                    strExec = strExec & "kcbh" & Trim(Str(numI + 1)) & "='" & fGetKcbh(Combo3(numI).Text) & "',pffs" & Trim(Str(numI + 1)) & "='" & Trim(Str(Combo4(numI).ListIndex)) & "',"
                    Select Case Combo4(numI).ListIndex
                        Case 0  '总成绩
                            strExec1 = strExec1 & "ZCJ" & Trim(Str(numI + 1)) & " float,"
                        Case 1  '理论成绩、实训成绩、总成绩
                            strExec1 = strExec1 & "LLCJ" & Trim(Str(numI + 1)) & " float,SXCJ" & Trim(Str(numI + 1)) & " float,ZCJ" & Trim(Str(numI + 1)) & " float,"
                        Case 2  '学分
                            strExec1 = strExec1 & "XF" & Trim(Str(numI + 1)) & " integer,"
                        Case 3  '考查
                            strExec1 = strExec1 & "KCCJ" & Trim(Str(numI + 1)) & " char(4),"
                    End Select
                End If
            Next
            strExec = Left(strExec, Len(strExec) - 1) & " Where kcbmc='" & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text) & "'"
            strExec1 = Left(strExec1, Len(strExec1) - 1) & ")"
            objCon.Execute (strExec)
            objCon.Execute ("drop Table " & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text))
            objCon.Execute (strExec1)
        End If
        
    End If
End Sub

'***************************************************************************************
'  过程：Command1_Click
'  功能：保存录入的课程信息，创建成绩表
'***************************************************************************************
Private Sub Command1_Click()
    Dim numI As Integer, numJ As Integer
'SQL语句字符串
    Dim strExec As String, strExec1 As String
    If Combo1.Text = "" Or Combo2.Text = "" Or Len(Text1.Text) <> 4 Or Combo5.Text = "" Or ( _
        Combo3(0).Text = "" And Combo3(1).Text = "" And Combo3(2).Text = "" And Combo3(3).Text = "" And Combo3(4).Text = "" And _
        Combo3(5).Text = "" And Combo3(6).Text = "" And Combo3(7).Text = "" And Combo3(8).Text = "" And Combo3(9).Text = "") Or ( _
        Combo4(0).Text = "" And Combo4(1).Text = "" And Combo4(2).Text = "" And Combo4(3).Text = "" And Combo4(4).Text = "" And _
        Combo4(5).Text = "" And Combo4(6).Text = "" And Combo4(7).Text = "" And Combo4(8).Text = "" And Combo4(9).Text = "") Then
        MsgBox "信息不全，请重新填写！", vbCritical, "错误信息"
    Else
'查找已经安排的课程信息
        Set objRs = objCon.Execute("Select * From XKQKB Where kcbmc='" & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text) & "'")
        If Not objRs.EOF Then   '已经存在同一条件的课程安排信息
            MsgBox "已经存在同一条件的课程安排信息，无法保存本次课程安排内容！", vbCritical, "错误信息"
        Else
'生成选课信息SQL语句
            strExec = "Insert Into XKQKB (kcbmc"
'创建成绩表SQL语句
            strExec1 = "Create Table " & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text) & "(xh char(16),"
            numJ = 0
            For numI = 0 To 9       '形成字段名字符串
                If Combo3(numI).Text <> "" And Combo4(numI).Text <> "" Then
'使用numj而不用numi是为了避免没有按控件顺序设置课程而出现课程编号空的问题
                    strExec = strExec & ",kcbh" & Trim(Str(numJ + 1)) & ",pffs" & Trim(Str(numJ + 1))
                    Select Case Combo4(numI).ListIndex
                        Case 0  '总成绩
                            strExec1 = strExec1 & "ZCJ" & Trim(Str(numJ + 1)) & " float,"
                        Case 1  '理论成绩、实训成绩、总成绩
                            strExec1 = strExec1 & "LLCJ" & Trim(Str(numJ + 1)) & " float,SXCJ" & Trim(Str(numJ + 1)) & " float,ZCJ" & Trim(Str(numJ + 1)) & " float,"
                        Case 2  '学分
                            strExec1 = strExec1 & "XF" & Trim(Str(numJ + 1)) & " integer,"
                        Case 3  '考查
                            strExec1 = strExec1 & "KCCJ" & Trim(Str(numJ + 1)) & " char(4),"
                    End Select
                    numJ = numJ + 1
                End If
            Next
            strExec = strExec & ") Values ('" & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text) & "'"
            For numI = 0 To 9
                If Combo3(numI).Text <> "" And Combo4(numI).Text <> "" Then
                    strExec = strExec & ",'" & fGetKcbh(Combo3(numI).Text) & "','" & Trim(Str(Combo4(numI).ListIndex)) & "'"
                End If
            Next
            strExec = strExec & ")"
            strExec1 = Left(strExec1, Len(strExec1) - 1) & ")"
            If MsgBox("您确认要保存本次课程安排吗？", vbYesNo, "系统信息") = vbYes Then
'执行生成选课信息SQL语句，生成选课记录
                objCon.Execute (strExec)
'执行创建成绩表SQL语句，生成成绩表（如CJ2000010106，1系1专业2000级第六学期成绩表）
                objCon.Execute (strExec1)
            End If
        End If
        objRs.Close
    End If
End Sub

Private Sub command5_click()        '根据不同条件提取课程名称信息或课程安排信息
    Dim strExec As String
    Dim numI As Integer
    Text1.Locked = False
    Combo1.Locked = False
    Combo2.Locked = False
    Combo5.Locked = False
    If Combo1.Text <> "" And Combo2.Text <> "" Then
        If Combo5.Text <> "" And Text1.Text <> "" Then  '条件充足，检查已有课程安排信息
            If Len(Text1.Text) <> 4 Then
                MsgBox "非法的年级数据，请重新填写！", , "系统信息"
                Text1.SetFocus
            Else
                strExec = "Select * From XKQKB Where kcbmc='" & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text) & "'"
                Set objRs = objCon.Execute(strExec)
                If Not objRs.EOF Then   '存在课程安排信息,显示供修改和删除
                    Text1.Locked = True     '不允许修改年级、系别名称、专业名称和学期
                    Combo1.Locked = True
                    Combo2.Locked = True
                    Combo5.Locked = True
                    numI = 0
                    Do While Not objRs.EOF And numI < 10
                        Combo3(numI).Clear
                        If objRs("kcbh" & Trim(Str(numI + 1))) <> "" Then
                            Combo3(numI).AddItem (fGetKcmc(objRs("kcbh" & Trim(Str(numI + 1)))))
                            Combo3(numI).ListIndex = 0      '显示当前排课情况
                            Combo4(numI).ListIndex = Val(objRs("pffs" & Trim(Str(numI + 1))))
                        End If
                        numI = numI + 1
                    Loop
                    Command2.Enabled = True
                    Command3.Enabled = True
                    Command1.Enabled = False
                    strExec = "Select * From KCMCB Where xbbh=(Select xbbh From XBMCB Where xbmc='" & Combo1.Text & "') And zybh=(Select zybh From ZYMCB Where zymc='" & Combo2.Text & "')"
                    Set objRs = objCon.Execute(strExec) '检索出其他课程名称，供修改
                    If Not objRs.EOF Then
                        For numI = 0 To 9
                            objRs.MoveFirst
                            Do While Not objRs.EOF
                                If Trim(objRs("kcmc")) <> Trim(Combo3(numI).Text) Then
                                    Combo3(numI).AddItem (objRs("kcmc"))
                                End If
                                objRs.MoveNext
                            Loop
                        Next
                    End If
                Else        '不存在指定年级、的课程安排信息，检索所有该系别和专业的课程名称，供安排新的课程表
                    strExec = "Select * From KCMCB Where xbbh=(Select xbbh From XBMCB Where xbmc='" & Combo1.Text & "') And zybh=(Select zybh From ZYMCB Where zymc='" & Combo2.Text & "')"
                    Set objRs = objCon.Execute(strExec)
                    If Not objRs.EOF Then   '存在课程名称信息,显示供排课
                        For numI = 0 To 9
                            objRs.MoveFirst
                            Combo3(numI).Clear
                            Do While Not objRs.EOF
                                Combo3(numI).AddItem (objRs("kcmc"))
                                objRs.MoveNext
                            Loop
                        Next
                        Command2.Enabled = False
                        Command3.Enabled = False
                        Command1.Enabled = True
                    Else
                        MsgBox "您还没有录入该系、专业的课程名称信息！", vbCritical, "错误信息"
                    End If
                End If
                objRs.Close
            End If
        Else             '提取所有该系别、专业的课程(未安排)信息
            strExec = "Select * From KCMCB Where xbbh=(Select xbbh From XBMCB Where xbmc='" & Combo1.Text & "') And zybh=(Select zybh From ZYMCB Where zymc='" & Combo2.Text & "')"
            Set objRs = objCon.Execute(strExec)
            If Not objRs.EOF Then   '存在课程名称信息,显示供排课
                For numI = 0 To 9
                    objRs.MoveFirst
                    Combo3(numI).Clear
                    Do While Not objRs.EOF
                        Combo3(numI).AddItem (objRs("kcmc"))
                        objRs.MoveNext
                    Loop
                Next
                Command2.Enabled = False
                Command3.Enabled = False
                Command1.Enabled = True
            Else
                MsgBox "您还没有录入该系、专业的课程名称信息！", vbCritical, "错误信息"
            End If
            objRs.Close
        End If
    Else
        MsgBox "请指定系别和专业名称！", vbCritical, "错误信息"
    End If
End Sub

Private Sub Jckcxz(ByVal index As Integer, ByVal strCurVal As String)
    Dim numI As Integer             '检查课程选择，保证不出现不合理的情况
    For numI = 0 To 9
        If Combo3(numI).Text = strCurVal And numI <> index Then '出现相同的课程选择
            MsgBox "同一个学期不能选择相同的课程两次！", vbCritical, "错误信息"
            Combo3(index).SetFocus
            Exit For
        End If
    Next
End Sub
Private Sub Combo3_Click(index As Integer)
    Call Jckcxz(index, Combo3(index).Text)
End Sub

Private Sub Form_Load()
    Set objRs = objCon.Execute("Select Distinct xbmc From XBMCB")
    Do While Not objRs.EOF
        Combo1.AddItem Trim((objRs("xbmc")))
        objRs.MoveNext
    Loop
    Set objRs = objCon.Execute("Select Distinct zymc From ZYMCB")
    Do While Not objRs.EOF
        Combo2.AddItem Trim((objRs("zymc")))
        objRs.MoveNext
    Loop
    objRs.Close
    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    FrmMain.Enabled = True
End Sub

Private Sub Command4_Click()
    Unload FrmKcap
    FrmMain.Enabled = True
End Sub