对于上次关于打开文件夹的问题已经解决了,多谢"grief"和"firechun"两位的帮忙,不过这次还有一个问题要请教,就是怎么为摁钮点击时添加声音.请大虾指点!
我的音乐播放模块
模块中包含声卡检测/WAV/MP3/MID音乐播放
'Model process sound play Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long Public Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Declare Function mciSendCommand Lib "winmm.dll" Alias "mciSendCommandA" (ByVal wDeviceID As Long, ByVal uMessage As Long, ByVal dwParam1 As Long, ByVal dwParam2 As Any) As Long Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As Long
Const SND_ASYNC = &H1 Const SND_NODEFAULT = &H2
Public PlayError As Boolean
'测试是否安装了声卡 Public Function TestSound() As Boolean Dim Ret As Long Ret& = waveOutGetNumDevs If Ret > 0 Then TestSound = True Else TestSound = False End If 'TestSound = False End Function
'播放wav声音文件 Public Sub PlaySound(FileName As String, Optional Flag As Long = (SND_ASYNC Or SND_NODEFAULT)) Dim Ret As Long Ret = sndPlaySound(FileName, Flag) If Ret = 0 And Flag = (SND_ASYNC Or SND_NODEFAULT) Then 'MessageBeep 0 Beep End If End Sub
'播放音乐mp3,wav,mid等 Public Sub PlayMusic(FileName As String) Dim Buffer As String * 128 Dim Ret As Long Dim PlayStatus As String * 20 Dim ShortFileName As String mciExecute "close all" If Dir(FileName) = "" Then PlayError = True: Exit Sub ShortFileName = ShortName(FileName) mciSendString "open " & ShortFileName & " alias mp3", Buffer, Ret, 0 mciSendString "play mp3", Buffer, Ret, 0 PlayError = False End Sub
Public Sub StopMusic() Dim Buffer As String * 128 Dim Ret As Long mciSendString "stop mp3", Buffer, Ret, 0 End Sub
Public Function GetPlayMode() As String Dim Buffer As String * 128 Dim pos As Integer mciSendString "status mp3 mode", Buffer, 128, 0& pos = InStr(Buffer, Chr(0)) GetPlayMode = Left(Buffer, pos - 1) End Function
'从带路径文件名中提取文件名 Public Function GetFileNameNoPath(sFullPathFileName As String) As String Dim pos As Integer Dim DifFilename As String If sFullPathFileName = "" Then Exit Function DifFilename = StrReverse(sFullPathFileName) pos = InStr(1, DifFilename, "\") If pos <> -1 Then GetFileNameNoPath = Right(sFullPathFileName, pos - 1) Else GetFileNameNoPath = sFullPathFileName End If End Function
'得到文件短文件名 Function ShortName(LongPath As String) As String Dim ShortPath As String Dim pos As String Dim Ret As Long Const MAX_PATH = 260 If LongPath = "" Then Exit Function ShortPath = Space$(MAX_PATH) Ret& = GetShortPathName(LongPath, ShortPath, MAX_PATH) If Ret& Then pos = InStr(1, ShortPath, " ") ShortName = Left$(ShortPath, pos - 2) End If End Function