form2.frm

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

VERSION 5.00
Object = "{DAAC6951-59A4-4C08-9D6E-FE3919B64861}#1.0#0"; "FlexCell.ocx"
Object = "{74848F95-A02A-4286-AF0C-A3C755E4A5B3}#1.0#0"; "actskn43.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form Form2 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "公共教室指定"
   ClientHeight    =   6105
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   10020
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6105
   ScaleWidth      =   10020
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Picture1 
      Height          =   340
      Left            =   0
      ScaleHeight     =   285
      ScaleWidth      =   10035
      TabIndex        =   3
      Top             =   3200
      Width           =   10095
      Begin MSComctlLib.Toolbar Toolbar1 
         Height          =   330
         Left            =   0
         TabIndex        =   4
         Top             =   0
         Width           =   10020
         _ExtentX        =   17674
         _ExtentY        =   582
         ButtonWidth     =   1984
         ButtonHeight    =   582
         Appearance      =   1
         Style           =   1
         TextAlignment   =   1
         _Version        =   393216
         BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
            NumButtons      =   3
            BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Caption         =   "提交指定"
               Key             =   "提交指定"
            EndProperty
            BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Caption         =   "注销指定"
               Key             =   "注销指定"
            EndProperty
            BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Caption         =   "回主界面"
               Key             =   "回主界面"
            EndProperty
         EndProperty
      End
   End
   Begin FlexCell.Grid Grid1 
      Height          =   3135
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   10020
      _ExtentX        =   17674
      _ExtentY        =   5530
      AllowUserResizing=   0   'False
      Appearance      =   0
      BackColorFixed  =   8421504
      BackColorFixedSel=   8421504
      Cols            =   10
      DisplayRowIndex =   -1  'True
      FixedRowColStyle=   0
      GridColor       =   0
      Rows            =   7
      ScrollBars      =   0
   End
   Begin FlexCell.Grid Grid4 
      Height          =   6495
      Left            =   -1000
      TabIndex        =   1
      Top             =   0
      Width           =   240
      _ExtentX        =   423
      _ExtentY        =   11456
      Appearance      =   0
      Cols            =   2
      Rows            =   1
      ScrollBars      =   0
   End
   Begin FlexCell.Grid Grid2 
      Height          =   1905
      Left            =   6255
      TabIndex        =   2
      Top             =   3650
      Width           =   3765
      _ExtentX        =   6641
      _ExtentY        =   3360
      Appearance      =   0
      BackColorBkg    =   16777215
      Cols            =   8
      DisplayRowIndex =   -1  'True
      FixedRowColStyle=   0
      GridColor       =   8421504
      ReadOnly        =   -1  'True
      Rows            =   30
      ScrollBars      =   0
   End
   Begin RichTextLib.RichTextBox txtRecive 
      Height          =   1900
      Left            =   0
      TabIndex        =   5
      Top             =   3645
      Width           =   6255
      _ExtentX        =   11033
      _ExtentY        =   3360
      _Version        =   393217
      BackColor       =   4210752
      BorderStyle     =   0
      Enabled         =   0   'False
      ReadOnly        =   -1  'True
      ScrollBars      =   2
      Appearance      =   0
      TextRTF         =   $"Form2.frx":0000
   End
   Begin ACTIVESKINLibCtl.Skin PKSkn 
      Left            =   0
      OleObjectBlob   =   "Form2.frx":009D
      Top             =   0
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim newstart As Long '索引行数
Dim CNumber As Integer '选定的自定义课数choosenumber
Dim array_long As Integer
Dim XY_X As Integer
Dim XY_Y As Integer
Dim XY_N As Integer '编号
Dim array1(0 To 100) As String
Dim array2(0 To 100) As String
Dim array3(0 To 100) As String
Dim ErrorN As Boolean
Private Declare Sub ReleaseCapture Lib "user32" () '支持移动API
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Sub Form_Load()
'Grid1.Column(0).Width = 0
pkskn.LoadSkin App.Path & "\chizh.skn"
pkskn.ApplySkinByName hWnd, "窗体"
pkskn.ApplySkin hWnd
With Grid1
.Range(0, 0, .Rows - 1, .Cols - 1).BackColor = RGB(123, 124, 125)
.Range(0, 0, .Rows - 1, .Cols - 1).ForeColor = RGB(255, 255, 255)
.Cell(0, 1).Text = "教室名称"
.Cell(0, 2).Text = "班级"
.Cell(0, 3).Text = "教师"
.Cell(0, 4).Text = "课程名"
.Cell(0, 5).Text = "课节数"
.Cell(0, 6).Text = "两节累排"
.Cell(0, 7).Text = "课程分布"
.Cell(0, 8).Text = "生成模式"
.Cell(0, 9).Text = "位置"
.Column(1).Width = 68
.Column(2).Width = 87
.Column(3).Width = 60
.Column(4).Width = 80
.Column(5).Width = 40
.Column(6).Width = 50
.Column(7).Width = 63
.Column(8).Width = 60

.Column(6).CellType = cellCheckBox
.Column(8).CellType = cellComboBox
.Column(9).CellType = cellComboBox
.ComboBox(8).AddItem "系统生成"
.ComboBox(8).AddItem "关联指定"
.ComboBox(8).AddItem "手动指定"
End With
With Grid2
.Rows = nknumber + 1
'.Range(0, 0, .Rows - 1, .Cols - 1).BackColor = RGB(123, 124, 125)
.Range(0, 0, .Rows - 1, .Cols - 1).ForeColor = vbBlack
For i = 1 To .Cols - 1
.Column(i).Width = 30
Next
Select Case nknumber
Case 6
 .Height = 1910
Case 7
 .Height = 2175
Case 8
 .Height = 2445
End Select
.AllowUserResizing = False
.Range(1, 1, .Rows - 1, .Cols - 1).Alignment = cellCenterCenter
.Cell(0, 1).Text = "一"
.Cell(0, 2).Text = "二"
.Cell(0, 3).Text = "三"
.Cell(0, 4).Text = "四"
.Cell(0, 5).Text = "五"
.Cell(0, 6).Text = "六"
.Cell(0, 7).Text = "七"
For i = 1 To .Rows - 1
 For j = 1 To .Cols - 1
  .Cell(i, j).Text = "×"
 Next
Next
End With
ShowDATA ' 显示对应的数据
txtRecive.Height = Grid2.Height
TEXTCOLOR_Start
txtRecive.SelText = "注：右边的[×]号为不可选项，已被别的课程占用或不满足需求" & vbCrLf
txtRecive.SelText = txtRecive.SelText & "注：右边的[--]号为可选项，未被占用" & vbCrLf
txtRecive.SelText = txtRecive.SelText & "注：右边的[√]号为已选项，已被本课程选用" & vbCrLf
TEXTCOLOR2_End
End Sub
Private Sub ShowDATA()
Dim Strsql As String
If formmain.XPCombo1.Text = "" Then
MsgBox "未选定班级"
Exit Sub
End If
Set kc1 = cnn.Execute("select 教室选择,所属班级,任课老师,课程名,每周课数,两节课累排,课程分布 from 课程信息 where 所属班级='" & formmain.XPCombo1.Text & "' and 教室选择<>'" & "默认" & "'")
If kc1.EOF = True Then
MsgBox "无公共教室需要指定"
Exit Sub
End If
Grid1.Rows = 1
Do While Not kc1.EOF
Grid1.Rows = Grid1.Rows + 1
 For i = 1 To kc1.Fields.Count
 Grid1.Cell(Grid1.Rows - 1, i).Text = kc1.Fields(i - 1)
 Next
