📄 frmmain.frm
字号:
Begin VB.Menu menu4
Caption = "权限管理"
Index = 3
End
Begin VB.Menu menu4
Caption = "数据备份与恢复"
Index = 4
End
Begin VB.Menu menu4
Caption = "查看事务日志"
Index = 5
End
End
Begin VB.Menu 综合查询
Caption = "【综合查询】"
Begin VB.Menu sel
Caption = "综合信息查询"
End
End
Begin VB.Menu Sup
Caption = "【辅助工具】"
Begin VB.Menu Count
Caption = "计算器"
End
Begin VB.Menu TX
Caption = "通讯簿"
End
Begin VB.Menu lin1
Caption = "-"
End
Begin VB.Menu Thun
Caption = "扫雷"
End
Begin VB.Menu Pok
Caption = "纸牌"
End
End
Begin VB.Menu 帮助
Caption = "【帮助】"
Index = 5
Begin VB.Menu menu5
Caption = "帮助"
Index = 1
End
Begin VB.Menu menu5
Caption = "关于"
Index = 2
End
End
Begin VB.Menu 退出
Caption = "【退出】"
End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************
'模块名称：系统主界面
'模块功能：提供各模块的入口
'版本 ：1.0版
'代码编写者：熊锋
'编写日期：2006-11-6
'*********************************************
Const speed = 200 '定义常量，确保speed不被修改
Dim expand As Boolean '定义布尔型变量，用于判断是否可以展开
Dim frame As Integer '整型变量，点击MenuHeader时获取MenuHeader的index值
Dim doresize As Boolean '定义布尔型变量，用户控制
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Sub Count_Click()
X = Shell("C:\WINDOWS\System32\calc.exe", 1)
End Sub
Private Sub Form_Load()
Dim n, X, Y, z As Integer
For i = 1 To M.UBound '将菜单中的caption赋给lblHeader控件数组中的caption
lblHeader(i - 1).Caption = M(i).Caption
Next i
n = menu1.UBound '6
X = menu1.UBound + menu2.UBound '11
Y = menu1.UBound + menu2.UBound + menu3.UBound '17
z = menu1.UBound + menu2.UBound + menu3.UBound + menu4.UBound
For i = 1 To menu1.UBound
Lab(i - 1).Caption = menu1(i).Caption
Next i
For i = 1 To menu2.UBound
Lab(i - 1 + n) = menu2(i).Caption
Next i
For i = 1 To menu3.UBound
Lab(i - 1 + X).Caption = menu3(i).Caption
Next i
For i = 1 To menu4.UBound
Lab(i - 1 + Y).Caption = menu4(i).Caption
Next i
For i = 1 To menu5.UBound
Lab(i - 1 + z).Caption = menu5(i).Caption
Next i
For i = 0 To MenuHeader.Count - 1 'Image控件数组MenuHeader
MenuHeader(i).Picture = img1.Picture '将图片1设为MenuHeader(i)的picture属性
MenuHeader(i).Height = 375 'MenuHeader(i)的高度为375
MenuHeader(i).Width = XPMenu(i).Width 'MenuHeader(i)的宽度等于XPMenu(i)的宽度，XPMenu为PictureBox控件数组
Next
For n = 0 To MenuHeader.Count - 1
XPMenu(n).Height = MenuHeader(n).Height 'XPMenu(n)的高度等于MenuHeader(n)的高度，即调用主界面时MenuHeader(n)是收缩状态
Next
doresize = False
'状态栏
StatusBar2.Panels(1).Text = StatusBar2.Panels(1).Text & frmlog.txtuser
StatusBar2.Panels(2).Text = StatusBar2.Panels(2).Text & Now
End Sub
Private Sub Form_Unload(Cancel As Integer) '用户退出系统时，将记录的登录次数清0
' If MsgBox("确实要退出实验室设备管理系统吗？", vbYesNo + vbQuestion + vbDefaultButton1, "确认窗口") = vbYes Then
' End
' Else
' Load Me
' End If
End Sub
'鼠标点下时控制lab的坐标左移30
Private Sub Lab_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Index
Case 0
Lab(0).Left = Lab(0).Left - 30
Case 1
Lab(1).Left = Lab(1).Left - 30
Case 2
Lab(2).Left = Lab(2).Left - 30
Case 3
Lab(3).Left = Lab(3).Left - 30
Case 4
Lab(4).Left = Lab(4).Left - 30
Case 5
Lab(5).Left = Lab(5).Left - 30
Case 6
Lab(6).Left = Lab(6).Left - 30
Case 7
Lab(7).Left = Lab(7).Left - 30
Case 8
Lab(8).Left = Lab(8).Left - 30
Case 9
Lab(9).Left = Lab(9).Left - 30
Case 10
Lab(10).Left = Lab(10).Left - 30
Case 11
Lab(11).Left = Lab(11).Left - 30
Case 12
Lab(12).Left = Lab(12).Left - 30
Case 13
Lab(13).Left = Lab(13).Left - 30
Case 14
Lab(14).Left = Lab(14).Left - 30
Case 15
Lab(15).Left = Lab(15).Left - 30
Case 16
Lab(16).Left = Lab(16).Left - 30
Case 17
Lab(17).Left = Lab(17).Left - 30
Case 18
Lab(18).Left = Lab(18).Left - 30
Case 19
Lab(19).Left = Lab(19).Left - 30
Case 20
Lab(20).Left = Lab(20).Left - 30
Case 21
Lab(21).Left = Lab(21).Left - 30
Case 22
Lab(22).Left = Lab(22).Left - 30
Case 23
Lab(23).Left = Lab(23).Left - 30
End Select
End Sub
'鼠标松开时控制lab坐标右移30
Private Sub Lab_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Index
Case 0
Lab(0).Left = Lab(0).Left + 30
Case 1
Lab(1).Left = Lab(1).Left + 30
Case 2
Lab(2).Left = Lab(2).Left + 30
Case 3
Lab(3).Left = Lab(3).Left + 30
Case 4
Lab(4).Left = Lab(4).Left + 30
Case 5
Lab(5).Left = Lab(5).Left + 30
Case 6
Lab(6).Left = Lab(6).Left + 30
Case 7
Lab(7).Left = Lab(7).Left + 30
Case 8
Lab(8).Left = Lab(8).Left + 30
Case 9
Lab(9).Left = Lab(9).Left + 30
Case 10
Lab(10).Left = Lab(10).Left + 30
Case 11
Lab(11).Left = Lab(11).Left + 30
Case 12
Lab(12).Left = Lab(12).Left + 30
Case 13
Lab(13).Left = Lab(13).Left + 30
Case 14
Lab(14).Left = Lab(14).Left + 30
Case 15
Lab(15).Left = Lab(15).Left + 30
Case 16
Lab(16).Left = Lab(16).Left + 30
Case 17
Lab(17).Left = Lab(17).Left + 30
Case 18
Lab(18).Left = Lab(18).Left + 30
Case 19
Lab(19).Left = Lab(19).Left + 30
Case 20
Lab(20).Left = Lab(20).Left + 30
Case 21
Lab(21).Left = Lab(21).Left + 30
Case 22
Lab(22).Left = Lab(22).Left + 30
Case 23
Lab(23).Left = Lab(23).Left + 30
End Select
End Sub
Private Sub menu2_Click(Index As Integer)
Select Case Index
Case 1
Frmin.Show
Case 2
Frmmend1.Show
Case 3
Frmlend.Show
Case 4
Frmbroke.Show
Case 5
Frmpey1.Show
End Select
End Sub
Private Sub menu3_Click(Index As Integer)
Select Case Index
Case 1
frmEt.Show
Case 2
frmEq.Show
Case 3
frmlabAD.Show
Case 4
frmLab.Show
Case 5
frmort.Show
Case 6
frmUser.Show
End Select
End Sub
'点击menuheader，判断是否可以下拉，并记录下menuheader的index值
Private Sub MenuHeader_Click(Index As Integer)
If doresize = False Then
If XPMenu(Index).Height = MenuHeader(Index).Height Then
expand = True '当XPMenu(Index)的高度等于MenuHeader(Index)时，表示该MenuHeader(Index)可以展开
Else
expand = False '不等于时，不可以展开，即不能下拉
End If
doresize = True
frame = Index
End If
End Sub
Private Sub Pok_Click()
RetVal = Shell("SOL.EXE", 1)
End Sub
Private Sub sel_Click()
frmstuinfo.Show '调用综合查询界面
End Sub
Private Sub Thun_Click()
RetVal = Shell("Winmine.exe", 1)
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
Dim ExpandHeight As Integer '展开高度
ExpandHeight = 0
For i = 1 To XPMenu.Count - 1
'XPMenu(i).Top为纵坐标，等于XPMenu(i-1).top+XPMenu(i-1).height+120，即将XPMenu(i-1)对应的展开了
'120为各个XPMenu之间的间隔
' XPMenu(i)为picturebox
XPMenu(i).Top = XPMenu(i - 1).Top + XPMenu(i - 1).Height + 120
Next
If doresize = True Then
If expand = False Then '不能展开
MenuHeader(frame).Picture = img2.Picture '将对应项图片换为img2,即收缩状态的图片
XPMenu(frame).Height = XPMenu(frame).Height - speed '不能展开时，即为展开状态，点击后收缩
If XPMenu(frame).Height <= MenuHeader(frame).Height Then
doresize = False
XPMenu(frame).Height = MenuHeader(frame).Height
End If
Else
MenuHeader(frame).Picture = img1.Picture '可以展开，将图片换为img1
XPMenu(frame).Height = XPMenu(frame).Height + speed '可以展开，点击后展开
For i = 0 To Me.Count - 1 '
'判断控件名是否和XPMenu(frame).Name一致,frame为index
If Controls(i).Container.Name = XPMenu(frame).Name Then
'判断控件的index是否一致
If Controls(i).Container.Index = XPMenu(frame).Index Then
If Controls(i).Top + Controls(i).Height > ExpandHeight Then
ExpandHeight = Controls(i).Top + Controls(i).Height
End If
End If
End If
Next
'控制展开的高度
If XPMenu(frame).Height >= ExpandHeight + 120 Then
doresize = False
XPMenu(frame).Height = ExpandHeight + 120
End If
End If
End If
End Sub
'点击lab控件数组相应的相，调用出相应的界面
Private Sub Lab_Click(Index As Integer)
Select Case Index
Case 0
frmbuy.Show '调用设备购置管理界面
Case 1
frmuse.Show '调用设备使用管理界面
Case 2
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -