📄 frmmain.frm
字号:
'打开数据库连接
Call MdlDB.DataIni
'使窗体靠前显示
'lngWindowPosition = SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
'读取基本设置
'一.读取刷卡类型设置
Dim Rs_CardCheck As ADODB.Recordset
Set Rs_CardCheck = New ADODB.Recordset
Rs_CardCheck.Open "SELECT * FROM CardCheck", CN, adOpenStatic, adLockOptimistic
If Not Rs_CardCheck.EOF Then
Rs_CardCheck.MoveFirst
Flag_CardCheck = Rs_CardCheck!checktype '读取刷卡设置
End If
Rs_CardCheck.Close
Set Rs_CardCheck = Nothing
Select Case Flag_CardCheck
Case 1
mnuOnlyIn.Checked = True '设置"仅仅进入"为选中
mnuBoth.Checked = False
Case 2
mnuBoth.Checked = True '设置“进出”为选中
mnuOnlyIn.Checked = False
Case Else
End Select
'**************************************
'读取音效设置
Dim Rs_SetUp As ADODB.Recordset
Set Rs_SetUp = New ADODB.Recordset
Rs_SetUp.Open "SELECT * FROM SetUp", CN, adOpenStatic, adLockOptimistic
If Not Rs_SetUp.EOF Then
Rs_SetUp.MoveFirst
MdlPublic.Flag_Sound = Rs_SetUp!FlagSound '读取音效设置
End If
Rs_SetUp.Close
Set Rs_SetUp = Nothing
If MdlPublic.Flag_Sound = True Then
mnuMscSet.Caption = "关闭"
Else
mnuMscSet.Caption = "打开"
End If
'启动音乐
If MdlPublic.Flag_Sound = True Then
sndPlaySound App.Path & "\Start.wav", &H1 '当参数为&h0时在播放声音时不响应其他
End If
End Sub
Private Sub Form_Terminate()
'结束音乐
If MdlPublic.Flag_Sound = True Then
sndPlaySound App.Path & "\End.wav", &H1 '当参数为&h0时在播放声音时不响应其他
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'结束音乐
If MdlPublic.Flag_Sound = True Then
sndPlaySound App.Path & "\End.wav", &H0 '当参数为&h0时在播放声音时不响应其他
End If
Set CN = Nothing '释放数据库连接
End '退出应用程序
End Sub
'显示储物箱管理界面
Private Sub mnuChest_Click()
FrmChestManage.Show 1 '显示储物箱管理界面
End Sub
'退出
Private Sub mnuClose_Click()
'结束音乐
If MdlPublic.Flag_Sound = True Then
sndPlaySound App.Path & "\End.wav", &H0 '当参数为&h0时在播放声音时不响应其他
End If
Set CN = Nothing '释放数据库连接
End '退出应用程序
End Sub
Private Sub mnuAbout_Click()
FrmAbout.Show
End Sub
'
Private Sub mnuAboutUs_Click()
FrmAboutUs.Show '关于我们
End Sub
Private Sub MnuInOutTest_Click()
FrmInOutTest.Show '出入检测
End Sub
'会员综合管理
Private Sub MnuManage_Click()
FrmAllManage.Show
End Sub
'会员注册
Private Sub mnuMemberReg_Click()
FrmClientReg.Show
End Sub
Private Sub mnuMscSet_Click()
If mnuMscSet.Caption = "打开" Then
MdlPublic.Flag_Sound = True
mnuMscSet.Caption = "关闭"
Else
MdlPublic.Flag_Sound = False
mnuMscSet.Caption = "打开"
End If
'**************************************
'读取音效设置
Dim Rs_SetUp As ADODB.Recordset
Set Rs_SetUp = New ADODB.Recordset
Rs_SetUp.Open "SELECT * FROM SetUp", CN, adOpenStatic, adLockOptimistic
If Not Rs_SetUp.EOF Then
Rs_SetUp.MoveFirst
Rs_SetUp!FlagSound = MdlPublic.Flag_Sound '保存音效设置
Rs_SetUp.Update
Else
Rs_SetUp.AddNew
Rs_SetUp!FlagSound = MdlPublic.Flag_Sound '保存音效设置
Rs_SetUp.Update
End If
Rs_SetUp.Close
Set Rs_SetUp = Nothing
End Sub
'设置刷卡类型
'仅仅进入刷卡
Private Sub mnuOnlyIn_Click()
mnuOnlyIn.Checked = True '设置自己为选中
mnuBoth.Checked = False
'在数据库中保存设置
Dim Rs_CardCheck As ADODB.Recordset
Set Rs_CardCheck = New ADODB.Recordset
Rs_CardCheck.Open "SELECT * FROM CardCheck", CN, adOpenStatic, adLockOptimistic
Rs_CardCheck!checktype = 1 '仅仅进入刷卡
Rs_CardCheck.Update
Rs_CardCheck.Close
Set Rs_CardCheck = Nothing
Flag_CardCheck = 1 '仅仅进入刷卡
End Sub
'进出都刷卡
Private Sub mnuBoth_Click()
mnuBoth.Checked = True '设置自己为选中
mnuOnlyIn.Checked = False
'在数据库中保存设置
Dim Rs_CardCheck As ADODB.Recordset
Set Rs_CardCheck = New ADODB.Recordset
Rs_CardCheck.Open "SELECT * FROM CardCheck", CN, adOpenStatic, adLockOptimistic
Rs_CardCheck!checktype = 2 '进出都刷卡
Rs_CardCheck.Update
Rs_CardCheck.Close
Set Rs_CardCheck = Nothing
'*************
Flag_CardCheck = 2 '进出都刷卡
End Sub
'显示使用帮助
Private Sub mnuUseHelp_Click()
'法一
'keybd_event VK_F1, 0, 0, 0
'****************************************
'法二(奶奶的,不好使)
'App.HelpFile = App.Path & "\Help.chm" '文件名是1.chm
'Me.CDgHelp.HelpFile = App.Path & "\Help.hlp" '!!!我故意写成1.hlp
'CDgHelp.HelpCommand = &H3
'CDgHelp.ShowHelp
'***********************************************
'法三
'Shell "hh.exe " & App.Path & "\Help.chm"
'*************************************
'法四
'SendKeys "{F1}" '按F1键,系统自动调用帮助
'*************************************
'法五
HtmlHelpA Me.hWnd, App.Path & "\Help.chm", 0, 0
End Sub
Private Sub TlbMain_ButtonClick(ByVal Button As ComctlLib.Button)
' Select Case Button.Index
' Case 1 '出入检测
' FrmInOutTest.Show
' Case 5 '退出
' 'End 语句不调用 Unload、QueryUnload、或 Terminate
' '事件或任何其它 Visual Basic 代码,只是生硬地终止代码执行
'
' '结束音乐
' If MdlPublic.Flag_Sound = True Then
' sndPlaySound App.Path & "\End.wav", &H1 '当参数为&h0时在播放声音时不响应其他
' End If
'
' End '退出软件
' End Select
Select Case Button.Key
Case "MemberReg" '新会员注册
FrmClientReg.Show
Case "InOutTest" '出入检测
FrmInOutTest.Show
Case "Help" '帮助
keybd_event VK_F1, 0, 0, 0
Case "Exit" '退出
'End 语句不调用 Unload、QueryUnload、或 Terminate
'事件或任何其它 Visual Basic 代码,只是生硬地终止代码执行
'结束音乐
If MdlPublic.Flag_Sound = True Then
sndPlaySound App.Path & "\End.wav", &H0 '当参数为&h0时在播放声音时不响应其他
End If
End '退出软件
End Select
End Sub
Private Sub tmrMain_Timer()
staMain.Panels(3).Text = CStr(Year(Date)) + "年" + CStr(Month(Date)) + "月" + CStr(Day(Date)) + "日 " + " 星期" + CStr(WeekNum()) + " " + Format(Time, "hh:nn:ss")
End Sub
'变换星期显示
Public Function WeekNum()
WeekNum = Weekday(Date)
Select Case WeekNum
Case 7
WeekNum = "六"
Case 1
WeekNum = "日"
Case 2
WeekNum = "一"
Case 3
WeekNum = "二"
Case 4
WeekNum = "三"
Case 5
WeekNum = "四"
Case 6
WeekNum = "五"
End Select
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -