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
相关推荐
'3、使用WindowsMediaPlayer控件,进行音乐文件的播放操作。 '4、拖拽文件到窗体操作进行添加音乐文件播放列表,可修改成图片拖拽或其它文件拖拽。 '5、用模块实现INI文件的读写操作,同步实现了软件版本号的读,写...
4. **灵活的播放列表管理**:用户可自定义播放列表,并支持顺序播放、随机播放等多种播放模式。 5. **完善的数据库设计**:系统采用SQL数据库存储歌曲信息、用户信息等数据,保证了数据的稳定性和安全性。 **二次...
vb.net写的仿QQ音乐播放器。源码,模块及类不可多得。 界面进行了优化,可以播放多种格式。值得下载下来学习学习。
不仅演示了 vb 的图形操作技巧,键盘操作,还演示了怎样使用 npmod32.dll(已包含,免费) 来播mod,s3m,mpp,med,xm,it,mdz,itz,xmz,s3z 等音乐格式文件(208KB) 583,g015.zip 旋转俄罗斯 1.0 demo 版的源程序,vb5 ...
不仅演示了 vb 的图形操作技巧,键盘操作,还演示了怎样使用 npmod32.dll(已包含,免费) 来播mod,s3m,mpp,med,xm,it,mdz,itz,xmz,s3z 等音乐格式文件(208KB) 583,g015.zip 旋转俄罗斯 1.0 demo 版的源程序,vb5 ...
不仅演示了 vb 的图形操作技巧,键盘操作,还演示了怎样使用 npmod32.dll(已包含,免费) 来播mod,s3m,mpp,med,xm,it,mdz,itz,xmz,s3z 等音乐格式文件(208KB) 583,g015.zip 旋转俄罗斯 1.0 demo 版的源程序,vb5 ...
不仅演示了 vb 的图形操作技巧,键盘操作,还演示了怎样使用 npmod32.dll(已包含,免费) 来播mod,s3m,mpp,med,xm,it,mdz,itz,xmz,s3z 等音乐格式文件(208KB) 583,g015.zip 旋转俄罗斯 1.0 demo 版的源程序,vb5 ...
Java局域网通信——飞鸽传书源代码,大家都知道VB版、VC版还有Delphi版的飞鸽传书软件,但是Java版的确实不多,因此这个Java文件传输实例不可错过,Java网络编程技能的提升很有帮助。 Java聊天程序,包括服务端和...
很简单,只能播放mp3格式的音乐。 功能: --------------------------------------- --------关闭-- 打开----最小化------- --------------------------------------- 显示歌曲名字 -------------------- -------...
修改核心支持库,解决用“播放音乐()”播放“音频采样大小为24位”的WAV文件时产生噪音的BUG。 4. 修改编译器,可以为编译出的EXE、DLL添加版本信息(通过“程序配置”设定)。 5. 修改集成开发环境,自动记忆非...
p2p vb实例。 p2p+technology文档。 P2P视频技术源码(含开发文档) PcShare 内含远程控制、进程管理、文件操作、视频控制、注册表操作、客户端服务器端。 redui_src_v0.9.130(DirectUI 3D) DirectUI 3D界面库...
p2p vb实例。 p2p+technology文档。 P2P视频技术源码(含开发文档) PcShare 内含远程控制、进程管理、文件操作、视频控制、注册表操作、客户端服务器端。 redui_src_v0.9.130(DirectUI 3D) DirectUI 3D界面库...
p2p vb实例。 p2p+technology文档。 P2P视频技术源码(含开发文档) PcShare 内含远程控制、进程管理、文件操作、视频控制、注册表操作、客户端服务器端。 redui_src_v0.9.130(DirectUI 3D) DirectUI 3D界面库...
p2p vb实例。 p2p+technology文档。 P2P视频技术源码(含开发文档) PcShare 内含远程控制、进程管理、文件操作、视频控制、注册表操作、客户端服务器端。 redui_src_v0.9.130(DirectUI 3D) DirectUI 3D界面库...
p2p vb实例。 p2p+technology文档。 P2P视频技术源码(含开发文档) PcShare 内含远程控制、进程管理、文件操作、视频控制、注册表操作、客户端服务器端。 redui_src_v0.9.130(DirectUI 3D) DirectUI 3D界面库...
Java局域网通信——飞鸽传书源代码 28个目标文件 内容索引:JAVA源码,媒体网络,飞鸽传书 Java局域网通信——飞鸽传书源代码,大家都知道VB版、VC版还有Delphi版的飞鸽传书软件,但是Java版的确实不多,因此这个Java...