或用Multimedia MCI 控件,就这点代码:Private Sub Form_Load() ' Set properties needed by MCI to open. MMControl1.Notify = False MMControl1.Wait = True MMControl1.Shareable = False MMControl1.DeviceType = "AVIVideo" MMControl1.FileName = "D:\vclearn\contents\00\vc0.avi" '打开 MCI WaveAudio 设备。 MMControl1.Command = "Open" Debug.Print MMControl1.hWnd End SubPrivate Sub Form_Unload(Cancel As Integer) MMControl1.Command = "Close" End Sub
问题是,有时候VS.NET找不到MMCI控件……那该怎么办……
Option Explicit''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 LongPrivate 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 LongPrivate Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As LongConst SND_ASYNC = &H1 Const SND_NODEFAULT = &H2Public PlayError As Boolean Private isPause As Boolean Public isRepeat 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 If Not isPause Then 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 Else isPause = False mciSendString "play mp3", Buffer, Ret, 0 End If End SubPublic Sub StopMusic() Dim Buffer As String * 128 Dim Ret As Long mciSendString "stop mp3", Buffer, Ret, 0 End SubPublic Sub PauseMusic() Dim Buffer As String * 128 Dim Ret As Long mciSendString "pause mp3", Buffer, Ret, 0 isPause = True End SubPublic Sub RepeatMusic() Dim Buffer As String * 128 Dim Ret As Long If isRepeat Then mciSendString "repeat mp3", Buffer, Ret, 0 End SubPublic 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
' Set properties needed by MCI to open.
MMControl1.Notify = False
MMControl1.Wait = True
MMControl1.Shareable = False
MMControl1.DeviceType = "AVIVideo"
MMControl1.FileName = "D:\vclearn\contents\00\vc0.avi"
'打开 MCI WaveAudio 设备。
MMControl1.Command = "Open"
Debug.Print MMControl1.hWnd
End SubPrivate Sub Form_Unload(Cancel As Integer)
MMControl1.Command = "Close"
End Sub
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 LongPrivate 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 LongPrivate Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As LongConst SND_ASYNC = &H1
Const SND_NODEFAULT = &H2Public PlayError As Boolean
Private isPause As Boolean
Public isRepeat 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
If Not isPause Then
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
Else
isPause = False
mciSendString "play mp3", Buffer, Ret, 0
End If
End SubPublic Sub StopMusic()
Dim Buffer As String * 128
Dim Ret As Long
mciSendString "stop mp3", Buffer, Ret, 0
End SubPublic Sub PauseMusic()
Dim Buffer As String * 128
Dim Ret As Long
mciSendString "pause mp3", Buffer, Ret, 0
isPause = True
End SubPublic Sub RepeatMusic()
Dim Buffer As String * 128
Dim Ret As Long
If isRepeat Then mciSendString "repeat mp3", Buffer, Ret, 0
End SubPublic 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