📄 frmmain.frm
字号:
Index = 7
End
Begin VB.Menu mnuLLKemu
Caption = "理科综合"
Index = 8
End
Begin VB.Menu mnuLLKemu
Caption = "-"
Index = 9
End
Begin VB.Menu mnuLLKemu
Caption = "政治"
Index = 10
End
Begin VB.Menu mnuLLKemu
Caption = "历史"
Index = 11
End
Begin VB.Menu mnuLLKemu
Caption = "地理"
Index = 12
End
Begin VB.Menu mnuLLKemu
Caption = "文科综合"
Index = 13
End
Begin VB.Menu mnuLLKemu
Caption = "-"
Index = 14
End
Begin VB.Menu mnuLLKemu
Caption = "音乐"
Index = 15
End
Begin VB.Menu mnuLLKemu
Caption = "美术"
Index = 16
End
Begin VB.Menu mnuLLKemu
Caption = "体育"
Index = 17
End
Begin VB.Menu mnuLLKemu
Caption = "劳技"
Index = 18
End
Begin VB.Menu mnuLLKemu
Caption = "-"
Index = 19
End
Begin VB.Menu mnuLLKemu
Caption = "任何科目"
Index = 20
End
Begin VB.Menu mnuLLKemu
Caption = "其它"
Index = 21
End
End
End
Begin VB.Menu munFind
Caption = "查找(&F)"
Begin VB.Menu munFind0
Caption = "查找(&F)"
Shortcut = ^F
End
Begin VB.Menu mnuMyFind
Caption = "----以前的查找----"
Enabled = 0 'False
Index = 0
End
End
Begin VB.Menu mnuNetWrok
Caption = "网络(&N)"
Begin VB.Menu mnuNetWrokSub
Caption = "共享资源"
Index = 1
End
Begin VB.Menu mnuNetWrokSub
Caption = "网上资源"
Index = 2
End
End
Begin VB.Menu mnuWindow
Caption = "窗口(&W)"
WindowList = -1 'True
Begin VB.Menu mnuWindowCascade
Caption = "层叠(&C)"
End
Begin VB.Menu mnuWindowTileHorizontal
Caption = "横向平铺(&V)"
End
Begin VB.Menu mnuWindowTileVertical
Caption = "纵向平铺(&H)"
End
Begin VB.Menu mnuWindowArrangeIcons
Caption = "排列图标(&A)"
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
Begin VB.Menu mnuHelpShiyong
Caption = "如何使用(&U)"
Shortcut = {F1}
End
Begin VB.Menu mnuHelpZhuce
Caption = "软件注册&S)"
End
Begin VB.Menu mnuHelpBar0
Caption = "-"
End
Begin VB.Menu mnuHelpAbout
Caption = "关于(&A) "
End
End
Begin VB.Menu mypop
Caption = "pop"
Visible = 0 'False
Begin VB.Menu popR
Caption = "刷新"
End
Begin VB.Menu line0
Caption = "-"
End
Begin VB.Menu popData
Caption = "打开"
Index = 0
End
Begin VB.Menu popData
Caption = "修改"
Index = 1
End
Begin VB.Menu popData
Caption = "撤除"
Index = 2
End
Begin VB.Menu popData
Caption = "另存为"
Index = 3
End
Begin VB.Menu popData
Caption = "共享"
Index = 4
End
Begin VB.Menu line1
Caption = "-"
End
Begin VB.Menu popview
Caption = "视图"
Begin VB.Menu popviewsub
Caption = "图标"
Index = 1
End
Begin VB.Menu popviewsub
Caption = "列表"
Index = 2
End
Begin VB.Menu popviewsub
Caption = "详细信息"
Index = 3
End
End
Begin VB.Menu popPailie
Caption = "排列"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim FindSQL(100) As String
Public FindNumber As Integer
Public Sub setFindSQl(ByVal i As Integer, ByVal sql As String)
FindSQL(i) = sql
End Sub
Private Sub MDIForm_Load()
con.Open
Dim sql As String
sql = "select * from info where deldate='0'"
rs.Open sql, con, adOpenKeyset, adLockPessimistic
Me.sbStatusBar.Panels(1).Text = "资源总数 " + CStr(rs.RecordCount)
rs.Close
con.Close
Timer1.Enabled = blnBGSound
Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
Me.WindowState = GetSetting(App.Title, "Settings", "MainWindowState", 0)
con.Open
sql = "select * from sys where setname='Find'"
rs.Open sql, con, adOpenKeyset, adLockPessimistic
FindNumber = 0
If rs.RecordCount >= 1 Then
While Not rs.EOF
Load mnuMyFind(rs.AbsolutePosition)
mnuMyFind(rs.AbsolutePosition).Caption = rs("setvalue")
mnuMyFind(rs.AbsolutePosition).Enabled = True
FindSQL(rs.AbsolutePosition) = rs("setvalue2")
rs.MoveNext
FindNumber = FindNumber + 1
Wend
End If
rs.Close
con.Close
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
SaveSetting App.Title, "Settings", "MainWidth", Me.Width
SaveSetting App.Title, "Settings", "MainHeight", Me.Height
SaveSetting App.Title, "Settings", "MainWindowState", Me.WindowState
End If
If blnBGSound Then Call StopMidiFile
End Sub
Private Sub mnuHelpAbout_Click()
frmAbout.Show vbModal, Me
End Sub
Private Sub mnuHelpZhuce_Click()
MsgBox "此版本为免费，不需要注册！", , "提示"
End Sub
Private Sub mnuLiulan_Click(Index As Integer)
Dim str As String
Dim i As Integer
i = InStr(1, mnuLiulan(Index).Caption, "(&")
If i <> 0 Then
str = Left(mnuLiulan(Index).Caption, i - 1)
Else
str = mnuLiulan(Index).Caption
End If
LiuLanLeixing str, Index
End Sub
Private Sub mnuLLKemu_Click(Index As Integer)
Dim str As String
Dim i As Integer
i = InStr(1, mnuLLKemu(Index).Caption, "(&")
If i <> 0 Then
str = Left(mnuLLKemu(Index).Caption, i - 1)
Else
str = mnuLLKemu(Index).Caption
End If
LiuLanKemu str, Index
End Sub
Private Sub mnuLLNianji_Click(Index As Integer)
Dim str As String
Dim i As Integer
i = InStr(1, mnuLLNianji(Index).Caption, "(&")
If i <> 0 Then
str = Left(mnuLLNianji(Index).Caption, i - 1)
Else
str = mnuLLNianji(Index).Caption
End If
LiuLanNianji str, Index
End Sub
Private Sub mnuMyFind_Click(Index As Integer)
Dim frmD As frmDocument
Set frmD = New frmDocument
frmD.Caption = mnuMyFind(Index).Caption
frmD.Init (FindSQL(Index))
frmD.Show
End Sub
Private Sub mnuTianjia_Click(Index As Integer)
Dim str As String
Dim i As Integer
i = InStr(1, mnuTianjia(Index).Caption, "(&")
If i <> 0 Then
str = Left(mnuTianjia(Index).Caption, i - 1)
Else
str = mnuTianjia(Index).Caption
End If
TianJiao str, Index
End Sub
Private Sub mnuWindowArrangeIcons_Click()
Me.Arrange vbArrangeIcons
End Sub
Private Sub mnuWindowTileVertical_Click()
Me.Arrange vbTileVertical
End Sub
Private Sub mnuWindowTileHorizontal_Click()
Me.Arrange vbTileHorizontal
End Sub
Private Sub mnuWindowCascade_Click()
Me.Arrange vbCascade
End Sub
Private Sub mnuFileExit_Click()
'卸载窗体asdfas
Unload Me
End Sub
Private Sub mnuXitongBeifen_Click()
Dim usf As clsBrowsing
Set usf = New clsBrowsing
usf.MyShow "请选择一个文件夹来保存备份数据："
If usf.OK Then
If usf.txtPath <> "" Then
Dim strPath As String
Dim MyDir As clsDir
Set MyDir = New clsDir
strPath = usf.txtPath + "\教学资源管理系统数据备份" + CStr(Date)
MkDir strPath
MkDir strPath + "\res\"
MyDir.strMyDir = App.Path + "\res\"
MyDir.uCopyDir strPath + "\res\"
FileCopy App.Path + "\system.dat", strPath + "\system.dat"
Else
MsgBox "你选择的文件夹不正确！", , "错误"
End If
End If
End Sub
Private Sub mnuXitongCanshu_Click()
frmCanshu.Show vbModal, Me
End Sub
Private Sub mnuXitongHuanyuan_Click()
Dim usf As clsBrowsing
Set usf = New clsBrowsing
usf.MyShow "请选择备份数据所在的文件夹："
If usf.OK Then
If usf.txtPath <> "" Then
Dim MyDir As clsDir
Set MyDir = New clsDir
MyDir.strMyDir = App.Path + "\res\"
MyDir.uDelDir
If Not IsFileExists(App.Path + "\res\") Then MkDir App.Path + "\res\"
MyDir.strMyDir = usf.txtPath + "\res\"
MyDir.uCopyDir App.Path + "\res\"
DeleteFile App.Path + "\system.dat"
CopyFile usf.txtPath + "\system.dat", App.Path + "\system.dat", 0
Else
MsgBox "你选择的文件夹不正确！", , "错误"
End If
End If
End Sub
Private Sub mnuXitongHuishou_Click()
Load frmHuishou
frmHuishou.Init "select * from info where deldate<>'0'"
frmHuishou.Show
End Sub
Private Sub munFind0_Click()
frmFind.Show
End Sub
Private Sub popData_Click(Index As Integer)
Me.ActiveForm.MyUpData Index
End Sub
Private Sub popR_Click()
Me.ActiveForm.Init ("")
End Sub
Private Sub popviewsub_Click(Index As Integer)
Me.ActiveForm.munViwe Index
End Sub
Private Sub Timer1_Timer()
Dim S As String
S = String(256, Chr(0))
mciSendString "status MyMid mode", S, Len(S), 0
If Left(S, 7) = "stopped" Or Left(S, 2) = "停止" Then
mciSendString "seek MyMid to start", vbNullString, 0, 0
mciSendString "play MyMid", vbNullString, 0, 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -