⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.frm

📁 健身俱乐部管理系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
    '打开数据库连接
    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 + -