kc1.MoveNext
Loop
For i = 1 To Grid1.Rows - 1
 Strsql = "select * from 公共教室指定 where "
 For j = 1 To 3
  Strsql = Strsql & Grid1.Cell(0, j).Text & "='" & Grid1.Cell(i, j).Text & "' and "
 Next
  Strsql = Strsql & Grid1.Cell(0, j).Text & "='" & Grid1.Cell(i, j).Text & "'"
 Set kc2 = cnn.Execute(Strsql)
 If kc2.EOF = False Then
  Grid1.Cell(i, Grid1.Cols - 2).Text = "已指定"
  Grid1.Cell(i, Grid1.Cols - 1).Text = kc2.Fields(kc2.Fields.Count - 1)
 End If
Next
With Grid1 '这里设置图表控件grid1的一些参数
    .AllowUserResizing = True '是否可调整行和例
    .DisplayFocusRect = False '当前活动单元格是否显示一个虚框
    .ExtendLastCol = True '是否让表格充满控件
    .Appearance = Flat '选择绘图风格，平面还是3D
    .FixedRowColStyle = Flat '固定行/列的样式
    .ScrollBarStyle = Flat '滚动条的样式
    '以上几个都是关于grid1的美化设置，都是一些无关紧要的设置
End With
For i = 1 To 9
 Grid1.Column(i).Locked = True
Next
If Grid1.Cell(0, 8).Text <> "已指定" Then
 Grid1.Column(8).Locked = False
 Grid1.Column(9).Locked = False
End If
End Sub
Private Sub SystemAPP2(ByVal iik As Long) '生成资源的主过程2
Set kc2 = cnn.Execute("select 课程分布 from 课程信息 where 所属班级='" & Grid1.Cell(iik, 2).Text & "' and 课程名='" & Grid1.Cell(iik, 4).Text & "'")
Select Case kc2.Fields(0)
 Case "周一至周五"
   array_long = 5 * nknumber
 Case "周一至周六"
   array_long = 6 * nknumber
 Case "周一至周日"
   array_long = 7 * nknumber
End Select
Set kc2 = cnn.Execute("select 占用 from 占用 where 教师姓名='" & Grid1.Cell(iik, 3).Text & "'")
For i = 1 To 7 * nknumber
array1(i) = Mid(kc2.Fields(0), i, 1)
Next
Set kc2 = cnn.Execute("select 占用 from 课程占用 where 班级='" & Grid1.Cell(iik, 2).Text & "'")
For i = 1 To 7 * nknumber
array2(i) = Mid(kc2.Fields(0), i, 1)
Next
Set kc2 = cnn.Execute("select 占用 from 公共教室 where 教室名称='" & Grid1.Cell(iik, 1).Text & "'")
For i = 1 To 7 * nknumber
array3(i) = Mid(kc2.Fields(0), i, 1)
Next
''''''''''''''''
Grid4.Rows = 1
For i = 1 To array_long Step n '通过对比对教师与班级之间的可以排课点进行规纳
  If i + 1 > array_long Then
  Exit For
  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
  If array1(i) = "0" And array2(i) = "0" And array3(i) = "0" Then
   '以下保证得到的结果不是同一天
    If Grid1.Cell(iik, Grid1.Cols - 1).Text <> "" Then
     str1 = Split(Grid1.Cell(iik, Grid1.Cols - 1).Text, ",")
     'imk表示循环变量
     For imk = 0 To UBound(str1)
        x = Round(Int(str1(imk)) / nknumber)
        If x < Int(str1(imk)) / nknumber Then
           x = x + 1
        End If
        y = Round(i / nknumber)
        If y < i / nknumber Then
           y = y + 1
        End If
        If x = y Then
          Exit For
        End If
        If imk = UBound(str1) Then
         Grid4.Rows = Grid4.Rows + 1
         Grid4.Cell(Grid4.Rows - 1, 1).Text = i
        End If
    Next
    Else
     Grid4.Rows = Grid4.Rows + 1
     Grid4.Cell(Grid4.Rows - 1, 1).Text = i
    End If
  End If
 Next