VB 多种格式的音乐播放模块

Public 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

Public Declare Function mciGetDeviceID Lib "winmm.dll" Alias "mciGetDeviceIDA" ( ByVal lpstrName As String ) As Long

Public Declare Function waveOutGetVolume Lib "winmm.dll" ( ByVal uDeviceID As Long , lpdwVolume As Long ) As Long

Public Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" ( ByVal Hwnd As Long , ByVal nIndex As Long ) As Long

Public Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" ( ByVal lpPrevWndFunc As Long , ByVal Hwnd As Long , ByVal Msg As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long

Public Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" ( ByVal Hwnd As Long , ByVal nIndex As Long , ByVal dwNewLong As Long ) As Long

Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" ( ByVal lpszLongPath As String , ByVal lpszShortPath As String , ByVal cchBuffer As Long ) As Long

Enum PlayTypeName
File = 1
CDAudio = 2
VCD = 3
RealPlay = 4
End Enum
Dim PlayType As PlayTypeName
Enum AudioSource
H = 0 ' "stereo"
L = 1 '"left"
R = 2 '"right"
End Enum
Enum Playstate
停止 = 1
暂停 = 2
播放 = 3
End Enum
Dim hWndMusic As Long
Dim prevWndproc As Long


'打开MCI设备，FILENAME为文件名,传值代表成功与否
Public Function OpenMusic(FileName As String , Optional Hwnd As Long ) As Boolean
OpenMusic = False
Dim ShortPathName As String * 255
Dim RefShortName As String
Dim RefInt As Long
Dim MciCommand As String
Dim DriverID As String

CloseMusic '关闭 已经打开的歌曲 才可以打开新的歌曲
'获取短文件名
GetShortPathName FileName, ShortPathName, 255
RefShortName = Left(ShortPathName, InStr( 1 , ShortPathName, Chr( 0 )) - 1 )
'MCI命令
DriverID = GetDriverID(RefShortName)
If DriverID = "RealPlayer" Then
PlayType = RealPlay
Exit Function
End If
MciCommand = "open " & RefShortName & " type " & DriverID & " alias NOWMUSIC"

'根据不同的格式加载不同的解码器

If DriverID = "AVIVideo" Or DriverID = "MPEGVideo" Or DriverID = "MPEGVideo2" Then
If Hwnd <> 0 Then
MciCommand = MciCommand + " parent " & Hwnd & " style child"
hWndMusic = GetWindowHandle
prevWndproc = GetWindowLong(hWndMusic, - 4 )
SetWindowLong hWndMusic, - 4 , AddressOf WndProc
Else
MciCommand = MciCommand + " style overlapped "
End If
End If

