📄 main.frm
字号:
Height = 375
Left = 240
TabIndex = 20
Top = 3480
Width = 1455
End
Begin VB.CommandButton XPButton3
Caption = "所有课程"
Height = 375
Left = 240
TabIndex = 19
Top = 2880
Width = 1455
End
Begin VB.CommandButton XPButton2
BackColor = &H00C0C0FF&
Caption = "生成课表"
Height = 375
Left = 240
TabIndex = 18
Top = 1680
Width = 1455
End
End
Begin VB.PictureBox Picmenu_qg
BackColor = &H00404040&
Height = 375
Index = 2
Left = 0
ScaleHeight = 315
ScaleWidth = 1995
TabIndex = 7
Top = 3240
Visible = 0 'False
Width = 2055
Begin VB.CommandButton XPButton5
Caption = "输出到EXECL"
Height = 375
Left = 240
TabIndex = 29
Top = 840
Width = 1335
End
Begin VB.CommandButton XPButton7
Caption = "报表输出"
Height = 375
Left = 240
TabIndex = 28
Top = 240
Width = 1335
End
End
Begin VB.PictureBox Picmenu_qg
BackColor = &H00404040&
Height = 375
Index = 3
Left = 0
ScaleHeight = 315
ScaleWidth = 1995
TabIndex = 6
Top = 8040
Visible = 0 'False
Width = 2055
Begin as97Popup.asPopup asPopup7
Height = 855
Left = 360
ToolTipText = "清空系统内所有数据"
Top = 2520
Width = 1095
_ExtentX = 1931
_ExtentY = 1508
CustomPicture = "main.frx":1DC8E
Caption = "系统初始化"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = 12632319
BevelWidth = 0
Layout = 3
MouseOverColor = 16777215
ScaleWidth = 73
ScaleMode = 0
ScaleHeight = 57
BackStyle = 0
Object.ToolTipText = "清空系统内所有数据"
End
Begin as97Popup.asPopup asPopup5
Height = 855
Left = 360
ToolTipText = "清空已利用的资源"
Top = 1440
Width = 1095
_ExtentX = 1931
_ExtentY = 1508
CustomPicture = "main.frx":225B8
Caption = "资源初始化"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = 12632319
BevelWidth = 0
Layout = 3
MouseOverColor = 16777215
ScaleWidth = 73
ScaleMode = 0
ScaleHeight = 57
BackStyle = 0
Object.ToolTipText = "清空已利用的资源"
End
Begin as97Popup.asPopup asPopup1
Height = 855
Left = 360
ToolTipText = "管理用户登陆"
Top = 360
Width = 1095
_ExtentX = 1931
_ExtentY = 1508
CustomPicture = "main.frx":270D7
Caption = "用户管理"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = 12632319
BevelWidth = 0
Layout = 3
MouseOverColor = 16777215
ScaleWidth = 73
ScaleMode = 0
ScaleHeight = 57
BackStyle = 0
Object.ToolTipText = "管理用户登陆"
End
End
Begin VB.PictureBox Picmenu_qg
BackColor = &H00404040&
Height = 495
Index = 4
Left = 0
ScaleHeight = 435
ScaleWidth = 1995
TabIndex = 5
Top = 8400
Visible = 0 'False
Width = 2055
Begin as97Popup.asPopup asPopup3
Height = 855
Left = 360
ToolTipText = "离开系统"
Top = 240
Width = 1095
_ExtentX = 1931
_ExtentY = 1508
CustomPicture = "main.frx":2BBF7
Caption = "离开系统"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = 12632319
BevelWidth = 0
Layout = 3
MouseOverColor = 16777215
ScaleWidth = 73
ScaleMode = 0
ScaleHeight = 57
BackStyle = 0
Object.ToolTipText = "离开系统"
End
End
End
Begin VB.Frame Frame1
Caption = "课程表生成信息"
Height = 4335
Left = 2280
TabIndex = 2
Top = 120
Width = 10215
Begin FlexCell.Grid Grid5
Height = 3890
Left = 120
TabIndex = 3
Top = 240
Width = 10020
_ExtentX = 17674
_ExtentY = 6853
AllowUserResizing= 0 'False
Appearance = 0
Cols = 8
FixedRowColStyle= 0
GridColor = 0
Rows = 7
ScrollBars = 0
End
End
Begin FlexCell.Grid Grid4
Height = 6495
Left = -300
TabIndex = 0
Top = 240
Width = 240
_ExtentX = 423
_ExtentY = 11456
Appearance = 0
Cols = 2
Rows = 1
ScrollBars = 0
End
Begin 排课系统.XPCombo XPCombo1
Height = 315
Left = 6000
TabIndex = 1
Top = 4755
Width = 1815
_ExtentX = 3201
_ExtentY = 556
Text = ""
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin ACTIVESKINLibCtl.Skin PKSkn
Left = 0
OleObjectBlob = "main.frx":305D5
Top = 0
End
Begin MSComctlLib.ProgressBar XPPbr1
Height = 255
Left = 2040
TabIndex = 30
Top = 4200
Width = 3975
_ExtentX = 7011
_ExtentY = 450
_Version = 393216
Appearance = 1
End
Begin VB.Menu dk
Caption = "调课"
Visible = 0 'False
Begin VB.Menu qqdk
Caption = "请求调课"
Begin VB.Menu finddkd
Caption = "查找当前课程可调点"
End
Begin VB.Menu playwz
Caption = "课程调到此位置"
End
Begin VB.Menu Canceldk
Caption = "取消本次调课"
End
End
End
End
Attribute VB_Name = "formmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Classprint As New OpenRs '定义打印记录集
Dim xlApp As New Excel.Application
Dim sendsql As String
Dim array1(0 To 100) As String
Dim array2(0 To 100) As String
Dim array3(0 To 100) As String
Dim array_long As Integer '数组需求长度
Dim InsertStr As String '保存相应的课表空间
Dim insertInt As Integer '保存相应的空间数
Public je As Integer '记忆菜单上次数值，实现数据传送
Private Sub StatIIE() '统计空间需求-初始化
'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 StatACC() '统计空间-计算
'On Error GoTo finish
Dim k As Integer
For i = 1 To array_long Step n '通过对比对教师与班级之间的可以排课点进行规纳
If i + 1 >= array_long Then
Set kc1 = cnn.Execute("insert into 空间明细 values('" & Grid1.Cell(hang, 1).Text & "'," & insertInt & ",'" & InsertStr & "')")
insertInt = 0
InsertStr = ""
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
insertInt = insertInt + 1
InsertStr = InsertStr & i & ";"
End If
Else
insertInt = insertInt + 1
InsertStr = InsertStr & i & ";"
End If
End If
End If
Next
End If
Next
'finish:
'MsgBox Err.Description
End Sub
Private Sub gridcs() '对grid所需求进行初始化
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -