📄 form6.frm
字号:
VERSION 5.00
Object = "{DAAC6951-59A4-4C08-9D6E-FE3919B64861}#1.0#0"; "FlexCell.ocx"
Object = "{CFA7AFF4-3242-4269-9172-7389D695AE01}#1.0#0"; "StoneXP.ocx"
Begin VB.Form Form6
BorderStyle = 0 'None
Caption = "班级管理"
ClientHeight = 5025
ClientLeft = 0
ClientTop = 0
ClientWidth = 5760
Icon = "Form6.frx":0000
LinkTopic = "Form6"
MaxButton = 0 'False
ScaleHeight = 5025
ScaleWidth = 5760
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin FlexCell.Grid Grid1
Height = 4215
Left = 0
TabIndex = 5
Top = 0
Width = 5775
_ExtentX = 10186
_ExtentY = 7435
Appearance = 0
Cols = 5
Rows = 30
End
Begin StoneXP.XPButton XPButton1
Height = 375
Left = 480
TabIndex = 1
Top = 4560
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "增 加"
MouseIcon = "Form6.frx":F84A
MousePointer = 99
End
Begin StoneXP.XPButton XPButton2
Height = 375
Left = 1440
TabIndex = 2
Top = 4560
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "保 存"
MouseIcon = "Form6.frx":FB64
MousePointer = 99
End
Begin StoneXP.XPButton XPButton3
Height = 375
Left = 2400
TabIndex = 3
Top = 4560
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "修 改"
MouseIcon = "Form6.frx":FE7E
MousePointer = 99
End
Begin StoneXP.XPButton XPButton4
Height = 375
Left = 3360
TabIndex = 4
Top = 4560
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "删 除"
MouseIcon = "Form6.frx":10198
MousePointer = 99
End
Begin StoneXP.XPButton XPButton5
Height = 375
Left = 4320
TabIndex = 0
Top = 4560
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "退 出"
MouseIcon = "Form6.frx":104B2
MousePointer = 99
End
Begin VB.Menu cz
Caption = "操作"
Visible = 0 'False
Begin VB.Menu renovate
Caption = "刷新"
End
End
End
Attribute VB_Name = "Form6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i, n As Integer
Private Declare Function GetKeyState Lib "user32" _
(ByVal nVirtKey As Long) As Integer
Private Sub Form_Load()
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册
With Grid1
.AllowUserResizing = True
.DisplayFocusRect = False
.ExtendLastCol = True
.Appearance = Flat
.FixedRowColStyle = Flat
.ScrollBarStyle = Flat
.DefaultFont.Name = "Tahoma"
.DefaultFont.Size = 8
.BackColorFixed = RGB(90, 158, 214)
.BackColorFixedSel = RGB(110, 180, 230)
.BackColorBkg = RGB(90, 158, 214)
.BackColorScrollBar = RGB(231, 235, 247)
.BackColor1 = RGB(231, 235, 247)
.BackColor2 = RGB(239, 243, 255)
.GridColor = RGB(148, 190, 231)
.Column(0).Width = 0
.Column(1).Width = 100
.Column(2).Width = 100
.Column(3).Width = 100
End With
If kctable = "班级名称" Then
MsgBox "请尽量不要修改和删除班级名称，否则可能会造成资源浪费！", vbInformation, "友情提示"
End If
Call callmain
End Sub
Private Sub callmain()
kcsave = False
kcedit = True
kcdel = True
Set kc1 = cnn.Execute("select * from " & kctable)
Select Case kctable
Case "班级名称"
Grid1.Rows = 1 '清除所有记录
i = 3
Case "登陆"
Grid1.Column(3).CellType = cellComboBox
Grid1.ComboBox(3).Clear
Grid1.ComboBox(3).AddItem "超级管理员"
Grid1.ComboBox(3).AddItem "一般用户"
Grid1.Rows = 1 '清除所有记录
i = 3
End Select
Grid1.Cols = i + 1 '必须+1,因为实际上为4行,但第一行是隐藏的
For i = 0 To i - 1 '显示数据的字段名
Grid1.Cell(0, i + 1).Text = kc1.Fields(i).Name '读取表中的各字段名
Next
n = i
i = 1
Do While Not kc1.EOF
Grid1.Rows = Grid1.Rows + 1
For j = 1 To n '设定读取列
If kc1.Fields(j - 1) = Null Then '空值的处理
Grid1.Cell(i, j).Text = ""
Else
Grid1.Cell(i, j).Text = kc1.Fields(j - 1)
End If
Next
i = i + 1
kc1.MoveNext '读取下一记录
Loop
Grid1.Column(1).Locked = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call XPButton5_Click
End Sub
Private Sub Grid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu cz
End If
End Sub
Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
End Sub
Private Sub Grid1_Validate(Cancel As Boolean) '设定TAB键切换
Dim nActiveRow As Long, nActiveCol As Long
Const VK_TAB = 9
If GetKeyState(VK_TAB) < 0 Then
nActiveRow = Grid1.ActiveCell.Row
nActiveCol = Grid1.ActiveCell.Col
If nActiveCol < Grid1.Cols - 1 Then
Grid1.Range(nActiveRow, nActiveCol + 1, _
nActiveRow, nActiveCol + 1).Selected
End If
Cancel = True
End If
End Sub
Private Sub renovate_Click()
Call callmain
End Sub
Private Sub XPButton1_Click()
kcsave = True
kcedit = False
kcdel = False
Set kc1 = cnn.Execute("select * from " & kctable)
Grid1.Rows = 1 '清除所有记录
Grid1.Rows = 2 '默认为2行
For i = 0 To 2 '显示数据的字段名
Grid1.Cell(0, i + 1).Text = kc1.Fields(i).Name '读取表中的各字段名
Next
Grid1.Column(1).Locked = False
Grid1.Cell(1, 1).SetFocus
End Sub
Private Sub XPButton2_Click()
If kcsave = False Then
MsgBox "不支持保存操作！", vbInformation, "当前不支持"
Exit Sub
End If
If Grid1.Cell(1, 1).Text <> "" Then
Set kc1 = cnn.Execute("select * from " & kctable & " where " & kc1.Fields(0).Name & "='" & Grid1.Cell(1, 1).Text & "'")
If kc1.EOF = True Then
Set kc1 = cnn.Execute("insert into " & kctable & " values('" & Grid1.Cell(1, 1).Text & "','" & Grid1.Cell(1, 2).Text & "','" & Grid1.Cell(1, 3).Text & "')")
'--------------------
If kctable = "班级名称" Then
Dim num As Integer
num = 7 * nknumber
For i = 1 To num
sql = sql & "0"
Next
Set kc2 = cnn.Execute("insert into 课程占用 values('" & Grid1.Cell(1, 1).Text & "','" & sql & "')")
End If
formmain.XPCombo1.Clear
Set kc2 = cnn.Execute("select 班级名称 from 班级名称")
Do While Not kc2.EOF
formmain.XPCombo1.AddItem kc2.Fields(0)
kc2.MoveNext
Loop
'---------------------
MsgBox "提交成功！", vbInformation, ""
Call callmain
Else
MsgBox "该名称名己存在！", vbInformation, "不可重名"
Exit Sub
End If
Else
MsgBox "对象不可以是空格", vbInformation, "错误提示"
End If
End Sub
Private Sub XPButton3_Click()
If kcedit = False Then
MsgBox "当前修改操作不被允许!", vbInformation, "非使用对象"
Exit Sub
End If
For i = 1 To Grid1.Rows - 1
Set kc1 = cnn.Execute("update " & kctable & " set " & kc1.Fields(1).Name & "='" & Grid1.Cell(i, 2).Text & "'," & kc1.Fields(2).Name & "='" & Grid1.Cell(i, 3).Text & "' where " & kc1.Fields(0).Name & "='" & Grid1.Cell(i, 1).Text & "'")
Next
MsgBox "修改的数据己经完成", vbInformation, "完成操作"
Call callmain
End Sub
Private Sub XPButton4_Click()
If kcdel = False Then
MsgBox "当前删除操作不被允许!", vbInformation, "非使用对象"
Exit Sub
End If
If hang = 0 Then
Exit Sub
End If
If Grid1.Cell(hang, 1).Text = "" Then
Exit Sub
End If
If kctable = "班级管理" Then
Set kc1 = cnn.Execute("select count(所属班级) from 临时生成表 where " & kc1.Fields(0).Name & "='" & Grid1.Cell(hang, 1).Text & "'")
If kc1.Fields(0) = 0 Then
MsgBox "该班级仍然占用了教师的排课资源，请注销该班级的课程表后在操作", vbInformation, "提示"
End If
End If
Set kc1 = cnn.Execute("delete from " & kctable & " where " & kc1.Fields(0).Name & "='" & Grid1.Cell(hang, 1).Text & "'")
MsgBox "目标己删除,请刷新数据!", vbInformation, "删除成功"
Call callmain
End Sub
Private Sub XPButton5_Click()
Unload Me
'Form1.WindowState = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -