main.frm

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

     End If
     y = Grid4.Cell(i, 1).Text Mod nknumber
       If y = 0 Then
       y = nknumber
       End If
 For j = 1 To nknumber
   If Grid5.Cell(j, x).Text <> Grid5.Cell(hang1, ne1).Text Then
   If j = nknumber Then
    Grid5.Cell(y, x).BackColor = RGB(255, 255, 255)
   End If
   Else
    If x = ne1 Then
         Grid5.Cell(y, x).BackColor = RGB(255, 255, 255)
    End If
   Exit For
   End If
  Next
 Next
' Exit Sub
'finish:
'MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo finish
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册
Me.Caption = Me.Caption & " 版本(" & Str(VersionN) & ")"
pkskn.LoadSkin App.Path & "\chizh.skn"
pkskn.ApplySkinByName hWnd, "窗体"
pkskn.ApplySkin hWnd
With Grid1 '这里设置图表控件grid1的一些参数
    .AllowUserResizing = True '是否可调整行和例
    .DisplayFocusRect = False '当前活动单元格是否显示一个虚框
    .ExtendLastCol = True '是否让表格充满控件
    .Appearance = Flat '选择绘图风格，平面还是3D
    .FixedRowColStyle = Flat '固定行/列的样式
    .ScrollBarStyle = Flat '滚动条的样式
    '以上几个都是关于grid1的美化设置，都是一些无关紧要的设置
    .DefaultFont.Name = "Tahoma"
    .BackColorFixed = RGB(123, 124, 125) 'RGB(90, 158, 214)
    .BackColorFixedSel = RGB(123, 124, 125) 'RGB(110, 180, 230)
    .BackColorBkg = RGB(123, 124, 125) 'RGB(90, 158, 214)
    .BackColorScrollBar = RGB(123, 124, 125) 'RGB(231, 235, 247)
    .BackColor1 = RGB(231, 235, 247)
    .BackColor2 = RGB(239, 243, 255)
    .GridColor = RGB(123, 124, 125) 'RGB(148, 190, 231)

End With
    Grid1.Column(0).Width = 0
    Grid1.Column(1).Width = 120
    Grid1.Column(2).Width = 60
    Grid1.Column(3).Width = 60
    Grid1.Column(4).Width = 60
    Grid1.Column(5).Width = 100
    Grid1.Column(6).Width = 80
    Grid1.Column(7).Width = 97
    Grid1.Column(8).Width = 90
    XPCombo1.Clear '清空xpcombo的集合内容
    Set kc2 = cnn.Execute("select 班级名称 from 班级名称")
    Do While Not kc2.EOF '将所有班级名称加入xpcombo1集合
    XPCombo1.AddItem kc2.Fields(0)
    kc2.MoveNext
    Loop
    Grid1.Visible = False
    Grid1.Column(4).Locked = True
    Grid1.Column(2).Mask = cellValue
    Grid1.Column(3).Mask = cellValue
    
    '---------------------
 Grid4.RowHeight(0) = 0 '设定grid4的第0行的行高为0
 Grid4.Column(0).Width = 0
 Grid4.Column(1).Width = 20
 '系统布局配置
Me.Show '显示窗体，以最终确定窗体的高度:)
Picmenu_bg.Height = Me.ScaleHeight - Picmenu_bg.Top '设定菜单页的高度
je = 4 '此处je变量主要作用于类QQ菜单的使用，这里自动设定记忆上一次的使用按钮
cmove 4, 0 '使菜单自选为第一菜单
'设定frame2的宽度
 Frame2.Width = Me.ScaleWidth - Frame2.Left - 120
 Frame2.Top = Me.ScaleHeight - Frame2.Height - 300
 Frame1.Width = Me.ScaleWidth - Frame2.Left - 120
 'Frame1.Top = Me.ScaleHeight - Frame2.Height - 300
 Grid1.Width = Frame2.Width - 240
 Grid5.Width = Frame1.Width - 240
XPPbr1.Move Frame2.Left, Me.ScaleHeight - XPPbr1.Height - 20, Frame2.Width, XPPbr1.Height
 '-------------grid5课程表的一些基本配置,包含第0行的内容,列宽等信息
Grid5.Visible = True
Grid5.Rows = nknumber + 1
For i = 1 To 7
Grid5.Column(i).Width = 103
Next
Grid5.RowHeight(0) = 18
Grid5.Column(0).Width = 107
Grid5.Rows = nknumber + 1
For i = 1 To nknumber
Grid5.RowHeight(i) = 30
Next
'以下在表格中填入一些固定内容
Grid5.Cell(0, 1).Text = "星期一"
Grid5.Cell(0, 2).Text = "星期二"
Grid5.Cell(0, 3).Text = "星期三"
Grid5.Cell(0, 4).Text = "星期四"
Grid5.Cell(0, 5).Text = "星期五"
Grid5.Cell(0, 6).Text = "星期六"
Grid5.Cell(0, 7).Text = "星期日"
'设置单元格格式
    Grid5.Range(0, 0, 0, 7).FontSize = 10
    With Grid5.Range(0, 0, Grid5.Rows - 1, Grid5.Cols - 1)
        .Alignment = cellCenterCenter '位置居中
        .BackColor = RGB(123, 124, 125)
        '.ForeColor = RGB(255, 252, 0)
        .WrapText = True '是否可自动换行
    End With
Grid5.BackColorBkg = RGB(148, 167, 178)
XPPbr1.Visible = False
 '以下是关于不是管理员的一些处理,即某些功能非管理员不可使用
 If admin = False Then
 XPButton2.Enabled = False
 XPButton4.Enabled = False
 XPButton1.Enabled = False
 XPButton6.Enabled = False
 savebutton.Enabled = False
 editbutton.Enabled = False
 delbutton.Enabled = False
 asPopup5.Enabled = False
 asPopup10.Enabled = False
 asPopup4.Enabled = False
 asPopup1.Enabled = False
 End If
 Set kc2 = cnn.Execute("select * from 教学时间段 order by 自动编号 asc")
 i = 1
 Do While Not kc2.EOF
 Grid5.Cell(i, 0).Text = kc2.Fields(0)
 i = i + 1
 If i > nknumber Then
 Exit Do
 End If
 kc2.MoveNext
 Loop
 Msgboxstr1 = "因已生成课表或公共教室已指定,为不可操作状态,请注销相关程序后在操作!"
 Exit Sub
finish:
MsgBox Err.Description
 End Sub
Private Sub kcmge()
On Error GoTo finish
'以下是将数据库表中的课程信息表中的所有内容全部写入表格
 kctable = "课程信息"
 numberkc = 8 '课程信息表字段的列数
 Grid1.AutoRedraw = False
 Set kc1 = cnn.Execute("select * from " & kctable & " where 所属班级='" & XPCombo1.Text & "' order by 每周课数 desc")
 '以上利用SQL查询数据库中所有对应的课程信息
 For i = 1 To numberkc
 Grid1.Cell(0, i).Text = kc1.Fields(i - 1).Name
 Next
 i = 1
 Grid1.Rows = 1
 Do While Not kc1.EOF
 Grid1.Rows = Grid1.Rows + 1 '每读取一条数据,就将表格的数量+1行
 For j = 1 To numberkc '设定读取列
 If Not kc1.Fields(j - 1) Is Nothing Then '空值的处理
  Grid1.Cell(i, j).Text = kc1.Fields(j - 1)
 Else
 Grid1.Cell(i, j).Text = ""
 End If
 Next
 kc1.MoveNext '读取下一记录
 i = i + 1
Loop
 Grid1.AutoRedraw = True
 Grid1.Refresh
Exit Sub
finish:
 Grid1.AutoRedraw = True
 Grid1.Refresh
MsgBox Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set kc1 = Nothing
Set kc2 = Nothing
Set kc3 = Nothing
cnn.Close
End Sub

Private Sub Grid1_CellChange(ByVal Row As Long, ByVal Col As Long)
On Error GoTo finish '这里主要验证快捷菜单,确定当前是否可以保存,修改,或删除
If kcsave = False Then
 savebutton.Enabled = False
Else
 savebutton.Enabled = True
End If
If kcedit = False Then
 editbutton.Enabled = False
Else
 editbutton.Enabled = True
End If
If kcdel = False Then
 delbutton.Enabled = False
Else
 delbutton.Enabled = True
End If
'以下代码是将总课数与每周课数相除,得出需要多少周来完成教学
If Grid1.Cell(Row, 2).Text <> "" And Grid1.Cell(Row, 3).Text <> "" And Row <> 0 Then
Grid1.Cell(Row, 4).Text = Int((Grid1.Cell(Row, 2).Text) / (Grid1.Cell(Row, 3).Text))
End If
Exit Sub
finish:
MsgBox Err.Description
End Sub

Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
On Error GoTo finish
hang = Row '这里主要是实时确定当前鼠标所在行
If Grid1.Cell(Row, 1).Text <> "" Then '通过每行填写的课程名来换取相对应的教师姓名
Grid1.ComboBox(5).Clear
Set kc2 = cnn.Execute("SELECT DISTINCT 教师姓名 FROM 课程名 where 课程名='" & Grid1.Cell(Row, 1).Text & "'")
Do While Not kc2.EOF
Grid1.ComboBox(5).AddItem kc2.Fields(0)
kc2.MoveNext
Loop
End If
Exit Sub
finish:
MsgBox Err.Description
End Sub

Private Sub Grid5_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If dkyesno = True And Button = 2 Then
PopupMenu dk '当按下鼠标右键时显示菜单dk
End If
End Sub

Private Sub Grid5_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang1 = Row ' 这里获取行和列的值,调课需要使用的
ne1 = Col
End Sub

Private Sub playwz_Click() '这里就是完成调课的功能按钮
If admin = False Then
MsgBox "非管理员不可执行此操作", vbInformation, "权限错误"
Exit Sub
End If
Dim y As Integer
If Grid5.Cell(hang1, ne1).BackColor <> RGB(255, 255, 255) Then
MsgBox "课程不可以调至此处"
Else
 Dim kcstr As String
  Dim str1, str2 As String
 kcstr = Grid5.Cell(jehang, jene).Text '以下是通过记忆将目标复制下来,以作后来修改之用
 Select Case jene
  Case 1
   str1 = "星期一"
  Case 2
   str1 = "星期二"
  Case 3
   str1 = "星期三"
  Case 4
   str1 = "星期四"
  Case 5
   str1 = "星期五"
  Case 6
   str1 = "星期六"
  Case 7
   str1 = "星期日"
 End Select
  For i = 1 To nknumber
  If Grid5.Cell(i, jene).Text = kcstr Then '做到清除并将资源占用情况修改
   Grid5.Cell(i, jene).Text = ""
      y = jene * nknumber - nknumber + i '计算行的位置
   Set kc2 = cnn.Execute("select 任课老师 from 课程信息 where 课程名='" & kcstr & "' and 所属班级='" & XPCombo1.Text & "'")
   '以上通过课程名来获取教师的姓名
   Set kc3 = cnn.Execute("select 占用 from 占用 where 教师姓名='" & kc2.Fields(0) & "'")
   '通过教师的姓名来获取该教师的资源占用情况
   str2 = Mid(kc3.Fields(0), 1, y - 1) & "0" & Mid(kc3.Fields(0), y + 1)
   '将改写的占用情况写入字符串str2
   Set kc3 = cnn.Execute("update 占用 set 占用='" & str2 & "' where 教师姓名='" & kc2.Fields(0) & "'")
   '将字符串str2写入占用中
   Set kc3 = cnn.Execute("select 占用 from 课程占用 where 班级='" & XPCombo1.Text & "'")
   str2 = Mid(kc3.Fields(0), 1, y - 1) & "0" & Mid(kc3.Fields(0), y + 1)
   Set kc3 = cnn.Execute("update 课程占用 set 占用='" & str2 & "' where 班级='" & XPCombo1.Text & "'")
   '这里同上
   Set kc3 = cnn.Execute("update 临时生成表 set " & str1 & "='' where 所属班级='" & XPCombo1.Text & "' and 时间段='" & Grid5.Cell(i, 0).Text & "'")
    End If
 Next
  Select Case ne1 '这里确定数据移动的新列位置
  Case 1
   str1 = "星期一"
  Case 2
   str1 = "星期二"
  Case 3
   str1 = "星期三"
  Case 4
   str1 = "星期四"
  Case 5
   str1 = "星期五"
  Case 6
   str1 = "星期六"
  Case 7
   str1 = "星期日"
 End Select
 y = ne1 * nknumber - nknumber + hang1
 '计算行的位置
 Grid5.Cell(hang1, ne1).Text = kcstr
 '将记忆的课程名写入新单元格
 Set kc2 = cnn.Execute("select 任课老师 from 课程信息 where 课程名='" & kcstr & "' and 所属班级='" & XPCombo1.Text & "'")
 Set kc3 = cnn.Execute("select 占用 from 占用 where 教师姓名='" & kc2.Fields(0) & "'")
 str2 = Mid(kc3.Fields(0), 1, y - 1) & "1" & Mid(kc3.Fields(0), y + 1)
 '通过查询课程得到教师姓名并取得资源占用情况,在此基础上作出修改
 If n = 2 Then
 Grid5.Cell(hang1 + 1, ne1).Text = kcstr
 str2 = Mid(kc3.Fields(0), 1, y - 1) & "11" & Mid(kc3.Fields(0), y + 2)
 End If
 Set kc3 = cnn.Execute("update 占用 set 占用='" & str2 & "' where 教师姓名='" & kc2.Fields(0) & "'")
 Set kc3 = cnn.Execute("select 占用 from 课程占用 where 班级='" & XPCombo1.Text & "'")
 str2 = Mid(kc3.Fields(0), 1, y - 1) & "1" & Mid(kc3.Fields(0), y + 1)
 If n = 2 Then
 str2 = Mid(kc3.Fields(0), 1, y - 1) & "11" & Mid(kc3.Fields(0), y + 2)
 End If
 Set kc3 = cnn.Execute("update 课程占用 set 占用='" & str2 & "' where 班级='" & XPCombo1.Text & "'")
 Set kc3 = cnn.Execute("update 临时生成表 set " & str1 & "='" & kcstr & "' where 所属班级='" & XPCombo1.Text & "' and 时间段='" & Grid5.Cell(hang1, 0).Text & "'")
 Set kc3 = cnn.Execute("update 临时生成表 set " & str1 & "='" & kcstr & "' where 所属班级='" & XPCombo1.Text & "' and 时间段='" & Grid5.Cell(hang1 + 1, 0).Text & "'")
Grid5.Range(0, 0, Grid5.Rows - 1, Grid5.Cols - 1).BackColor = RGB(148, 167, 178)
'以上就是通过在次写入占用的形式改写教师的资源占用情况,并将修改后的背景还原回来
End If
End Sub

Private Sub savebutton_Click() '保存课程资料
If XPCombo1.Text = "" Then
MsgBox "班级名称不可为空，请选择班级", vbInformation, "提示"
End If
word_validate
If vde = False Then
 MsgBox Msgboxstr1, vbInformation, "提示"
 Exit Sub
End If
If kcsave = False Then
MsgBox "当前不允许保存！", vbInformation, "提示"
Exit Sub
End If
For i = 1 To Grid1.Rows - 1 '处理重名数据
 If Grid1.Cell(i, 1).Text <> "" Then
 Set kc1 = cnn.Execute("select 课程名 from 课程信息 where 课程名='" & Grid1.Cell(i, 1).Text & "' and 所属班级='" & XPCombo1.Text & "'")
 If kc1.EOF = False Then
   MsgBox "第" & i & "行的课程名在数据库里出现重复，请检查", vbInformation, "错误"
   Grid1.Cell(i, 1).SetFocus
   Exit Sub
 End If
 End If
Next
For i = 1 To Grid1.Rows - 1
  For n = 1 To Grid1.Cols - 1
    Select Case n
       Case 1, 2, 3, 4, 5, 7, 8 '检查数据是否为空
         If Grid1.Cell(i, 1).Text <> "" Then
          If Grid1.Cell(i, n).Text = "" Then
            MsgBox "第" & i & "行的--[" & Grid1.Cell(0, n).Text & "]--字段不允许为空!", vbInformation, "提示"
            Grid1.Cell(i, n).SetFocus
            Exit Sub
          End If
          If Val(Grid1.Cell(i, 3).Text) < 2 And Grid1.Cell(i, 6).Text = "1" Then
            MsgBox "第" & i & "行的每周课数无法实现两节课连排!", vbInformation, "提示"
          Exit Sub
          End If
          ElseIf i = 1 Then
          MsgBox "无任何数据可保存", vbInformation, "排课系统"
          Exit Sub
          End If
    End Select
    Next
  If Grid1.Cell(i, 1).Text <> "" Then '执行插入语句
  sql = "insert into 课程信息 values('"