VB 多種格式的音樂(lè )播放模塊
Public Declare Function mciSendString Lib "winmm.dll" Alias"mciSendStringA" (ByVal lpstrCommand As String, ByVallpstrReturnString As String, ByVal uReturnLength As Long, ByValhwndCallback 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" (ByValuDeviceID As Long, lpdwVolume As Long) As Long
Public Declare Function GetWindowLong Lib "USER32" Alias"GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) AsLong
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) AsLong
Public Declare Function SetWindowLong Lib "USER32" Alias"SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByValdwNewLong As Long) As Long
Public Declare Function GetShortPathName Lib "kernel32" Alias"GetShortPathNameA" (ByVal lpszLongPath As String, ByVallpszShortPath 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
'打開(kāi)MCI設備，FILENAME為文件名,傳值代表成功與否
Public Function OpenMusic(FileName As String, Optional Hwnd AsLong) 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 '關(guān)閉 已經(jīng)打開(kāi)的歌曲 才可以打開(kāi)新的歌曲
'獲取短文件名
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 & " stylechild"
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 '關(guān)閉 已經(jīng)打開(kāi)的歌詞
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, ByValwParam 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
'獲取媒體的長(cháng)度
Public Function GetMusicLength() As Long
Dim RefStr As String * 80
mciSendString "status NOWMUSIC length", RefStr, 80, 0
GetMusicLength = Val(RefStr)
End Function
'獲取媒體的長(cháng)度 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
'設置當前播放進(jìn)度條的長(cháng)度 最長(cháng)是 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: ExitFunction
HScrollWidth = 1980 / GetMusicLength * Val(RefStr) ' * 1980
End Function
'設置當前播放進(jìn)度條的長(cháng)度和播放位置
Public Sub HScrollValue(Value As Single)
SetMusicPos ((1980 - (4240 - Value)) / 1980 * GetMusicLength) ' *Val(RefStr) ' * 1980
End Sub
'獲取當前播放進(jìn)度 毫秒
Public Function GetMusicPos() As Long
Dim RefStr As String * 80
mciSendString "status NOWMUSIC position", RefStr, 80, 0
GetMusicPos = Val(RefStr)
End Function
'獲取當前播放進(jìn)度 格式 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
'獲取媒體的當前進(jìn)度
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
'關(guān)閉媒體
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) AsBoolean
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
'獲得當前媒體的狀態(tài)是不是在播放
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
聯(lián)系客服
