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