frmclasskecheng1.frm

vb精彩编程希望大家有用

VERSION 5.00
Begin VB.Form Frmclasskecheng1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "班级课程设置"
   ClientHeight    =   6450
   ClientLeft      =   3345
   ClientTop       =   1020
   ClientWidth     =   5460
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   6450
   ScaleWidth      =   5460
   Begin VB.Frame Frame1 
      Caption         =   "班级课程设置"
      Height          =   6255
      Left            =   0
      TabIndex        =   0
      Top             =   120
      Width           =   5415
      Begin VB.CommandButton Command4 
         Height          =   735
         Left            =   2460
         Picture         =   "Frmclasskecheng1.frx":0000
         Style           =   1  'Graphical
         TabIndex        =   13
         Top             =   3240
         Width           =   495
      End
      Begin VB.CommandButton Command3 
         Height          =   855
         Left            =   2460
         Picture         =   "Frmclasskecheng1.frx":0442
         Style           =   1  'Graphical
         TabIndex        =   12
         Top             =   2400
         Width           =   495
      End
      Begin VB.CommandButton Command2 
         Caption         =   "取消设置"
         Height          =   375
         Left            =   3600
         TabIndex        =   11
         Top             =   5760
         Width           =   1095
      End
      Begin VB.CommandButton Command1 
         Caption         =   "确定设置"
         Height          =   375
         Left            =   600
         TabIndex        =   10
         Top             =   5760
         Width           =   1095
      End
      Begin VB.Frame Frame7 
         Caption         =   "年制："
         Height          =   615
         Left            =   120
         TabIndex        =   9
         Top             =   840
         Width           =   2055
         Begin VB.ComboBox Combo1 
            BackColor       =   &H80000018&
            Height          =   300
            Index           =   2
            Left            =   120
            TabIndex        =   15
            Top             =   200
            Width           =   1815
         End
      End
      Begin VB.Frame Frame6 
         Caption         =   "所选科目"
         Height          =   4095
         Left            =   3120
         TabIndex        =   7
         Top             =   1560
         Width           =   2175
         Begin VB.ListBox List2 
            BackColor       =   &H80000018&
            Height          =   3630
            ItemData        =   "Frmclasskecheng1.frx":0884
            Left            =   120
            List            =   "Frmclasskecheng1.frx":0886
            Style           =   1  'Checkbox
            TabIndex        =   8
            Top             =   240
            Width           =   1935
         End
      End
      Begin VB.Frame Frame5 
         Caption         =   "所有科目"
         Height          =   4095
         Left            =   120
         TabIndex        =   5
         Top             =   1560
         Width           =   2175
         Begin VB.ListBox List1 
            BackColor       =   &H80000018&
            Height          =   3630
            ItemData        =   "Frmclasskecheng1.frx":0888
            Left            =   120
            List            =   "Frmclasskecheng1.frx":088A
            Style           =   1  'Checkbox
            TabIndex        =   6
            Top             =   240
            Width           =   1935
         End
      End
      Begin VB.Frame Frame4 
         Caption         =   "学期："
         Height          =   615
         Left            =   2400
         TabIndex        =   4
         Top             =   840
         Width           =   2895
         Begin VB.ComboBox Combo1 
            BackColor       =   &H80000018&
            Height          =   300
            Index           =   3
            Left            =   120
            TabIndex        =   16
            Top             =   200
            Width           =   2655
         End
      End
      Begin VB.Frame Frame3 
         Caption         =   "专业："
         Height          =   615
         Left            =   2400
         TabIndex        =   3
         Top             =   240
         Width           =   1695
         Begin VB.ComboBox Combo1 
            BackColor       =   &H80000018&
            Height          =   300
            Index           =   1
            Left            =   120
            TabIndex        =   14
            Top             =   200
            Width           =   1455
         End
      End
      Begin VB.Frame Frame2 
         Caption         =   "年级："
         Height          =   615
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   2055
         Begin VB.ComboBox Combo1 
            BackColor       =   &H80000018&
            Height          =   300
            Index           =   0
            Left            =   120
            TabIndex        =   2
            Top             =   200
            Width           =   1815
         End
      End
   End
End
Attribute VB_Name = "Frmclasskecheng1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'班级课程设置
Private Sub Combo1_Click(Index As Integer)
    Dim mrc As ADODB.Recordset
    If Index = 0 Then
        txtsql = "select   DISTINCT 专业 from class where 年级='" & Trim(Combo1(0).Text) & "'"
        Set mrc = ExecuteSQL(txtsql)
        If mrc.EOF = True Then
            Combo1(1).Text = ""
            Combo1(2).Text = ""
            Exit Sub
        End If
        Combo1(1).Clear
        mrc.MoveFirst
        Do Until mrc.EOF
            Combo1(1).AddItem mrc.Fields(0)
            mrc.MoveNext
        Loop
        Combo1(1).ListIndex = 0
        txtsql = "select   DISTINCT 年制 from class where 年级='" & Trim(Combo1(0).Text) & _
            "' and 专业='" & Trim(Combo1(1).Text) & "'"
        Set mrc = ExecuteSQL(txtsql)
        If mrc.EOF = True Then
            Combo1(2).Text = ""
            Exit Sub
        End If
        Combo1(2).Clear
        mrc.MoveFirst
        Do Until mrc.EOF
            Combo1(2).AddItem mrc.Fields(0)
            mrc.MoveNext
        Loop
        Combo1(2).ListIndex = 0
    ElseIf Index = 1 Then
        txtsql = "select   DISTINCT 年制 from class where 年级='" & _
            Trim(Combo1(0).Text) & "' and 专业='" & Trim(Combo1(1).Text) & "'"
        Set mrc = ExecuteSQL(txtsql)
        If mrc.EOF = True Then
            Combo1(0).Text = ""
            Combo1(2).Text = ""
            Exit Sub
        End If
        Combo1(2).Clear
        mrc.MoveFirst
        Do Until mrc.EOF
            Combo1(2).AddItem mrc.Fields(0)
            mrc.MoveNext
        Loop
        Combo1(2).ListIndex = 0
    End If
End Sub
Private Sub Combo1_DropDown(Index As Integer)
    If Index = 0 Then
        Dim mrc As ADODB.Recordset
        txtsql = "select  DISTINCT 年级  from class "
        Set mrc = ExecuteSQL(txtsql)
        mrc.MoveFirst
        Combo1(0).Clear
        Do While Not mrc.EOF
            Combo1(0).AddItem mrc.Fields(0)
            mrc.MoveNext
        Loop
        Combo1(0).ListIndex = 0
    End If
End Sub
Private Sub Command1_Click()
    qxstr = Executeqx(4)
    If qxstr = "readonly" Then
        ss = MsgBox("对不起，你是只读用户不能添加记录，请与管理员联系！", _
            vbInformation + vbOKOnly, " 警告")
        Exit Sub
    End If
    If List2.ListCount = 0 Then
        ssss = MsgBox("你还没有选择课程！", vbInformation + vbOKOnly, "警告")
        Exit Sub
    End If
    Dim mrc As ADODB.Recordset
    txtsql = "select * from classkecheng where 年级='" & _
        Trim(Combo1(0).Text) & "' and 专业='" & Trim(Combo1(1).Text) & _
        "'and 年制='" & Trim(Combo1(2).Text) & "' and 学期='" & _
        Trim(Combo1(3).Text) & "'"
    Set mrc = ExecuteSQL(txtsql)
    If mrc.EOF = False Then
        sss = MsgBox("已存在该班级本学期课程设置和成绩记录，" & Chr(10) & Chr(13) & _
            "继续会导致以上的成绩丢失,继续吗？！", vbOKCancel + vbExclamation, "警告")
        If sss = vbCancel Then
            Exit Sub
        Else
            txtsql = "delete * from classkecheng where 年级='" & _
            Trim(Combo1(0).Text) & "' and 专业='" & Trim(Combo1(1).Text) & _
            "'and 年制='" & Trim(Combo1(2).Text) & "' and 学期='" & _
                Trim(Combo1(3).Text) & "'"
            Set mrc = ExecuteSQL(txtsql)
            txtsql = "delete * from cj where 学号 in(select DISTINCT xj.学号 " & _
                " from xj inner join class on xj.班级=class.班级 where 年级='" & _
                Trim(Combo1(0).Text) & "' and 专业='" & Trim(Combo1(1).Text) & _
                "'and 年制='" & Trim(Combo1(2).Text) & "')  and 学期='" & _
                    Trim(Combo1(3).Text) & "'"
            Set mrc = ExecuteSQL(txtsql)
        End If
    End If
    txtsql = "select * from classkecheng"
    Set mrc = ExecuteSQL(txtsql)
    For i = o To List2.ListCount - 1
        mrc.AddNew
        mrc.Fields(0) = Trim(Combo1(0).Text)
        mrc.Fields(1) = Trim(Combo1(1).Text)
        mrc.Fields(2) = Trim(Combo1(2).Text)
        mrc.Fields(3) = Trim(Combo1(3).Text)
        mrc.Fields(4) = Trim(List2.List(i))
        mrc.Update
    Next i
    ssss = MsgBox("课程设置成功！", vbInformation + vbOKOnly, "提示")
