MCI播放器在VB中实现

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

'用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

'======================================================

'设置声道

'======================================================

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 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 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

'====================================================

'是否有画面True为有,FALSE为取消

'====================================================

Public Function SetWindowShow(WindowOff As Boolean) As Boolean

Dim RefInt As Long

Dim OnOff As String

SetWindowShow = False

If WindowOff Then OnOff = "show" Else OnOff = "hide"

RefInt = mciSendString("window NOWMUSIC state " & OnOff, vbNull, 0, 0)

If RefInt = 0 Then SetWindowShow = True

End Function

'====================================================

'获得当前媒体的状态是不是在播放

'====================================================

Public Function IsPlaying() As Boolean

Dim sl As String * 255

mciSendString "status NOWMUSIC mode", sl, Len(sl), 0

If Left(sl, 7) = "playing" Or Left(sl, 2) = "播放" Then

IsPlaying = True

Else

IsPlaying = False

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航