main.frm

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

'On Error GoTo finish
Select Case Grid1.Cell(hang, 7).Text
 Case "周一至周五"
   array_long = 5 * nknumber
 Case "周一至周六"
   array_long = 6 * nknumber
 Case "周一至周日"
   array_long = 7 * nknumber
End Select
For i = 0 To UBound(array1) - 1
array1(i) = ""
array2(i) = ""
Next
Set kc2 = cnn.Execute("select 占用 from 占用 where 教师姓名='" & Grid1.Cell(hang, 5).Text & "'")
For i = 1 To 7 * nknumber
array1(i) = Mid(kc2.Fields(0), i, 1)
Next
Set kc2 = cnn.Execute("select 占用 from 课程占用 where 班级='" & XPCombo1.Text & "'")
For i = 1 To 7 * nknumber
array2(i) = Mid(kc2.Fields(0), i, 1)
Next
Exit Sub
'finish:
'MsgBox Err.Description
End Sub

Private Sub grid4hq() '获取教师与班级之间的课程点
'On Error GoTo finish
Dim k As Integer
Grid4.Rows = 1
For i = 1 To array_long Step n '通过对比对教师与班级之间的可以排课点进行规纳
  If i + 1 > array_long Then
  Exit Sub
  End If
 If (i = 1 * nknumber Or i = 2 * nknumber Or i = 3 * nknumber Or i = 4 * nknumber Or i = 5 * nknumber Or i = 6 * nknumber Or i = 7 * nknumber Or i = 8 * nknumber) And n <> 1 Then
   i = i + 1
 End If

  '以前判断不可用else语句,否则将会出现一些错误
   If array1(i) = "0" And array2(i) = "0" Then
    '计算I的行数K
        k = Round(i / nknumber)
        If k < i / nknumber Then
           k = k + 1
        End If
     For j = 1 To nknumber
      If Grid5.Cell(j, k).Text = Grid1.Cell(hang, 1).Text Then
      '当已排课与对应课吻合时
      Exit For
      Else
     If j = nknumber Then
     If n = 2 Then '防止5,6,其中6有课程时出现的错误
       If array1(i + 1) = "0" And array2(i + 1) = "0" Then
          Grid4.Rows = Grid4.Rows + 1
          Grid4.Cell(Grid4.Rows - 1, 1).Text = i
       End If
      Else
          Grid4.Rows = Grid4.Rows + 1
          Grid4.Cell(Grid4.Rows - 1, 1).Text = i
      End If
     End If
      
      End If
      Next
    End If
 Next
'finish:
'MsgBox Err.Description
End Sub

Private Sub asPopup1_Click(Cancel As Boolean) '显示用户管理
kctable = "登陆"
usermanage.Caption = "用户管理"
usermanage.Show 1
End Sub

Private Sub asPopup10_Click(Cancel As Boolean)
kctable = "班级名称"
usermanage.Caption = "班级管理"
usermanage.Show 1
End Sub
Private Sub asPopup3_Click(Cancel As Boolean)
Set kc1 = Nothing
Set kc2 = Nothing
Set kc3 = Nothing
cnn.Close
End
End Sub

Private Sub asPopup4_Click(Cancel As Boolean)
kctable = "课程名"
Form5.Caption = "课程管理"
Form5.Show 1
End Sub

Private Sub asPopup5_Click(Cancel As Boolean) '这里是对一些生成错误的数据进行还原
Dim vyes As String
vyes = MsgBox("当系统出现排课错误时需要清空资源占用,确定吗？", vbQuestion + vbYesNo, "提示")
If vyes = vbYes Then
    Dim num As Integer
     num = 7 * nknumber
     For i = 1 To num
     sql = sql & "0"
     Next
Set kc2 = cnn.Execute("update 占用 set 占用='" & sql & "'")
Set kc2 = cnn.Execute("update 课程占用 set 占用='" & sql & "'")
Set kc2 = cnn.Execute("update 公共教室 set 占用='" & sql & "'")
Set kc2 = cnn.Execute("delete * from 公共教室指定")
Set kc2 = cnn.Execute("delete from 临时生成表 where 所属班级='" & XPCombo1.Text & "'")
Set kc2 = cnn.Execute("delete from 对应教师表 where 班级='" & XPCombo1.Text & "'")
End If
End Sub

Private Sub asPopup6_Click(Cancel As Boolean)
kctable = "公共教室"
Form8.Show 1
End Sub

Private Sub asPopup7_Click(Cancel As Boolean)
On Error Resume Next
If admin = True Then
Dim vyes As String
vyes = MsgBox("当系统需要重新配置时可以执行此操作,确定吗？", vbQuestion + vbYesNo, "提示")
If vyes = vbYes Then
Set kc2 = cnn.Execute("delete * from 公共教室指定")
Set kc2 = cnn.Execute("delete * from 临时生成表")
Set kc2 = cnn.Execute("delete * from pksystem")
Set kc2 = cnn.Execute("delete * from 班级名称")
Set kc2 = cnn.Execute("delete * from 登陆")
Set kc2 = cnn.Execute("delete * from 公共教室")
Set kc2 = cnn.Execute("delete * from 教学时间段")
Set kc2 = cnn.Execute("delete * from 课程名")
Set kc2 = cnn.Execute("delete * from 课程信息")
Set kc2 = cnn.Execute("delete * from 课程占用")
Set kc2 = cnn.Execute("delete * from 占用")
Set kc2 = cnn.Execute("delete from 对应教师表")
MsgBox "执行完毕,程序将自动退出,您可以重新打开程序来执行新配置！"
Unload Me
End If
Else
MsgBox "非管理员不可执行此危险操作,谢谢支持!"
End If
End Sub

Private Sub Canceldk_Click()
Grid5.Range(0, 0, Grid5.Rows - 1, Grid5.Cols - 1).BackColor = RGB(148, 167, 178)
MsgBox "已取消此次调课操作", vbInformation, "提示"
End Sub

Private Sub Command_menu_Click(Index As Integer)
cmove 4, Index
End Sub

Private Sub Command10_Click()
Call XPButton9_Click
End Sub

Private Sub Command11_Click()
Call XPButton4_Click
End Sub

Private Sub YuPK() '预排课,通过判断来确定课程的空间量
Set kc4 = cnn.Execute("delete * from 空间明细")
For hang = 1 To Grid1.Rows - 1
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
 StatIIE '初始化比对排课
 StatACC '进行预冒泡排序,得到顺序
End If
Next
End Sub

Private Sub Command2_Click()
Call XPButton1_Click
End Sub

Private Sub Command3_Click()
Call editbutton_Click
End Sub

Private Sub Command4_Click()
Call delbutton_Click
End Sub

Private Sub Command5_Click()
Call XPButton6_Click
End Sub

Private Sub Command6_Click()
Call XPButton3_Click
End Sub

Private Sub Command7_Click()
Call savebutton_Click
End Sub

Private Sub Command8_Click()
Call XPButton8_Click
End Sub

Private Sub Command9_Click()
Call XPButton2_Click
End Sub

Private Sub delbutton_Click() '删除按钮
If XPCombo1.Text = "" Then
MsgBox "班级名称不可为空，请选择班级", vbInformation, "提示"
End If
word_validate
If vde = False Then
 MsgBox Msgboxstr1, vbInformation, "提示"
 Exit Sub
End If
If kcdel = False Then
MsgBox "当前删除操作不被允许!", vbInformation, "非使用对象"
Exit Sub
End If
If hang = 0 Then
Exit Sub
End If
Dim delok As String
If Grid1.Cell(hang, 1).Text = "" Then
Exit Sub
End If
delok = MsgBox("确认删除课程名为" & Grid1.Cell(hang, 1).Text & "的数据吗？？", vbQuestion + vbOKCancel, "注意:此操作将会将学生资料与成绩资料完全清除")
If delok = vbOK Then
sql = "delete from 课程信息 where " & kc1.Fields(0).Name & "='" & Grid1.Cell(hang, 1).Text & "' and 所属班级='" & XPCombo1.Text & "'"
Set kc2 = cnn.Execute(sql)
MsgBox "目标己删除完成!", , "提示"
Call XPButton3_Click
End If
End Sub

Private Sub editbutton_Click() '班级课程资料的编辑
If XPCombo1.Text = "" Then
MsgBox "班级名称不可为空，请选择班级", vbInformation, "提示"
End If
word_validate
If vde = False Then
 MsgBox Msgboxstr1, vbInformation, "提示"
 Exit Sub
End If
If kcedit = False Then
MsgBox "当前修改操作不被允许!", vbInformation, "非使用对象"
Exit Sub
End If

Dim delok As String
delok = MsgBox("确认修改刚才修改的所有数据吗？？", vbQuestion + vbOKCancel, "提示")
If delok = vbOK Then
 Set kc1 = cnn.Execute("select * from 课程信息 where 所属班级='" & XPCombo1.Text & "' order by 每周课数 desc")
 hang = 1
 Do While hang <= Grid1.Rows - 1
 If Grid1.Cell(hang, 1).Text = "" Then
 MsgBox "己完成修改操作!", , "提示"
 Exit Sub
 End If
 If Val(Grid1.Cell(hang, 3).Text) < 2 And Grid1.Cell(hang, 6).Text = "1" Then
  MsgBox "第" & hang & "行的每周课数无法实现两节课连排!", vbInformation, "提示"
 Exit Sub
 End If
 '判断是否公共教室修改
' "提示:当公共教室已成功配置后未注销这段时间内,指定为公共教室的资料是无法修改的!"
 Set kc3 = cnn.Execute("select 教室选择 from 课程信息 where 所属班级='" & XPCombo1.Text & "' and 课程名='" & Grid1.Cell(hang, 1).Text & "'")
  If kc3.Fields(0) <> "默认" Then
   Set kc3 = cnn.Execute("select count(*) from 公共教室指定 where 班级='" & XPCombo1.Text & "' and 课程名='" & Grid1.Cell(hang, 1).Text & "'")
   If kc3.Fields(0) <= 0 Then
      sql = "update 课程信息 set "
            For j = 1 To Grid1.Cols - 2
            sql = sql & kc1.Fields(j - 1).Name & "='" & Grid1.Cell(hang, j).Text & "',"
            Next
  sql = sql & kc1.Fields(j - 1).Name & "='" & Grid1.Cell(hang, j).Text & "' where " & kc1.Fields(0).Name & "='" & Grid1.Cell(hang, 1).Text & "' and 所属班级='" & XPCombo1.Text & "'"
  Set kc2 = cnn.Execute(sql) '用kc2更新数据集,这样可实现批量更新
   End If
  Else
  sql = "update 课程信息 set "
            For j = 1 To Grid1.Cols - 2
            sql = sql & kc1.Fields(j - 1).Name & "='" & Grid1.Cell(hang, j).Text & "',"
            Next
  sql = sql & kc1.Fields(j - 1).Name & "='" & Grid1.Cell(hang, j).Text & "' where " & kc1.Fields(0).Name & "='" & Grid1.Cell(hang, 1).Text & "' and 所属班级='" & XPCombo1.Text & "'"
  Set kc2 = cnn.Execute(sql) '用kc2更新数据集,这样可实现批量更新
  End If
  hang = hang + 1
 Loop
 MsgBox "己完成修改操作!", , "提示"
 Call XPButton3_Click
 End If
End Sub
Function word_validate() '权限验证，主要验证用户是否能执行输入等操作
Set kc2 = cnn.Execute("select count(所属班级) from 临时生成表 where 所属班级='" & XPCombo1.Text & "'")
Set kc3 = cnn.Execute("select count(班级) from 公共教室指定 where 班级='" & XPCombo1.Text & "'")
If kc2.Fields(0) = 0 And kc3.Fields(0) = 0 Then
 vde = True
Else
 vde = False
End If
End Function

Private Sub finddkd_Click() '这里是调课的按钮
'On Error GoTo finish
If admin = False Then
MsgBox "非管理员不可执行此操作", vbInformation, "权限错误"
Exit Sub
End If
'以下是检查班级是否为空,或其它的一些行和列的指向是否正确
If XPCombo1.Text = "" Or Grid5.Cell(hang1, ne1).Text = "" Or hang1 = 0 Or ne1 = 0 Then
MsgBox "对象选择错误!", vbInformation, "错误"
Exit Sub
End If
Set kc1 = cnn.Execute("select 任课老师,两节课累排,课程分布,教室选择 from 课程信息 where 课程名='" & Grid5.Cell(hang1, ne1).Text & "' and 所属班级='" & XPCombo1.Text & "'")
If kc1.Fields(3) <> "默认" Then
 MsgBox "您选择的是公共类教室, 目前不支持此类调动!", vbInformation, "选择错误"
 Exit Sub
End If
Select Case kc1.Fields(2) '获取课程的分布,并以此来确定调课点的位置
 Case "周一至周五"
   array_long = 5 * nknumber
 Case "周一至周六"
   array_long = 6 * nknumber
 Case "周一至周日"
   array_long = 7 * nknumber
End Select
If kc1.Fields(1) = "1" Then
n = 2
Else
n = 1
End If
For i = 0 To UBound(array1) - 1
array1(i) = ""
array2(i) = ""
Next
Set kc2 = cnn.Execute("select 占用 from 占用 where 教师姓名='" & kc1.Fields(0) & "'")
For i = 1 To 7 * nknumber
array1(i) = Mid(kc2.Fields(0), i, 1)
Next
Set kc2 = cnn.Execute("select 占用 from 课程占用 where 班级='" & XPCombo1.Text & "'")
For i = 1 To 7 * nknumber
array2(i) = Mid(kc2.Fields(0), i, 1)
Next

''''''''''''''''''''''''''''''''''''''''''
Grid4.Rows = 1
Dim m As Integer '以下是将可用的点进行规纳和处理,确定调课位置
'grid4hq
For i = 1 To array_long Step n
  If array1(i) = "0" Then
   If array2(i) = "0" Then
    If n = 2 Then
     If array1(i + 1) = "0" And array2(i + 1) = "0" Then
          Grid4.Rows = Grid4.Rows + 1
          Grid4.Cell(Grid4.Rows - 1, 1).Text = i
     End If
    Else
    Grid4.Rows = Grid4.Rows + 1
    Grid4.Cell(Grid4.Rows - 1, 1).Text = i
    End If
    End If
 End If
 Next
 '------------以上整理排课的资源列表
Dim x, y As Integer '以下计算出行和列的位置,并将其背景色变色显示,提示用户
jehang = hang1
jene = ne1
For i = 1 To Grid4.Rows - 1
     x = Round(Grid4.Cell(i, 1).Text / nknumber)
     If x < Grid4.Cell(i, 1).Text / nknumber Then
     x = x + 1