📄 main.frm
字号:
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = 12582912
BevelWidth = 0
Layout = 3
MouseOverColor = 16777215
ScaleWidth = 73
ScaleMode = 0
ScaleHeight = 57
BackStyle = 0
Object.ToolTipText = "查看销售记录"
End
Begin as97Popup.asPopup asPopup1
Height = 855
Left = 10875
ToolTipText = "查看销售记录"
Top = 6600
Width = 1095
_ExtentX = 1931
_ExtentY = 1508
CustomPicture = "main.frx":47BB7
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 = 12582912
BevelWidth = 0
Layout = 3
MouseOverColor = 16777215
ScaleWidth = 73
ScaleMode = 0
ScaleHeight = 57
BackStyle = 0
Object.ToolTipText = "查看销售记录"
End
Begin as97Popup.asPopup asPopup2
Height = 855
Left = 10875
ToolTipText = "查看销售记录"
Top = 5520
Width = 1095
_ExtentX = 1931
_ExtentY = 1508
CustomPicture = "main.frx":4C6D7
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 = 12582912
BevelWidth = 0
Layout = 3
MouseOverColor = 16777215
ScaleWidth = 73
ScaleMode = 0
ScaleHeight = 57
BackStyle = 0
Object.ToolTipText = "查看销售记录"
End
Begin as97Popup.asPopup asPopup3
Height = 855
Left = 10875
ToolTipText = "查看销售记录"
Top = 7680
Width = 1095
_ExtentX = 1931
_ExtentY = 1508
CustomPicture = "main.frx":51077
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 = 12582912
BevelWidth = 0
Layout = 3
MouseOverColor = 16777215
ScaleWidth = 73
ScaleMode = 0
ScaleHeight = 57
BackStyle = 0
Object.ToolTipText = "查看销售记录"
End
Begin as97Popup.asPopup asPopup5
Height = 855
Left = 10875
ToolTipText = "查看销售记录"
Top = 240
Width = 1095
_ExtentX = 1931
_ExtentY = 1508
CustomPicture = "main.frx":55A55
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 = 12582912
BevelWidth = 0
Layout = 3
MouseOverColor = 16777215
ScaleWidth = 73
ScaleMode = 0
ScaleHeight = 57
BackStyle = 0
Object.ToolTipText = "查看销售记录"
End
Begin 排课系统.XPCombo XPCombo1
Height = 315
Left = 2280
TabIndex = 17
Top = 8310
Width = 1815
_extentx = 3201
_extenty = 556
text = ""
font = "main.frx":5A574
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = $"main.frx":5A598
ForeColor = &H00000000&
Height = 615
Left = 0
TabIndex = 19
Top = 7680
Width = 9975
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "班级名称："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Left = 1320
TabIndex = 18
Top = 8340
Width = 1215
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
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
Private Sub asPopup1_Click(Cancel As Boolean)
kctable = "登陆"
Form6.Caption = "用户管理"
Form6.Show 1
End Sub
Private Sub asPopup10_Click(Cancel As Boolean)
kctable = "班级名称"
Form6.Caption = "班级管理"
Form6.Show 1
End Sub
Private Sub asPopup2_Click(Cancel As Boolean)
kctable = "教学时间段"
Form5.Caption = "教学时间段设置"
Form5.Show 1
End Sub
Private Sub asPopup3_Click(Cancel As Boolean)
End
End Sub
Private Sub asPopup4_Click(Cancel As Boolean)
kctable = "课程名"
Form5.Caption = "课程管理"
Form5.Show 1
End Sub
Private Sub asPopup5_Click(Cancel As Boolean)
Dim vyes As String
vyes = MsgBox("当系统出现排课错误时进行的完全还原操作,确定吗？", vbQuestion + vbYesNo, "提示")
If vyes = vbYes Then
Set kc2 = cnn.Execute("update 占用 set 占用='000000000000000000000000000000000000000000'")
Set kc2 = cnn.Execute("update 课程占用 set 占用='000000000000000000000000000000000000000000'")
End If
End Sub
Private Sub delbutton_Click()
On Error GoTo finish
If XPCombo1.Text = "" Then
MsgBox "班级名称不可为空，请选择班级", vbInformation, "提示"
End If
word_validate
If vde = False Then
MsgBox "因已生成课程表，为不可操作状态，请注销现有的课程表在进行操作！", vbInformation, "提示"
Exit Sub
End If
If kcdel = False Then
MsgBox "当前删除操作不被允许!", vbInformation, "非使用对象"
Exit Sub
End If
If hang = 0 Then
Exit Sub
End If
Dim delok As String
If Grid1.Cell(hang, 1).Text = "" Then
Exit Sub
End If
delok = MsgBox("确认删除课程名为" & Grid1.Cell(hang, 1).Text & "的数据吗？？", vbQuestion + vbOKCancel, "注意:此操作将会将学生资料与成绩资料完全清除")
If delok = vbOK Then
sql = "delete from 课程信息 where " & kc1.Fields(0).Name & "='" & Grid1.Cell(hang, 1).Text & "' and 所属班级='" & XPCombo1.Text & "'"
Set kc2 = cnn.Execute(sql)
MsgBox "目标己删除完成!", , "提示"
Call XPButton3_Click
End If
Exit Sub
finish:
MsgBox Err.Description
End Sub
Private Sub editbutton_Click()
On Error GoTo finish
If XPCombo1.Text = "" Then
MsgBox "班级名称不可为空，请选择班级", vbInformation, "提示"
End If
word_validate
If vde = False Then
MsgBox "因已生成课程表，为不可操作状态，请注销现有的课程表在进行操作！", vbInformation, "提示"
Exit Sub
End If
If kcedit = False Then
MsgBox "当前修改操作不被允许!", vbInformation, "非使用对象"
Exit Sub
End If
Dim delok As String
delok = MsgBox("确认修改刚才修改的所有数据吗？？", vbQuestion + vbOKCancel, "提示")
If delok = vbOK Then
hang = 1
Do While hang <= Grid1.Rows - 1
If Grid1.Cell(hang, 1).Text = "" Then
MsgBox "己完成修改操作!", , "提示"
Exit Sub
End If
If Grid1.Cell(hang, 3).Text < "2" And Grid1.Cell(hang, 6).Text = "1" Then
MsgBox "第" & hang & "行的每周课数无法实现两节课连排!", vbInformation, "提示"
Exit Sub
End If
sql = "update 课程信息 set "
For j = 1 To Grid1.Cols - 2
sql = sql & kc1.Fields(j - 1).Name & "='" & Grid1.Cell(hang, j).Text & "',"
Next
sql = sql & kc1.Fields(j - 1).Name & "='" & Grid1.Cell(hang, j).Text & "' where " & kc1.Fields(0).Name & "='" & Grid1.Cell(hang, 1).Text & "' and 所属班级='" & XPCombo1.Text & "'"
Set kc2 = cnn.Execute(sql) '用kc2更新数据集,这样可实现批量更新
hang = hang + 1
Loop
MsgBox "己完成修改操作!", , "提示"
Call XPButton3_Click
End If
Exit Sub
finish:
MsgBox Err.Description
End Sub
Function word_validate() '权限验证，主要验证用户是否能执行输入等操作
Set kc2 = cnn.Execute("select count(所属班级) from 临时生成表 where 所属班级='" & XPCombo1.Text & "'")
If kc2.Fields(0) = 0 Then
vde = True
Else
vde = False
End If
End Function
Private Sub finddkd_Click()
MsgBox "执行此处请参照完整版EXE程序"
End Sub
Private Sub Form_Load()
On Error GoTo finish
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册
Grid1.AllowUserResizing = True
Grid1.DisplayFocusRect = False
Grid1.ExtendLastCol = True
Grid1.Appearance = Flat
Grid1.FixedRowColStyle = Flat
Grid1.ScrollBarStyle = Flat
Grid1.DefaultFont.Name = "Tahoma"
Grid1.DefaultFont.Size = 8
Grid1.BackColorFixed = RGB(148, 167, 178)
Grid1.BackColorFixedSel = RGB(148, 167, 178)
Grid1.BackColorBkg = RGB(148, 167, 178)
Grid1.BackColorScrollBar = RGB(148, 167, 178)
Grid1.BackColor1 = RGB(148, 167, 178)
Grid1.BackColor2 = RGB(148, 167, 178)
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 = 187
XPCombo1.Clear
Set kc2 = cnn.Execute("select 班级名称 from 班级名称")
Do While Not kc2.EOF
XPCombo1.AddItem kc2.Fields(0)
kc2.MoveNext
Loop
Grid1.Visible = False
Grid1.Column(4).Locked = True
'---------------------
grid2pz
grid3pz
Grid4.RowHeight(0) = 0
Grid4.Column(0).Width = 0
Grid4.Column(1).Width = 20
'-------------grid5课程表
Grid5.Visible = True
For i = 1 To 7
Grid5.Column(i).Width = 80
Grid5.RowHeight(0) = 18
Next
Grid5.Column(0).Width = 107
For i = 1 To 6
Grid5.RowHeight(i) = 18
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(148, 167, 178)
'.ForeColor = RGB(255, 252, 0)
.WrapText = True '是否可自动换行
End With
Grid5.BackColorBkg = RGB(148, 167, 178)
Set kc2 = cnn.Execute("select * from 教学时间段 order by 自动编号 asc")
i = 1
If kc2.EOF = True Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -