b课表安排.frm

派克系统

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "msdatgrd.ocx"
Begin VB.Form B课表安排 
   Caption         =   "课表安排"
   ClientHeight    =   5280
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6300
   LinkTopic       =   "Form5"
   ScaleHeight     =   5280
   ScaleWidth      =   6300
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame1 
      Caption         =   "班级课程信息"
      Height          =   5295
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   6255
      Begin VB.CommandButton CmdDo 
         BackColor       =   &H00C0C0C0&
         Caption         =   "生成课表"
         Height          =   360
         Left            =   3600
         Style           =   1  'Graphical
         TabIndex        =   4
         Top             =   4800
         Width           =   1275
      End
      Begin VB.CommandButton CmdExit 
         BackColor       =   &H00C0C0C0&
         Caption         =   "退出"
         Height          =   360
         Left            =   5250
         Style           =   1  'Graphical
         TabIndex        =   3
         Top             =   4800
         Width           =   800
      End
      Begin MSDataGridLib.DataGrid DataGrid1 
         Height          =   2295
         Left            =   120
         TabIndex        =   2
         Top             =   2400
         Width           =   6015
         _ExtentX        =   10610
         _ExtentY        =   4048
         _Version        =   393216
         HeadLines       =   1
         RowHeight       =   15
         BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ColumnCount     =   2
         BeginProperty Column00 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column01 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
         EndProperty
      End
      Begin MSComctlLib.ListView ListView1 
         Height          =   2055
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   6015
         _ExtentX        =   10610
         _ExtentY        =   3625
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         _Version        =   393217
         Icons           =   "ImageList1"
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   0
         NumItems        =   0
      End
      Begin MSComctlLib.ImageList ImageList1 
         Left            =   120
         Top             =   360
         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   32
         ImageHeight     =   32
         MaskColor       =   12632256
         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   1
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "B课表安排.frx":0000
               Key             =   ""
            EndProperty
         EndProperty
      End
   End
End
Attribute VB_Name = "B课表安排"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As ADODB.Recordset
Dim SQL As String
Dim msg As String
Dim index As Integer
Dim index2 As Integer
Dim flag As String '判断是新增记录还是修改记录
Dim M_courseTable(11, 8) As String   '定义一张课表矩阵
Dim M_segmentNum  As Integer
Dim M_Flag As Boolean    '定义模块变量，判断条件设置是否合法
Dim M_rowIndex As Integer '定义模块变量，存放行序号
Dim M_colIndex As Integer '定义模块变量，存放列序号
Dim M_course As String '定义模块变量，存放课程名称
Dim M_class As String '定义模块变量，存放班级名称
Private Sub Form_Load()
    Call LoadData                               '装载数据
    Call ListView1_Click                        '显示班级课程信息
End Sub
Private Sub LoadData()
'装载数据
    Dim list As ListItem
    Dim key As String
    Set rs = Nothing
    '查询班级名称
    SQL = "SELECT 班级名称 FROM 班级信息表 ORDER BY 班级名称"
    Set rs = SelectSQL(SQL, msg)
    ListView1.ListItems.Clear    '清空ListView
    If rs.RecordCount > 0 Then   '如果存在记录
        rs.MoveFirst
        Do Until rs.EOF
            key = rs.Fields("班级名称")
            Set list = ListView1.ListItems.Add(, , key, 1)
            rs.MoveNext
        Loop
    End If
End Sub
Private Sub ListView1_Click()
'在控件中显示班级信息
    Dim key As String
    If rs.RecordCount > 0 Then
        key = Trim(ListView1.SelectedItem)
        Call ShowData(key)                    '重新显示数据
    End If
End Sub
Private Sub ShowData(key As String)
'显示班级课程信息
    Dim rst As ADODB.Recordset
    SQL = " SELECT 课程名称,总节数,每周节数,课程分布,任课教师 FROM 班级课程信息表 "
    SQL = SQL & "WHERE 班级名称='" & key & "'"
    Set rst = SelectSQL(SQL, msg)
    Set DataGrid1.DataSource = rst
    DataGrid1.Refresh
End Sub
Private Sub CmdDo_Click()
'生成课表
    msg = MsgBox("您确实要进行排课吗?", vbYesNo)
    If msg = vbYes Then     '如果选则“是”，进行排课
        M_Flag = True       '给模块变量赋值
        '@1给每个班生成一张空的课程表
        Call GenerateEmptyCT
        '@2开始排课
        Call GenerateRealCT
        '@3如果排课条件设置错误，不进行排课
        If M_Flag = False Then
            MsgBox ("排课条件设置有问题，请重新设置！")
            Exit Sub
        End If
    Else
        Exit Sub
    End If
End Sub
Private Sub GenerateEmptyCT()
' 给每个班生成一张空的课程表
    Dim rst1 As ADODB.Recordset
    Dim rst2 As ADODB.Recordset
    Dim strClass As String    '定义班级名称变量
    Dim strSegment As String  '定义节号变量
    '@1删除排课信息表
    SQL = " delete from 排课信息表"
    Call ExecuteSQL(SQL, msg)
    '@2得到班级名称集
    SQL = " select 班级名称 from 班级信息表 order by 班级名称"
    Set rst1 = SelectSQL(SQL, msg)
    '@3得到节号集
    SQL = " select 节号 from 时间段信息表 order by 节号"
    Set rst2 = SelectSQL(SQL, msg)
    M_segmentNum = rst2.RecordCount    '得到每天教学节数
    '@4生成空课表，遍历每一个班级
    If rst1.RecordCount > 0 And rst2.RecordCount > 0 Then
        Do While Not rst1.EOF
            strClass = rst1.Fields("班级名称")
            '遍历所有节号，将初始排课信息插入到课表中
            Do While Not rst2.EOF
                strSegment = rst2.Fields("节号")
                SQL = "insert into 排课信息表(班级名称,节号,星期一,星期二,星期三,星期四,星期五,星期六,星期日) "
                SQL = SQL & " values ('" & strClass & "','" & strSegment & "','','','','','','','')"
                Call ExecuteSQL(SQL, msg)
                rst2.MoveNext
            Loop
            rst2.MoveFirst
            rst1.MoveNext
        Loop
        MsgBox ("已经生成了空课表！")
    End If
End Sub
Private Sub GenerateRealCT()
'给每个班生成一张真实的课程表
    Dim rst1 As ADODB.Recordset
    Dim strClass As String    '定义班级名称变量
    '@1得到班级名称集
    SQL = " select 班级名称 from 班级信息表 order by 班级名称"
    Set rst1 = SelectSQL(SQL, msg)
    '@2给每个班生成课表