End Sub
Private Sub Command2_Click()
    Unload Me
End Sub
Private Sub Command3_Click()
    Dim i As Integer
    i = 0
    Do While i < List1.ListCount
        If List1.Selected(i) = True Then
            List2.AddItem List1.List(i)
            List1.RemoveItem i
        Else
            i = i + 1
        End If
    Loop
    If List1.ListCount = 0 Then
        Command3.Enabled = False
    End If
    If List2.ListCount <> 0 Then
        Command4.Enabled = True
    End If
End Sub
Private Sub Command4_Click()
    Dim i As Integer
    i = 0
    Do While i < List2.ListCount
        If List2.Selected(i) = True Then
            List1.AddItem List2.List(i)
            List2.RemoveItem i
        Else
            i = i + 1
        End If
    Loop
    If List1.ListCount <> 0 Then
        Command3.Enabled = True
    End If
    If List2.ListCount = 0 Then
        Command4.Enabled = False
    End If
End Sub
Private Sub Form_Load()
    Dim mrc As ADODB.Recordset
    txtsql = "select  DISTINCT 年级  from class "
    Set mrc = ExecuteSQL(txtsql)
    mrc.MoveFirst
    Combo1(0).Clear
    Do While Not mrc.EOF
        Combo1(0).AddItem mrc.Fields(0)
        mrc.MoveNext
    Loop
    Combo1(0).ListIndex = 0
    txtsql = "select   DISTINCT 专业 from class where 年级='" & Trim(Combo1(0).Text) & "'"
    Set mrc = ExecuteSQL(txtsql)
    Combo1(1).Clear
    mrc.MoveFirst
    Do While Not mrc.EOF
        Combo1(1).AddItem mrc.Fields(0)
        mrc.MoveNext
    Loop
    Combo1(1).ListIndex = 0
    txtsql = "select   DISTINCT 年制 from class where 年级='" & Trim(Combo1(0).Text) & _
        "' and 专业='" & Trim(Combo1(1).Text) & "'"
    Combo1(2).Clear
    Set mrc = ExecuteSQL(txtsql)
    mrc.MoveFirst
    Do While Not mrc.EOF
        Combo1(2).AddItem mrc.Fields(0)
        mrc.MoveNext
    Loop
    Combo1(2).ListIndex = 0
    mrc.Close
    Combo1(3).AddItem Val(Format(Date, "yyyy")) - 1 & "---" & _
        Val(Format(Date, "yyyy")) & "年级第一学期"
    Combo1(3).AddItem Val(Format(Date, "yyyy")) - 1 & "---" & _
        Val(Format(Date, "yyyy")) & "年级第二学期"
    Combo1(3).AddItem Format(Date, "yyyy") & "---" & _
        Val(Format(Date, "yyyy")) + 1 & "年级第一学期"
    Combo1(3).AddItem Format(Date, "yyyy") & "---" & _
        Val(Format(Date, "yyyy")) + 1 & "年级第二学期"
    Combo1(3).AddItem Val(Format(Date, "yyyy")) + 1 & "---" & _
        Val(Format(Date, "yyyy")) + 2 & "年级第一学期"
    Combo1(3).AddItem Val(Format(Date, "yyyy")) + 1 & "---" & _
        Val(Format(Date, "yyyy")) + 2 & "年级第二学期"
    If Val(Format(Date, "mm")) > 8 Then
        Combo1(3).ListIndex = 2
    Else
        Combo1(3).ListIndex = 1
    End If
    '填充列表框
    List1.Clear
    List2.Clear
    txtsql = "select 课程名称 from allkecheng "
    Set mrc = ExecuteSQL(txtsql)
    If mrc.EOF = True Then
        Exit Sub
    End If
    mrc.MoveFirst
    Do Until mrc.EOF
        List1.AddItem mrc.Fields(0)
        mrc.MoveNext
    Loop
    Set mrc = Nothing
    '判断按纽是否有效
    If List1.ListCount = 0 Then
        Command3.Enabled = False
    Else
        Command3.Enabled = True
    End If
    If List2.ListCount = 0 Then
        Command4.Enabled = False
    Else
        Command4.Enabled = True
    End If
End Sub