main.frm

高校排课系统.这个小程序使用了皮肤控件

            For j = 1 To Grid1.Cols - 1
            sql = sql & Grid1.Cell(i, j).Text & "','"
           Next
  sql = sql & XPCombo1.Text & "')"
  Set kc1 = cnn.Execute(sql)
     If Grid1.Cell(i, 8).Text <> "默认" Then
    Set kc1 = cnn.Execute("select * from 公共教室 where 教室名称='" & Grid1.Cell(i, 8).Text & "' and 所属='" & Grid1.Cell(i, 1).Text & "'")
    If kc1.EOF = True Then
    Dim num As Integer
     num = 7 * nknumber
     sql = ""
     For n1 = 1 To num
     sql = sql & "0"
     Next
    Set kc1 = cnn.Execute("select 属性 from 公共教室 where 教室名称='" & Grid1.Cell(i, 8).Text & "' and 所属='汇总'")
    Set kc2 = cnn.Execute("insert into 公共教室 values('" & Grid1.Cell(i, 8).Text & "','" & kc1.Fields(0) & "','" & sql & "','" & Grid1.Cell(i, 1).Text & "')")
   End If
  End If
  End If
Next
MsgBox "命令执行完毕!", vbInformation, "完成"
Call XPButton3_Click
End Sub
Private Sub XPButton1_Click() '添加课程的按钮
If XPCombo1.Text = "" Then
MsgBox "班级名称不可为空，请选择班级", vbInformation, "提示"
End If
word_validate
If vde = False Then
 MsgBox Msgboxstr1, vbInformation, "提示"
 Exit Sub
End If
Grid1.Visible = True
 kctable = "课程信息"
 numberkc = 8
 Set kc1 = cnn.Execute("select * from " & kctable)
 For i = 1 To numberkc
 Grid1.Cell(0, i).Text = kc1.Fields(i - 1).Name
 Next
 Grid1.Rows = 1
Grid1.Rows = 8
gridcenter
Grid1.Cell(1, 1).SetFocus
griddispose
kcsave = True
kcedit = False
kcdel = False
End Sub
Private Sub gridcenter()
If Grid1.Rows <> 1 Then '以下是将grid1的所有行所有列的文字全部居中显示
Grid1.Range(1, 1, Grid1.Rows - 1, Grid1.Cols - 1).Alignment = cellCenterCenter
End If
End Sub
Private Sub griddispose() '这里主要是对课程的表格进行处理,并加入课程分布以及所有课程名项
Grid1.Column(1).CellType = cellComboBox
Grid1.Column(5).CellType = cellComboBox
Grid1.Column(6).CellType = cellCheckBox
Grid1.Column(7).CellType = cellComboBox
Grid1.Column(8).CellType = cellComboBox
Grid1.ComboBox(1).Clear
Set kc2 = cnn.Execute("SELECT DISTINCT 课程名 FROM 课程名")
Do While Not kc2.EOF
Grid1.ComboBox(1).AddItem kc2.Fields(0)
kc2.MoveNext
Loop
Grid1.ComboBox(7).Clear
Grid1.ComboBox(7).AddItem "周一至周五"
Grid1.ComboBox(7).AddItem "周一至周六"
Grid1.ComboBox(7).AddItem "周一至周日"
Dim nnum As Integer
nnum = 7 * nknumber
For i = 1 To nnum
Grid1.ComboBox(7).AddItem "第" & i & "节课"
Next
Grid1.ComboBox(8).Clear
Grid1.ComboBox(8).AddItem "默认"
Set kc2 = cnn.Execute("select DISTINCT 教室名称 from 公共教室")
Do While Not kc2.EOF
Grid1.ComboBox(8).AddItem kc2.Fields(0)
kc2.MoveNext
Loop
End Sub