RefInt = mciSendString(MciCommand, vbNull, 0 , 0 )
mciSendString "set NOWMUSIC time format milliseconds" , vbNullString, 0 , 0
If RefInt = 0 Then
OpenMusic = True
LrcForm.LRC1.Sotp '关闭 已经打开的歌词
SongName = Trim$(Mid$(FileName, InStrRev(FileName, "\" ) + 1 , Len(FileName))) & " " '滤除前面的路径
Naccuracy = 0 '还原歌词调整值 为 0
End If
End Function
Function WndProc( ByVal Hwnd As Long , ByVal Msg As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long
If Msg = &H202 Then
MsgBox "OK"
End If
WndProc = CallWindowProc(prevWndproc, Hwnd, Msg, wParam, lParam)
End Function

'根据文件名，确定设备
Public Function GetDriverID(ff As String ) As String
Select Case UCase(Right(ff, 3 ))
Case "MID" , "RMI" , "IDI"
GetDriverID = "Sequencer"
Case "WAV"
GetDriverID = "Waveaudio"
Case "ASX" , "IVF" , "LSF" , "LSX" , "P2V" , "WAX" , "WVX" , ".WM" , "WMX" , "WMP"
GetDriverID = "MPEGVideo2"
Case ".RM" , "RAM" , ".RA" , "MVB"
GetDriverID = "RealPlayer"
Case Else
GetDriverID = "MPEGVideo"
End Select
End Function


'播放文件
Public Function PlayMusic() As Boolean
Dim RefInt As Long
PlayMusic = False
RefInt = mciSendString( "play NOWMUSIC" , vbNull, 0 , 0 )
If RefInt = 0 Then
PlayMusic = True : DownloadLrc '加载 或下 载歌词
SetVolume ((Mian.Button1( 6 ).Left - 660 )) / 640 * 1000 '计算当前音量大小 '最大为1000
'检测播放速度 800 慢 1200 快
If menu.SpeedDown.Checked Then SetSpeed 800
If menu.SpeedUp.Checked Then SetSpeed 1200
'检测声道 默认 立体
If menu.AudioLeft.Checked Then SetAudioSource L '左声道
If menu.AudioRight.Checked Then SetAudioSource R
End If
End Function


'获取媒体的长度
Public Function GetMusicLength() As Long
Dim RefStr As String * 80
mciSendString "status NOWMUSIC length" , RefStr, 80 , 0
GetMusicLength = Val(RefStr)
End Function

'获取媒体的长度 00:00
Public Function GetMusicLengthString() As String
Dim RefStr As String * 80
mciSendString "status NOWMUSIC length" , RefStr, 80 , 0
GetMusicLengthString = CStr (Format(Int(Val(RefStr) \ 1000 \ 60 ), "00" ) & "：" & Format(Val(RefStr) \ 1000 Mod 60 , "00." ) & Val(RefStr) \ 100 Mod 10 )
End Function
'设置当前播放进度条的长度 最长是 1980

Public Function HScrollWidth() As Long
Dim RefStr As String * 80
mciSendString "status NOWMUSIC position" , RefStr, 80 , 0
If Int(Val(RefStr)) <= 0 Then HScrollWidth = 1980 : Exit Function
HScrollWidth = 1980 / GetMusicLength * Val(RefStr) ' * 1980
End Function
'设置当前播放进度条的长度和播放位置

Public Sub HScrollValue(Value As Single )
SetMusicPos (( 1980 - ( 4240 - Value)) / 1980 * GetMusicLength) ' * Val(RefStr) ' * 1980
End Sub

'获取当前播放进度 毫秒
Public Function GetMusicPos() As Long
Dim RefStr As String * 80
mciSendString "status NOWMUSIC position" , RefStr, 80 , 0
GetMusicPos = Val(RefStr)
End Function

'获取当前播放进度 格式 00：00.0
Public Function GetMusicPosString() As String
Dim RefStr As String * 80
mciSendString "status NOWMUSIC position" , RefStr, 80 , 0
GetMusicPosString = CStr (Format(Int(Val(RefStr) \ 1000 \ 60 ), "00" ) & "：" & Format(Val(RefStr) \ 1000 Mod 60 , "00." ) & Val(RefStr) \ 100 Mod 10 )
End Function

'获取媒体的当前进度
Public Function SetMusicPos(Position As Long ) As Boolean
Dim RefInt As Long
SetMusicPos = False
RefInt = mciSendString( "seek NOWMUSIC to " & Position, vbNull, 0 , 0 )
If RefInt = 0 Then PlayMusic: SetMusicPos = True
End Function

'暂停播放
Public Function PauseMusic() As Boolean
Dim RefInt As Long
PauseMusic = False
RefInt = mciSendString( "pause NOWMUSIC" , vbNull, 0 , 0 )
If RefInt = 0 Then PauseMusic = True
End Function

'关闭媒体
Public Function CloseMusic() As Boolean
Dim RefInt As Long
CloseMusic = False
RefInt = mciSendString( "close NOWMUSIC" , vbNull, 0 , 0 )
If RefInt = 0 Then CloseMusic = True
End Function

'全屏播放
Public Function PlayFullScreen() As Boolean
Dim RefInt As Long
PlayFullScreen = False
RefInt = mciSendString( "play NOWMUSIC fullscreen" , vbNull, 0 , 0 )
If RefInt = 0 Then PlayFullScreen = True
End Function

'设置声音大小
Public Function SetVolume(Volume As Long ) As Boolean
Dim RefInt As Long
SetVolume = False
RefInt = mciSendString( "setaudio NOWMUSIC volume to " & Volume, vbNull, 0 , 0 )
If RefInt = 0 Then SetVolume = True
End Function
'设置声道
'======================================================
Public Function SetAudioSource(sAudioSource As AudioSource) As Boolean
Dim RefInt As Long
Dim strSource As String
Select Case sAudioSource
Case 1 : strSource = "left"
Case 2 : strSource = "right"
Case 0 : strSource = "stereo"
End Select
SetAudioSource = False
RefInt = mciSendString( "setaudio NOWMUSIC source to " & strSource, vbNull, 0 , 0 )
If RefInt = 0 Then SetAudioSource = True
End Function

'设置播放速度
Public Function SetSpeed(Speed As Long ) As Boolean
Dim RefInt As Long
SetSpeed = False
RefInt = mciSendString( "set NOWMUSIC speed " & Speed, vbNull, 0 , 0 )
If RefInt = 0 Then SetSpeed = True
End Function

'静音True为静音，FALSE为取消静音
Public Function SetAudioOnOff(AudioOff As Boolean ) As Boolean
Dim RefInt As Long
Dim OnOff As String
SetAudioOff = False
If AudioOff Then OnOff = "off" Else OnOff = "on"
RefInt = mciSendString( "setaudio NOWMUSIC " & OnOff, vbNull, 0 , 0 )
If RefInt = 0 Then SetAudioOff = True
End Function

'获得当前媒体的状态是不是在播放
Public Function IsPlaying() As Playstate
Dim sl As String * 255
mciSendString "status NOWMUSIC mode" , sl, Len(sl), 0
'MsgBox sl
If Left(sl, 7 ) = "playing" Or Left(sl, 2 ) = "播放" Then
IsPlaying = 播放
ElseIf Left(sl, 7 ) = "stopped" Or Left(sl, 2 ) = "停止" Then
IsPlaying = 停止
Else
IsPlaying = 暂停
End If
End Function

'获得播放窗口的handle
Public Function GetWindowHandle() As Long
Dim RefStr As String * 160
mciSendString "status NOWMUSIC window handle" , RefStr, 80 , 0
GetWindowHandle = Val(RefStr)
End Function

'获取DeviceID
Public Function GetDeviceID() As Long
GetDeviceID = mciGetDeviceID( "NOWMUSIC" )
End Function