mdimain.frm
来自「一款非常适合中小学教学任务不是很繁重的管理程序」· FRM 代码 · 共 502 行 · 第 1/2 页
FRM
502 行
NumPanels = 6
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 2
Alignment = 1
Bevel = 0
Object.Width = 2187
MinWidth = 2187
TextSave = "NUM"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
AutoSize = 1
Object.Width = 952
MinWidth = 952
TextSave = "2:27"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
AutoSize = 1
Object.Width = 1481
MinWidth = 1481
TextSave = "2007-4-27"
EndProperty
BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 5010
MinWidth = 5010
Text = "作者QQ:16968526 452831478"
TextSave = "作者QQ:16968526 452831478"
Object.ToolTipText = "联系作者"
EndProperty
BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 4304
MinWidth = 4304
Text = "伊妹儿：tqw1215@163.com"
TextSave = "伊妹儿：tqw1215@163.com"
Object.ToolTipText = "邮箱"
EndProperty
BeginProperty Panel6 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 9596
MinWidth = 9596
Text = "感谢您的使用！欢迎批评指正！祝您开心！"
TextSave = "感谢您的使用！欢迎批评指正！祝您开心！"
EndProperty
EndProperty
End
Begin VB.PictureBox Picture1
Align = 1 'Align Top
BackColor = &H00E0E0E0&
BorderStyle = 0 'None
Height = 1500
Left = 0
Picture = "mdiMain.frx":20E1CE
ScaleHeight = 1500
ScaleWidth = 9450
TabIndex = 0
Top = 0
Width = 9450
Begin VB.Label Label3
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "教学管理系统V2007版"
BeginProperty Font
Name = "宋体"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 495
Left = 4335
TabIndex = 11
Top = 495
Width = 4740
End
End
End
Attribute VB_Name = "mdiMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click(Index As Integer)
Dim strName As String
Dim i As Integer
i = MsgBox("确实要退出吗？", vbYesNo + vbQuestion, "提示")
Unload Me
End Sub
Private Sub Command2_Click()
Dim strName As String
Dim i As Integer
i = MsgBox("确实要注销吗？", vbYesNo + vbQuestion, "提示")
Unload Me
frmLog.Show
End Sub
Private Sub MDIForm_Load()
Dim strSql As String
'附加功能的实现
vmnuMain.Height = Screen.Height - 3000
strSql = "select 学号,姓名 from 学生基本情况表"
writeMS strSql, Me.mgridStu
strSql = "select 编号,姓名 from 教师基本情况表"
writeMS strSql, Me.mgridTea
Me.SSTab1.Tab = 0
frmMain.Show
cdgAll.CancelError = True
Me.WindowsXPC1.InitSubClassing
End Sub
Private Sub Picture1_Click()
frmMain.Show
End Sub
Private Sub vMnuMain_MenuItemClick(MenuNumber As Long, MenuItem As Long)
Select Case MenuNumber
Case 1
Select Case MenuItem '学生
Case 1
frmStuBase.Show '基本情况
frmStuBase.txtCommand.SetFocus
Case 2
frmStuGrade.Show '成绩表
frmStuGrade.txtGrade(0).SetFocus
Case 3
frmStuOther.Show '住宿情况
frmStuOther.txtName.SetFocus
Case 4
frmStuValue.Show '评价总结
frmStuValue.txtName.SetFocus
End Select
Case 2
Select Case MenuItem '教师
Case 1
frmTeaBase.Show '教师基本情况
frmTeaBase.txtCommand.SetFocus
Case 2
frmSClass.Show '课程设置表
frmSClass.cboName.SetFocus
Case 3
frmClass.Show '课程表
frmClass.txtRow.SetFocus
End Select
Case 3
Select Case MenuItem '其他
Case 1
frmStay.Show '座次表
frmStay.txtRow.SetFocus
Case 2
frmTitle.Show '优秀称号
frmTitle.txtNum.SetFocus
Case 3
frmDuty.Show '值日表
frmDuty.txtIRow.SetFocus
Case 4
frmMessage.Show '公告信息
frmMessage.txtIn.SetFocus
Case 5
frmLead.Show '干部设置
frmLead.txtNum.SetFocus
End Select
Case 4
Select Case MenuItem '系统
Case 1 '系统初始化
frmInit.Show
frmInit.List1.SetFocus
Case 2 '备份
Call AddSave
Case 3 '恢复
Call AddAgain
Case 4 '帮助
Dim strName As String
Dim i As Integer
i = MsgBox("对不起，暂无帮助！", vbYesNo + vbQuestion, "提示")
frmAbout.Show
Case 5 '密码设置
frmSSecrect.Show
frmSSecrect.txtNew.SetFocus
Case 6 '关于
frmAbout.Show
End Select
Case 4
Case 5
Select Case MenuItem '系统
Case 1 'Word
Shell App.Path & "\tools\word.exe", vbMaximizedFocus
Case 2 'Piano
Shell App.Path & "\tools\Piano.exe", vbNormalFocus
Case 3 'shutup
Shell App.Path & "\tools\shutup.exe", vbNormalFocus
Case 4 'Russia
Shell App.Path & "\tools\Russia.exe", vbNormalFocus
End Select
End Select
End Sub
Sub AddAgain() '恢复
Dim strName As String
Dim i As Integer
i = MsgBox("确信恢复吗？", vbYesNo + vbQuestion, "提示")
If i = 6 Then
On Error GoTo errS
dbConn
dbClose
cdgAll.DialogTitle = "教学管理系统"
cdgAll.Filter = "数据文件 (*.mdb)|*.mdb"
cdgAll.FileName = ""
cdgAll.FilterIndex = 2
cdgAll.ShowOpen
strName = cdgAll.FileName
If Right(strName, 4) = ".mdb" Or Right(strName, 4) = ".MDB" Then
FileCopy strName, App.Path & "\data\student.mdb"
MsgBox "『恢复』成功！", vbOKOnly + vbInformation, "教学管理系统"
End If
Exit Sub
errS:
If err.Number = 70 Then
MsgBox "您取消了数据库备份，请您下回备份数据库！", vbOKOnly + vbInformation, "教学管理系统"
Else
MsgBox "错误：" & err.Description, vbOKOnly + vbCritical, "教学管理系统"
End If
End If
End Sub
Sub AddSave() '备份
MsgBox "进行备份之前请关闭所有窗体后进行备份,若有问题请重新登陆系统!", vbOKCancel + vbExclamation, "提示"
Dim strPath As String
Dim i As Integer
On Error GoTo errS
dbConn
dbClose
cdgAll.DialogTitle = "教学管理系统"
cdgAll.Filter = "数据文件 (*.mdb)|*.mdb"
cdgAll.FilterIndex = 2
cdgAll.FileName = "E:\教学管理系统" & Year(Now) & ".mdb"
cdgAll.ShowSave
strPath = cdgAll.FileName
FileCopy App.Path & "\data\student.mdb", strPath
MsgBox "『数据库备份』成功！", vbOKOnly + vbInformation, "教学管理系统"
Exit Sub
errS:
If err.Number = 70 Then
MsgBox "您取消了数据库备份，请您下回备份数据库！", vbOKOnly + vbInformation, "教学管理系统"
Else
MsgBox "错误：" & err.Description, vbOKOnly + vbCritical, "教学管理系统"
End If
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?