|
''''用MCI命令来实现多媒体的播放功能
''''下面的内容几乎有播放器软件的各种功能，你只是引用这些函数就能做出一个播放器来
''''
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
AudioStereo = 0 '''' "stereo"
AudioLeft = 1 ''''"left"
AudioRight = 2 ''''"right"
End Enum
Dim hWndMusic As Long
Dim prevWndproc As Long
''''=======================================================
''''打开MCI设备，urlStr为网址,传值代表成功与否
''''=======================================================
Public Function OpenURL(urlStr As String, Optional hwnd As Long) As Boolean
OpenMusic = False
Dim MciCommand As String
Dim DriverID As String
CloseMusic
''''MCI命令
DriverID = GetDriverID(urlStr)
If DriverID = "RealPlayer" Then
PlayType = RealPlay
Exit Function
End If
MciCommand = "open " & urlStr & " 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
End Function
''''=======================================================
''''打开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
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 "ASF", "ASX", "IVF", "LSF", "LSX", "P2V", "WAX", "WVX", ".WM", "WMA", "WMX", "WMP"
GetDriverID = "MPEGVideo2"
Case ".RM", "RAM", ".RA"
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
End Function
''''======================================================
''''获取媒体的长度
''''======================================================
Public Function GetMusicLength() As Long
Dim RefStr As String * 80
mciSendString "status NOWMUSIC length", RefStr, 80, 0
GetMusicLength = Val(RefStr)
End Function
''''======================================================
''''获取当前播放进度
''''======================================================
Public Function GetMusicPos() As Long
Dim RefStr As String * 80
mciSendString "status NOWMUSIC position", RefStr, 80, 0
GetMusicPos = Val(RefStr)
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 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
''''==================================== [1] [2] 下一页
[VB.NET程序]VB.NET中实现IEnumerator接口 [VB.NET程序]在VB中实现PickList功能
[Delphi程序]用API函数在DELPHI中实现“非典型”窗体 [Delphi程序]在Delphi中实现StringTokenizer功能模块
[网页制作]DW中实现flash的透明背景 [网页制作]Dreamweaver中实现flash的透明背景
[Web开发]ASP.NET 中实现 MD5_HMAC(C#) [Web开发]在ASP 中实现ASP.Net 的DataGrid 功能(转载）
[Web开发]在ASP.NET中实现MVC模式（五） [Web开发]在ASP.NET中实现MVC模式（四）
|
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
