📄 frmcurrschedule.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmCurrSchedule
BorderStyle = 3 'Fixed Dialog
Caption = "课程表信息维护"
ClientHeight = 6720
ClientLeft = 45
ClientTop = 330
ClientWidth = 7860
Icon = "frmCurrSchedule.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6720
ScaleWidth = 7860
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin MSComctlLib.ImageList ImgCurrSchedule
Left = 3600
Top = 3120
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 4
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmCurrSchedule.frx":000C
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmCurrSchedule.frx":08E8
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmCurrSchedule.frx":0C0C
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmCurrSchedule.frx":3A98
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 420
Left = 0
TabIndex = 1
Top = 0
Width = 7860
_ExtentX = 13864
_ExtentY = 741
ButtonWidth = 609
ButtonHeight = 582
Appearance = 1
ImageList = "ImgCurrSchedule"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 5
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 4
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 4
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "print"
Object.ToolTipText = "打印"
ImageIndex = 2
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "Add"
Object.ToolTipText = "添加"
ImageIndex = 1
EndProperty
EndProperty
End
Begin MSComctlLib.ListView lvwCurrSchedule
Height = 6015
Left = 240
TabIndex = 0
Top = 480
Width = 7455
_ExtentX = 13150
_ExtentY = 10610
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
HotTracking = -1 'True
_Version = 393217
ForeColor = 0
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.Menu MnuCurrSchedule
Caption = "课表"
Visible = 0 'False
Begin VB.Menu MnuAdd
Caption = "添加课表"
End
Begin VB.Menu MnuEdit
Caption = "修改课表"
End
Begin VB.Menu MnuDelete
Caption = "删除课表"
End
End
End
Attribute VB_Name = "frmCurrSchedule"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' ''
''Filename frmCurrSchedule.frm ''
'' ''
''Created On 2004.2.24 ''
'' ''
''Description 课表信息维护窗体 ''
'' ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim lItem As ListItem
Public rsCurrSchedule As Recordset
Dim rsDeleteCurrSchedule As Recordset
Dim rsOperateLog As Recordset
Dim rsLog As Recordset
Public StrItem As String
Public typeAdd As Boolean
Public Index As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''配置该窗体lvwCurrSchedule控件 ''
''给lvwCurrSchedule控件添加结点 ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
lvwCurrSchedule.ColumnHeaders.Add , , "日期", lvwCurrSchedule.Width / 8 '配置lvwInstitute控件
lvwCurrSchedule.ColumnHeaders.Add , , "星期", lvwCurrSchedule.Width / 8
lvwCurrSchedule.ColumnHeaders.Add , , "上午(8:00-12:00)", 2 * lvwCurrSchedule.Width / 8
lvwCurrSchedule.ColumnHeaders.Add , , "下午(2:00-6:00)", 2 * lvwCurrSchedule.Width / 8
lvwCurrSchedule.ColumnHeaders.Add , , "晚上(6:00-10:00)", 2 * lvwCurrSchedule.Width / 8
lvwCurrSchedule.GridLines = True
lvwCurrSchedule.Sorted = True
lvwCurrSchedule.View = lvwReport
Set rsCurrSchedule = New Recordset
rsCurrSchedule.Open "select * from TbCurrSchedule where Date>=date()", Modmain.conn, 3, 2
While Not rsCurrSchedule.EOF ' 添加相应的 ListItem
Set lItem = lvwCurrSchedule.ListItems.Add
lItem.Text = rsCurrSchedule.Fields("Date")
lItem.SubItems(1) = rsCurrSchedule.Fields("Week")
If rsCurrSchedule.Fields("Morning") <> "" Then
lItem.SubItems(2) = rsCurrSchedule.Fields("Morning")
End If
If rsCurrSchedule.Fields("Afternoon") <> "" Then
lItem.SubItems(3) = rsCurrSchedule.Fields("Afternoon")
End If
If rsCurrSchedule.Fields("Night") <> "" Then
lItem.SubItems(4) = rsCurrSchedule.Fields("Night")
End If
rsCurrSchedule.MoveNext
Wend
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' 点击lvwCurrSchedule控件时，保存该结点的Item,Index值 ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub lvwCurrSchedule_ItemClick(ByVal Item As MSComctlLib.ListItem)
StrItem = Item
Index = Item.Index
End Sub
Private Sub lvwCurrSchedule_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu MnuCurrSchedule, vbPopupMenuRightButton
End If
End Sub
Private Sub MnuAdd_Click()
typeAdd = True
frmAddCurrSchedule.Show 1
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' 删除课表信息 ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub MnuDelete_Click()
If MsgBox("确实要删除该天的课表吗?", vbYesNo + vbQuestion, "机房管理") = vbYes Then
Set rsDeleteCurrSchedule = New Recordset
rsDeleteCurrSchedule.Open "select * from TbCurrSchedule where Date like'" & StrItem & "'", Modmain.conn, 3, 2
rsDeleteCurrSchedule.Delete
lvwCurrSchedule.ListItems.Remove (Index)
AddLog
End If
End Sub
Private Sub MnuEdit_Click()
typeAdd = False
frmAddCurrSchedule.Show 1
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "Add"
MnuAdd_Click
Case "print"
DRCurrSchedule.Show 1
End Select
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''将用户添加班级的信息记入操作日志 ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub AddLog()
Dim strEvents As String
Dim strTemp As String
strTemp = "'"
Set rsOperateLog = New Recordset
rsOperateLog.Open "select * from tbOperateLog", Modmain.conn, 3, 2
Set rsLog = New Recordset
rsLog.Open "select * from tblog where L_ID='L17'", Modmain.conn, 3, 2
strEvents = rsLog.Fields!Events
rsOperateLog.AddNew
rsOperateLog.Fields!U_ID = frmLoad.StrU_ID
rsOperateLog.Fields!Time = Time
rsOperateLog.Fields!Date = Date
rsOperateLog.Fields!Events = strEvents
rsOperateLog.Fields!Description = strEvents & strTemp & StrItem & strTemp
rsOperateLog.Update
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -