form2.frm

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

End Sub

Private Sub SystemAPP1(ByVal iik As Long) '生成资源的主过程1,获取连排
'由系统生成
Dim iij As Integer
Dim kk1 As Integer
Dim weizi, x, y, j1, j2 As Integer
Dim str1() As String
Select Case Grid1.Cell(iik, 6).Text
  Case "1"
  n = 2 'n代表该课程是否允许连排
  Case "0"
  n = 1
End Select
'==============================
End Sub
Private Sub SystemMake(ByVal iik As Long)
SystemAPP1 (iik) '执行资源生成过程1
For ii1 = 1 To Grid1.Cell(iik, 5).Text / n '通过循环为某个课程开始排表
SystemAPP2 (iik) '执行资源生成过程2
'==============================
If Grid4.Rows <= 1 Then '这里可以改为跳过
   Exit Sub
End If
   Randomize '加入此句保证每次程序启动时生成的随机数都不会一样
   weizi = Int((Grid4.Rows - 1) * Rnd()) + 1 '随机出某个grid4中的数值
   '以下计算随机出来的值,取向于课程有的某行某列
     x = Round(Grid4.Cell(weizi, 1).Text / nknumber)
     If x < Grid4.Cell(weizi, 1).Text / nknumber Then
     x = x + 1
     End If
     y = Grid4.Cell(weizi, 1).Text Mod nknumber
       If y = 0 Then
       y = nknumber
       End If
   'For j = 1 To nknumber '如果某一天重复
   ' If Grid5.Cell(j, X).Text = Grid1.Cell(hang, 1).Text Then
   '  i = i - 1
   '  Exit For
   ' End If
   '  If j = nknumber Then
      Select Case n
       Case 2 '当允许两节课连排时运行
          array1(Grid4.Cell(weizi, 1).Text) = "1"
          array1(Grid4.Cell(weizi, 1).Text + 1) = "1"
          array2(Grid4.Cell(weizi, 1).Text) = "1"
          array2(Grid4.Cell(weizi, 1).Text + 1) = "1"
          array3(Grid4.Cell(weizi, 1).Text) = "1"
          array3(Grid4.Cell(weizi, 1).Text + 1) = "1"
       Case 1
       If y > 4 Then '  这里主要是想将单节课程放在下午5,6节课位置
          array1(Grid4.Cell(weizi, 1).Text) = "1"
          array2(Grid4.Cell(weizi, 1).Text) = "1"
          array3(Grid4.Cell(weizi, 1).Text) = "1"
       Else
          y = 5
          weizi = nknumber * x - 1
          array1(weizi) = "1" '此处直接使用weizi就能找到grid2的位置
          array2(weizi) = "1"
          array3(weizi) = "1"
       End If
       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(iik, 3).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 班级='" & Grid1.Cell(iik, 2).Text & "'")

  '----------------------
  gsql2 = ""
     For j2 = 1 To nknumber * 7
     If array3(j2) = "" Then
       gsql2 = gsql2 & "0"
     Else
       gsql2 = gsql2 & array3(j2)
     End If
   Next
       Set kc2 = cnn.Execute("update 公共教室 set 占用='" & gsql2 & "' where 教室名称='" & Grid1.Cell(iik, 1).Text & "'")
'-------添加到公共教室指定表----------
If Grid1.Cell(iik, Grid1.Cols - 1).Text = "" Then
 If n <> 2 Then '用不等2是因为有些课程是两节课一起排的
 Grid1.Cell(iik, Grid1.Cols - 1).Text = Grid4.Cell(weizi, 1).Text
 Else
 Grid1.Cell(iik, Grid1.Cols - 1).Text = Grid4.Cell(weizi, 1).Text & "," & Int(Grid4.Cell(weizi, 1).Text) + 1
 End If
Else
 If n <> 2 Then
 Grid1.Cell(iik, Grid1.Cols - 1).Text = Grid1.Cell(iik, Grid1.Cols - 1).Text & "," & Grid4.Cell(weizi, 1).Text
 Else
 Grid1.Cell(iik, Grid1.Cols - 1).Text = Grid1.Cell(iik, Grid1.Cols - 1).Text & "," & Grid4.Cell(weizi, 1).Text & "," & Int(Grid4.Cell(weizi, 1).Text) + 1
 End If
End If
gsql2 = "select * from 公共教室指定 where "
For iij = 1 To 3
gsql2 = gsql2 & Grid1.Cell(0, iij).Text & "='" & Grid1.Cell(iik, iij).Text & "' and "
Next
gsql2 = gsql2 & Grid1.Cell(0, iij).Text & "='" & Grid1.Cell(iik, iij).Text & "'"
Set kc2 = cnn.Execute(gsql2)
If kc2.EOF = True Then
 gsql2 = "insert into 公共教室指定 values("
 For iij = 1 To Grid1.Cols - 3
  If kc2.Fields(iij - 1).Type = 202 Then
    gsql2 = gsql2 & "'" & Grid1.Cell(iik, iij).Text & "',"
  Else
    gsql2 = gsql2 & Grid1.Cell(iik, iij).Text & ","
  End If
 Next
  gsql2 = gsql2 & "'" & Grid1.Cell(iik, Grid1.Cols - 1).Text & "')"
  Set kc2 = cnn.Execute(gsql2)
Else
  gsql2 = "update 公共教室指定 set " & kc2.Fields(kc2.Fields.Count - 1).Name & "='" & Grid1.Cell(iik, Grid1.Cols - 1).Text & "' where "
 For iij = 1 To kc2.Fields.Count - 2
  If kc2.Fields(iij - 1).Type = 202 Then
    gsql2 = gsql2 & kc2.Fields(iij - 1).Name & "='" & Grid1.Cell(iik, iij).Text & "' and "
  Else
    gsql2 = gsql2 & kc2.Fields(iij - 1).Name & "=" & Grid1.Cell(iik, iij).Text & " and "
  End If
 Next
  gsql2 = gsql2 & kc2.Fields(kc2.Fields.Count - 2).Name & "='" & Grid1.Cell(iik, Grid1.Cols - 3).Text & "'"
  Set kc2 = cnn.Execute(gsql2)
End If
'-------------------------------------
  Next
'Next
'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
End Sub
Private Sub RelatSpecify(ByVal Row As Long)
'关联指定
Dim sql As String
Set kc1 = cnn.Execute("select * from 公共教室指定")
sql = "insert into 公共教室指定 values("
 For j = 1 To Grid1.Cols - 3
  If kc1.Fields(j - 1).Type = 202 Then
    sql = sql & "'" & Grid1.Cell(Row, j).Text & "',"
  Else
    sql = sql & Grid1.Cell(Row, j).Text & ","
  End If
 Next
  sql = sql & "'" & Grid1.Cell(Row, Grid1.Cols - 1).Text & "')"
  Set kc1 = cnn.Execute(sql)
End Sub
Private Sub ManualSPecify(ByVal Row As Long)
'手动指定
For k = Row To Grid1.Rows - 1
Dim sql As String
Dim str1() As String
str1 = Split(Grid1.Cell(k, 9).Text, ",")
If Int(Grid1.Cell(k, 5).Text) <> UBound(str1) + 1 Then
  TEXTCOLOR_Start
  txtRecive.SelText = txtRecive.SelText & "错误：手动指定课程数量少于设定" & vbCrLf
  TEXTCOLOR2_End
 ErrorN = True
 Exit Sub
End If
If Grid1.Cell(k, 6).Text = "1" Then
n = 2
Else
n = 1
End If
'冒泡法检查是否同属一天
For i = 0 To UBound(str1) Step n
 If n = 2 Then
  If Int(str1(i)) + 1 <> Int(str1(i + 1)) Then
  ErrorN = True
  TEXTCOLOR_Start
  txtRecive.SelText = txtRecive.SelText & "错误：表格位置: " & str1(i + 1) & " 累排指定参数不连贯,请修改!" & vbCrLf
  TEXTCOLOR2_End
  Exit Sub
  End If
 End If
 For j = i + n To UBound(str1) Step n
  Dim x As Integer
  Dim y As Integer
  x = Round(Int(str1(i)) / nknumber)
  If x < Int(str1(i)) / nknumber Then
   x = x + 1
  End If
  y = Round(Int(str1(j)) / nknumber)
  If y < Int(str1(j)) / nknumber Then
   y = y + 1
  End If
If x = y Then
  TEXTCOLOR_Start
  txtRecive.SelText = txtRecive.SelText & "错误：表格位置: " & str1(i) & "," & str1(j) & "分配同属一天，程序不允许!" & vbCrLf
  TEXTCOLOR2_End
ErrorN = True
Exit Sub
End If
 Next
Next
For i = 0 To UBound(str1) Step n '检查占用全部通过之后才可以执行修改占用
 '检查是否被占用
   Set kc1 = cnn.Execute("select 占用 from 公共教室 where 教室名称='" & Grid1.Cell(Row, 1).Text & "'")
   If Mid(kc1.Fields(0), str1(i), 1) <> "0" Then
      TEXTCOLOR_Start
      txtRecive.SelText = txtRecive.SelText & "错误：指定位置:[" & str1(i) & "]已被占用,请修改!" & vbCrLf
      TEXTCOLOR2_End
      ErrorN = True
     Exit Sub
   End If
   If n = 2 Then
    If Mid(kc1.Fields(0), str1(i + 1), 1) <> "0" Then
      TEXTCOLOR_Start
      txtRecive.SelText = txtRecive.SelText & "错误：指定位置:[" & str1(i + 1) & "]已被占用,请修改!" & vbCrLf
      TEXTCOLOR2_End
      ErrorN = True
       Exit Sub
    End If
   End If
Next
Next '检测循环结束
str1 = Split(Grid1.Cell(Row, 9).Text, ",")
For i = 0 To UBound(str1) Step n
 '修改占用
  UpdateSpecify "课程占用", "班级", Row, 2, str1(i)
  UpdateSpecify "占用", "教师姓名", Row, 3, str1(i)
  UpdateSpecify "公共教室", "教室名称", Row, 1, str1(i)
 '加入数据库
Dim gsql2 As String
gsql2 = "select * from 公共教室指定 where "
For iij = 1 To 3
gsql2 = gsql2 & Grid1.Cell(0, iij).Text & "='" & Grid1.Cell(Row, iij).Text & "' and "
Next
gsql2 = gsql2 & Grid1.Cell(0, iij).Text & "='" & Grid1.Cell(Row, iij).Text & "'"
Set kc2 = cnn.Execute(gsql2)
If kc2.EOF = True Then
 gsql2 = "insert into 公共教室指定 values("
 For iij = 1 To Grid1.Cols - 3
  If kc2.Fields(iij - 1).Type = 202 Then
    gsql2 = gsql2 & "'" & Grid1.Cell(Row, iij).Text & "',"
  Else
    gsql2 = gsql2 & Grid1.Cell(Row, iij).Text & ","
  End If
 Next
  gsql2 = gsql2 & "'" & Grid1.Cell(Row, Grid1.Cols - 1).Text & "')"
  Set kc2 = cnn.Execute(gsql2)
Else
  gsql2 = "update 公共教室指定 set " & kc2.Fields(kc2.Fields.Count - 1).Name & "='" & Grid1.Cell(Row, Grid1.Cols - 1).Text & "' where "
 For iij = 1 To kc2.Fields.Count - 2
  If kc2.Fields(iij - 1).Type = 202 Then
    gsql2 = gsql2 & kc2.Fields(iij - 1).Name & "='" & Grid1.Cell(Row, iij).Text & "' and "
  Else
    gsql2 = gsql2 & kc2.Fields(iij - 1).Name & "=" & Grid1.Cell(Row, iij).Text & " and "
  End If
 Next
  gsql2 = gsql2 & kc2.Fields(kc2.Fields.Count - 2).Name & "='" & Grid1.Cell(Row, Grid1.Cols - 3).Text & "'"
  Set kc2 = cnn.Execute(gsql2)
End If
Next
End Sub
Private Sub UpdateSpecify(Updatename As String, UpdateKey As String, ByVal Row As Long, ByVal Col As Long, ByVal StartNumber As String)
'修改指定占用的过程,通过参数传递
  Dim gsql As String
  Set kc1 = cnn.Execute("select 占用 from " & Updatename & " where " & UpdateKey & "='" & Grid1.Cell(Row, Col).Text & "'")
  gsql1 = Mid(kc1.Fields(0), 1, Int(StartNumber) - 1)
  If n = 2 Then
  gsql1 = gsql1 & "11"
  Else
  gsql1 = gsql1 & "1"
  End If
  gsql1 = gsql1 & Mid(kc1.Fields(0), Int(StartNumber) + n, Len(kc1.Fields(0)) - Int(StartNumber) + n)
  Set kc1 = cnn.Execute("update " & Updatename & " set 占用='" & gsql1 & "' where " & UpdateKey & "='" & Grid1.Cell(Row, Col).Text & "'")
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    ReleaseCapture '以下的移动方式更简便
    SendMessage Me.hWnd, &HA1, 2, 0&
End Sub

Private Sub Grid1_ComboClick(ByVal Index As Integer)
If Index = 8 Then
Dim Row, Col As Integer
Row = hang
Col = 8
 Select Case Grid1.Cell(Row, Col).Text
  Case "系统生成"
  Case "关联指定"
    '关联指定
    Dim sql As String
    sql = "select DISTINCT 位置 from 公共教室指定 where "
     For i = 1 To Grid1.Cols - 6
     If i <> 2 Then '教室就去除
      sql = sql & Grid1.Cell(0, i).Text & "='" & Grid1.Cell(Row, i).Text & "' and "
     End If
     Next
      sql = sql & Grid1.Cell(0, 5).Text & "=" & Grid1.Cell(Row, 5).Text & " and "
      sql = sql & Grid1.Cell(0, 6).Text & "='" & Grid1.Cell(Row, 6).Text & "' and "
      sql = sql & Grid1.Cell(0, 7).Text & "='" & Grid1.Cell(Row, 7).Text & "'"
     Set kc1 = cnn.Execute(sql)
     Grid1.ComboBox(9).Clear
     Do While Not kc1.EOF
      Grid1.ComboBox(9).AddItem kc1.Fields(0)
      kc1.MoveNext
     Loop
  Case "手动指定"
   SystemAPP1 (hang) '加载资源判断过程1
   SystemAPP2 (hang) '加载资源判断过程2
   GridShowValue '显示Grid2表格值
 End Select
End If
End Sub