Private Sub XPButton2_Click() '这里是排课的主要代码
'On Error GoTo finish
Dim x, y As Integer
Dim str1() As String
If XPCombo1.Text = "" Then
MsgBox "班级名称不可为空，请选择班级", vbInformation, "提示"
End If
Call XPButton3_Click
XPPbr1.Visible = True
'计算每周数目是否超出范围
kbreturn '返回以前己生成的课表
Dim nnum As Integer '当班级的课程为空时退出排课
Set kc2 = cnn.Execute("select count(所属班级) from 课程信息 where 所属班级='" & XPCombo1.Text & "'")
If kc2.Fields(0) = 0 Then
MsgBox "没有定义课程，无法排课！", vbInformation, "课程未定义"
XPPbr1.Visible = False
Exit Sub
End If
'总结所有课程的每周课数累加是否超过规定的数量
Set kc1 = cnn.Execute("select sum(每周课数) from 课程信息 where 所属班级='" & XPCombo1.Text & "'")
XPPbr1.Max = kc1.Fields(0)
XPPbr1.Min = 0
XPPbr1.Value = 0
nnum = 30
Set kc2 = cnn.Execute("select count(课程分布) from 课程信息 where 所属班级='" & XPCombo1.Text & "' and 课程分布='周一至周六'")
nnum = nnum + kc2.Fields(0) * 2
Set kc2 = cnn.Execute("select count(课程分布) from 课程信息 where 所属班级='" & XPCombo1.Text & "' and 课程分布='周一至周日'")
nnum = nnum + kc2.Fields(0) * 4
If kc1.Fields(0) > nnum Then
MsgBox "每周累计课数超出设置范围，请重新调整"
Exit Sub
End If
Set kc2 = cnn.Execute("delete from 临时生成表 where 所属班级='" & XPCombo1.Text & "'")
'列出公共教室资源
Set kc1 = cnn.Execute("select * from 课程信息 where 所属班级='" & XPCombo1.Text & "' and 教室选择<>'默认'")
If kc1.EOF = False Then
  Do While Not kc1.EOF
   Set kc2 = cnn.Execute("select * from 公共教室指定 where 教室名称='" & kc1.Fields(7) & "' and 班级='" & kc1.Fields(8) & "' and 课程名='" & kc1.Fields(0) & "'")
   If kc2.EOF = True Then
    MsgBox "您定义的公共教室未进行配置,请进入公共教室配置中心", vbInformation, "任务未完成"
    XPPbr1.Visible = False
    Exit Sub
   End If
   kc1.MoveNext
  Loop
  kc1.MoveFirst
  Grid5.Range(1, 1, Grid5.Rows - 1, Grid5.Cols - 1).ClearText '先清除课程表表格中的所有内容
  Do While Not kc1.EOF
    Set kc2 = cnn.Execute("select * from 公共教室指定 where 教室名称='" & kc1.Fields(7) & "' and 班级='" & kc1.Fields(8) & "' and 课程名='" & kc1.Fields(0) & "'")
     str1 = Split(kc2.Fields(kc2.Fields.Count - 1), ",")
     For i = 0 To UBound(str1)
     x = Round(Int(str1(i)) / nknumber)
     If x < Int(str1(i)) / nknumber Then
     x = x + 1
     End If
     y = Int(str1(i)) Mod nknumber
     If y = 0 Then
      y = nknumber
     End If
     Grid5.Cell(y, x).Text = kc2.Fields(3)
     XPPbr1.Value = XPPbr1.Value + 1
     Next
     kc1.MoveNext
  Loop
End If
pkzx '进入排课中心过程
XPPbr1.Visible = False
Exit Sub
'finish:
'MsgBox Err.Description
End Sub
Private Sub pkzx()
 'Second(Time)
'On Error GoTo finish
Dim weizi, x, y, j1, j2 As Integer
YuPK '冒泡排序空间法
Set kc4 = cnn.Execute("select * from 空间明细 order by 剩余空间 asc")
Do While Not kc4.EOF
 For hang = 1 To Grid1.Rows - 1
  If Grid1.Cell(hang, 1).Text = kc4.Fields(0) Then
   Exit For
  End If
 Next
 If Grid1.Cell(hang, 8).Text = "默认" Then
 Select Case Grid1.Cell(hang, 6).Text
  Case "1"
  n = 2 'n代表该课程是否允许连排
  Case "0"
  n = 1
  End Select
 gridcs '执行过程,此过程主要是运行数组比对,读取可用的教师资源和班级资源用
 grid4hq '这里是将可用的教师资源和班级资源进行对比,得出需要的结果
   If Grid4.Rows <= 1 Then
   Set kc4 = cnn.Execute("delete * from 空间明细")
   MsgBox "本次生成课表时系统遇到不可预料故障,请检查各项设定,并注销课程表重新生成！"
   GoTo 1
   End If
 '通过比较得到较适当的课程位置
  Dim Gint(7) As Integer '存取当前课程的各天空间
  Dim Statint(7) As Integer '存储每一天首位值
  For i = 0 To 6
   Gint(i) = 0
   Statint(i) = 0
  Next
  Dim MXstr() As Integer '明细数组
  'MXstr = Split(kc4.Fields(2), ";")
  For i = 1 To Grid4.Rows - 1
    Dim MXInt As Integer
    MXInt = Round(Grid4.Cell(i, 1).Text / nknumber)
    If MXInt < Grid4.Cell(i, 1).Text / nknumber Then
      MXInt = MXInt + 1
    End If
    Select Case MXInt '获昨每天的分布情况
    Case 1
         Gint(0) = Gint(0) + 1
         If Statint(0) = 0 Then
          Statint(0) = Grid4.Cell(i, 1).Text
         End If
    Case 2
         Gint(1) = Gint(1) + 1
         If Statint(1) = 0 Then
          Statint(1) = Grid4.Cell(i, 1).Text
         End If
    Case 3
         Gint(2) = Gint(2) + 1
         If Statint(2) = 0 Then
          Statint(2) = Grid4.Cell(i, 1).Text
         End If
    Case 4
         Gint(3) = Gint(3) + 1
         If Statint(3) = 0 Then
          Statint(3) = Grid4.Cell(i, 1).Text
         End If
    Case 5
         Gint(4) = Gint(4) + 1
         If Statint(4) = 0 Then
          Statint(4) = Grid4.Cell(i, 1).Text
         End If
    Case 6
         Gint(5) = Gint(5) + 1
         If Statint(5) = 0 Then
          Statint(5) = Grid4.Cell(i, 1).Text
         End If
    Case 7
         Gint(6) = Gint(6) + 1
         If Statint(6) = 0 Then
          Statint(6) = Grid4.Cell(i, 1).Text
         End If
    End Select
  Next
  '----------此段为将分布结果排序
  For i = 0 To 6
   Set kc5 = cnn.Execute("insert into i values(" & Gint(i) & "," & Statint(i) & ")")
  Next
   Set kc5 = cnn.Execute("select * from i order by i desc")
   For i = 0 To 6
     Gint(i) = kc5.Fields(0)
     Statint(i) = kc5.Fields(1)
     kc5.MoveNext
   Next
   Set kc5 = cnn.Execute("delete * from i")
'-----------
 '----------------------------
 
 
 '----------------------------
 For i = 1 To Grid1.Cell(hang, 3).Text / n '通过循环为某个课程开始排表
   weizi = Statint(i - 1) '等于最大值的列，相当于平均分配
   '以下计算随机出来的值,取向于课程有的某行某列
     x = Round(weizi / nknumber)
     If x < weizi / nknumber Then
     x = x + 1
     End If
     y = weizi Mod nknumber
     If y = 0 Then
      If nknumber <> 7 Then
      y = nknumber - 1
      Else
      y = nknumber
      End If
     End If
      Select Case n
       Case 2 '当允许两节课连排时运行
          Grid5.Cell(y, x).Text = Grid1.Cell(hang, 1).Text
          Grid5.Cell(y + 1, x).Text = Grid1.Cell(hang, 1).Text
          array1(weizi) = "1"
          array1(weizi + 1) = "1"
          array2(weizi) = "1"
          array2(weizi + 1) = "1"
          XPPbr1.Value = XPPbr1.Value + 2
       Case 1
          Grid5.Cell(y, x).Text = Grid1.Cell(hang, 1).Text
          array1(weizi) = "1"
          array2(weizi) = "1"
          XPPbr1.Value = XPPbr1.Value + 1
       End Select
       '以上XX="1"的部分都是实时对表格进行修改,以便后面将表格的数据提交到数据库
        Dim gsql1, gsql2 As String
        gsql1 = ""
        gsql2 = ""
    For j1 = 1 To nknumber * 7 '以下是开始提交各表格的数据
     If array1(j1) = "" Then
     gsql1 = gsql1 & "0"
     Else
     gsql1 = gsql1 & array1(j1)
     End If
    Next
        Set kc2 = cnn.Execute("update 占用 set 占用='" & gsql1 & "' where 教师姓名='" & Grid1.Cell(hang, 5).Text & "'")
   '将修改的数据提交到数据库中
   For j2 = 1 To nknumber * 7
     If array2(j2) = "" Then
       gsql2 = gsql2 & "0"
     Else
       gsql2 = gsql2 & array2(j2)
     End If
   Next
       Set kc2 = cnn.Execute("update 课程占用 set 占用='" & gsql2 & "' where 班级='" & XPCombo1.Text & "'")
  Next
  End If
 kc4.MoveNext
Loop
1:
Dim gsql3 As String
For i = 1 To Grid5.Rows - 1 '以下是将生成的课表保存到数据库中
      gsql3 = "insert into 临时生成表(时间段,星期一,星期二,星期三,星期四,星期五,星期六,星期日,所属班级) values('"
            For j = 0 To Grid5.Cols - 1
            gsql3 = gsql3 & Grid5.Cell(i, j).Text & "','"
           Next
      gsql3 = gsql3 & XPCombo1.Text & "')"
  Set kc3 = cnn.Execute(gsql3)
Next
'添加教师对应教学表
For i = 1 To Grid5.Rows - 1 '以下是将生成的课表保存到数据库中
      gsql3 = "insert into 对应教师表(时间段,一,二,三,四,五,六,日,班级) values('"
            gsql3 = gsql3 & Grid5.Cell(i, 0).Text & "','"
            For j = 1 To Grid5.Cols - 1
             For k = 0 To Grid1.Rows - 1
               If Grid5.Cell(i, j).Text = "" And k = Grid1.Rows - 1 Then
                gsql3 = gsql3 & "','"
               Else
               If Grid1.Cell(k, 1).Text = Grid5.Cell(i, j).Text Then
                 gsql3 = gsql3 & Grid1.Cell(k, 5).Text & "','"
               End If
               End If
             Next
           Next
      gsql3 = gsql3 & XPCombo1.Text & "')"
  Set kc3 = cnn.Execute(gsql3)

Next

Exit Sub
'finish:
'MsgBox Err.Description
End Sub

Private Sub XPButton3_Click()
On Error GoTo finish
If XPCombo1.Text = "" Then
MsgBox "班级名称不可为空，请选择班级", vbInformation, "提示"
End If
Grid1.Visible = True
kcsave = False
kcedit = True
kcdel = True
griddispose
kcmge
gridcenter
Exit Sub
finish:
MsgBox Err.Description
End Sub

Private Sub kbreturn() '此处主要是返回课表,解决课表占用情况
Call XPButton8_Click
Dim js As Integer
js = 0
XPPbr1.Max = (Grid5.Rows - 1) * (Grid5.Cols - 1)
XPPbr1.Min = 0
XPPbr1.Value = 0
For i = 1 To Grid5.Cols - 1
  For j = 1 To Grid5.Rows - 1
   js = js + 1
   XPPbr1.Value = XPPbr1.Value + 1
   If Grid5.Cell(j, i).Text <> "" Then
   Set kc1 = cnn.Execute("select 教室选择 from 课程信息 where 课程名='" & Grid5.Cell(j, i).Text & "' and 所属班级='" & XPCombo1.Text & "'")
   If kc1.Fields(0) = "默认" Then '以下主要是通过得到教师的资源信息,通过循环得到所要返回的目标,然后对数据进行修改
     Set kc2