Imports DirectShowLib ‘導入Directshow.net
Imports System.Runtime.InteropServices ’導入該庫可獲得對COM組建的操作支持
Public Class JRMPActiveX ’控件名
'一下是必須變量的聲明
Private NewMediaName As String
Private fg As IGraphBuilder ’這就是所謂的過濾器圖表，播放的核心
Private MyMediaControl As IMediaControl ‘用于控制媒體的播放
Private MyMediaEventEx As IMediaEventEx ’用于獲取Directshow的事件通知
Private MediaAudio As IBasicAudio ‘用于控制媒體的聲音
Private MediaVideoWindow As IVideoWindow ’用于控制視頻的播放窗口
Private MediaVeido As IBasicVideo ‘用于控制視頻
Private MediaPosition As IMediaPosition ’用于控制媒體的播放點
Private MediaSeeking As IMediaSeeking ‘用于獲取媒體現(xiàn)在的播放位置
Private CurrentState As PlayState ’用于保存播放狀態(tài)
Private CurrentPlaySpeed As Double ‘保存播放速度
Private CurrentVolume As Integer = 0 ’保存音量大小
Private CurrentBalance As Integer = 0 ’保存音量平衡值
Private Const WMGraphNotify As Integer = &H400 + 13 ‘定義消息常量，通知窗口是否播放完畢
Delegate Sub ML() '加載媒體事件
Public Event MediaLoad As ML
Delegate Sub ErrorE(ByVal ErrorCode As Integer) '加載媒體錯誤事件
Public Event ErrorEvent As ErrorE
Delegate Sub MFinished() '媒體播放完成事件
Public Event MediaFinished As MFinished
Delegate Sub MStop() '停止播放媒體事件
Public Event MediaStop As MStop
Delegate Sub MRun() '開始播放媒體事件
Public Event MediaRun As MRun
Delegate Sub MPause() '暫停播放媒體事件
Public Event MediaPause As MPause
Delegate Sub MReady() '媒體就緒事件
Public Event MediaReady As MReady
Delegate Sub MClean()
Public Event MediaClean As MClean
'定義錯誤代碼
Private Enum ErrorCodes As Integer
LoadError
RunMediaError
PauseMediaError
StopMediaError
CleanUpMediaError
UnKnowError
SetPositionError
End Enum
'定義播放狀態(tài)
Private Enum PlayState As Integer
Stopped
Paused
Running
Init
End Enum
'設置或獲取播放音量
Public Property Volume() As Integer
Get
Return CurrentVolume
End Get
Set(ByVal value As Integer)
If MediaAudio IsNot Nothing Then
Dim hr As Integer = MediaAudio.get_Volume(CurrentVolume)
If hr >= 0 Then
MediaAudio.put_Volume(value)
End If
End If
CurrentVolume = value
End Set
End Property
'設置或獲取播放音量平衡
Public Property Balance() As Integer
Get
Return CurrentBalance
End Get
Set(ByVal value As Integer)
If MediaAudio IsNot Nothing Then
Dim hr As Integer = MediaAudio.get_Balance(CurrentBalance)
If hr >= 0 Then
MediaAudio.put_Balance(value)
End If
End If
CurrentBalance = value
End Set
End Property
'獲取現(xiàn)在的播放狀態(tài)
Public ReadOnly Property NowPlayState() As Integer
Get
Return CurrentState
End Get
End Property
'設置或獲取媒體播放速度
Public Property PlaySpeed() As Double
Get
Return CurrentPlaySpeed
End Get
Set(ByVal value As Double)
If MediaPosition IsNot Nothing Then
Dim hr As Integer = MediaPosition.put_Rate(value)
If hr >= 0 Then
CurrentPlaySpeed = value
End If
End If
End Set
End Property
'停止播放當前媒體
Public Sub CtrStop()
Try
If MyMediaControl IsNot Nothing Then
Dim hr As Integer = MyMediaControl.Stop()
If hr >= 0 Then
CurrentState = PlayState.Stopped
If MediaPosition IsNot Nothing Then
MediaPosition.put_CurrentPosition(0)
End If
RaiseEvent MediaStop()
End If
End If
Catch ex As Exception
RaiseEvent ErrorEvent(ErrorCodes.StopMediaError)
End Try
End Sub
'開始播放當前媒體
Public Sub CtrRun()
Try
If MyMediaControl IsNot Nothing Then
Dim hr As Integer = MyMediaControl.Run()
If hr >= 0 Then
CurrentState = PlayState.Running
RaiseEvent MediaRun()
End If
End If
Catch ex As Exception
RaiseEvent ErrorEvent(ErrorCodes.RunMediaError)
End Try
End Sub
'暫停播放當前媒體
Public Sub CtrPause()
Try
If MyMediaControl IsNot Nothing Then
Dim hr As Integer = MyMediaControl.Pause()
If hr >= 0 Then
CurrentState = PlayState.Paused
RaiseEvent MediaPause()
End If
End If
Catch ex As Exception
RaiseEvent ErrorEvent(ErrorCodes.PauseMediaError)
End Try
End Sub
'重寫WndProc以獲取DirectShow的通知，并激發(fā)相應事件
Protected Overrides Sub WndProc(ByRef m As Message)
If m.Msg = WMGraphNotify Then
Dim NowPosition As Long
Dim StopPosition As Long
MediaSeeking.GetPositions(NowPosition, StopPosition)
If NowPosition = StopPosition Then
RaiseEvent MediaFinished()
End If
End If
MyBase.WndProc(m)
End Sub
'獲取播放進度的百分數(shù)
Public ReadOnly Property PlayPercent() As Double
Get
Try
Dim NowPosition As Long
Dim StopPosition As Long
If MediaSeeking IsNot Nothing Then
MediaSeeking.GetPositions(NowPosition, StopPosition)
Return NowPosition / StopPosition
End If
Catch ex As Exception
RaiseEvent ErrorEvent(ErrorCodes.UnKnowError)
End Try
End Get
End Property
'獲取媒體總時間
Public ReadOnly Property StopTime() As Double
Get
Try
If MediaPosition IsNot Nothing Then
Dim StPo As Double
Dim hr As Integer = MediaPosition.get_StopTime(StPo)
If hr >= 0 Then
Return StPo
End If
End If
Catch ex As Exception
RaiseEvent ErrorEvent(ErrorCodes.UnKnowError)
End Try
End Get
End Property
'獲取現(xiàn)在所播放的時間
Public ReadOnly Property CurTime() As Double
Get
Try
If MediaPosition IsNot Nothing Then
Dim StPo As Double
Dim hr As Integer = MediaPosition.get_CurrentPosition(StPo)
If hr >= 0 Then
Return StPo
End If
End If
Catch ex As Exception
RaiseEvent ErrorEvent(ErrorCodes.UnKnowError)
End Try
End Get
End Property
'設置或獲取媒體播放點
Public Property SetOrGetPosition() As Double
Get
Try
If MediaPosition IsNot Nothing Then
Dim NowPosition As Double
MediaPosition.get_CurrentPosition(NowPosition)
Return NowPosition
End If
Catch ex As Exception
RaiseEvent ErrorEvent(ErrorCodes.SetPositionError)
End Try
End Get
Set(ByVal value As Double)
Try
If MediaPosition IsNot Nothing Then
MediaPosition.put_CurrentPosition(value)
End If
Catch ex As Exception
RaiseEvent ErrorEvent(ErrorCodes.SetPositionError)
End Try
End Set
End Property
'將秒格式化為“時：分：秒”格式
Public Function ShowTime(ByVal mstime As Double) As String
Dim hh As Integer = mstime \ 3600
Dim ss As Integer = (mstime - 3600 * hh) \ 60
Dim ms As Integer = CInt(mstime - 3600 * hh - ss * 60)
Dim strhh As String = CStr(hh)
Dim strss As String = CStr(ss)
Dim strms As String = CStr(ms)
If hh < 10 Then
strhh = "0" & strhh
End If
If ss < 10 Then
strss = "0" & strss
End If
If ms < 10 Then
strms = "0" & strms
End If
Return strhh & ":" & strss & ":" & strms
End Function
'設置視頻是否全屏播放
Public Property IsFullScreen() As Boolean
Get
If MediaVideoWindow IsNot Nothing Then
Dim booIsFullScreen As Boolean
MediaVideoWindow.get_FullScreenMode(booIsFullScreen)
Return booIsFullScreen
Else
Return False
End If
End Get
Set(ByVal value As Boolean)
If MediaVideoWindow IsNot Nothing Then
MediaVideoWindow.put_FullScreenMode(value)
End If
End Set
End Property
'實現(xiàn)按ESC退出全屏
Private Sub JRMPActiveX_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles Me.KeyPress
If e.KeyChar = CChar(ChrW(27)) Then
IsFullScreen = False
End If
End Sub
'讓視頻窗口大小改變時，視頻尺寸也跟著改變
Private Sub PictureBox1_SizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox1.SizeChanged
If MediaVideoWindow IsNot Nothing AndAlso MediaVeido IsNot Nothing Then
MediaVideoWindow.SetWindowPosition(Me.ClientRectangle.Left, Me.ClientRectangle.Top, Me.ClientRectangle.Width, Me.ClientRectangle.Height)
End If
End Sub
'媒體載入接口
Public Sub OpenMedia(ByVal FileName As String)
RaiseEvent MediaLoad()
CleanUP()
NewMediaName = FileName
LoadMedia()
End Sub
'媒體載入及初始化函數(shù)
Private Sub LoadMedia()
Try
Dim hr As Integer
fg = New FilterGraph ’獲取過濾器圖表對象
MyMediaControl = DirectCast(fg, IMediaControl) ‘以下：從過濾器圖表的對象中可獲取各分對象，用DirectCast轉化類型的效率要高一些。
MediaPosition = DirectCast(fg, IMediaPosition)
MediaSeeking = DirectCast(fg, IMediaSeeking)
MediaAudio = DirectCast(fg, IBasicAudio)
MediaVeido = DirectCast(fg, IBasicVideo)
MediaVideoWindow = DirectCast(fg, IVideoWindow)
MyMediaEventEx = DirectCast(fg, IMediaEvent)
'建立過濾器圖表，也就是加載媒體文件
hr = fg.RenderFile(NewMediaName, Nothing)
DsError.ThrowExceptionForHR(hr)
If MediaVideoWindow IsNot Nothing AndAlso MediaVeido IsNot Nothing Then '判斷加載的媒體是純音樂還是有視頻
MediaVideoWindow.put_Owner(Me.Handle) ’設置播放窗口為自身
MediaVideoWindow.put_Visible(OABool.True)
MediaVideoWindow.put_MessageDrain(Me.Handle) ‘設置此窗口為可接受事件
MediaVideoWindow.put_WindowStyle(WindowStyle.Child Or WindowStyle.ClipSiblings Or WindowStyle.ClipChildren) ’設置窗口模式，這里設置為子窗口且?？坑诟溉萜?/p>
MediaVideoWindow.SetWindowPosition(Me.ClientRectangle.Left, Me.ClientRectangle.Top, Me.ClientRectangle.Width, Me.ClientRectangle.Height) ‘設置窗口大小
End If
MediaAudio.put_Volume(CurrentVolume) ‘設置音量和平衡
MediaAudio.put_Balance(CurrentBalance)
'設置事件處理窗口，這里設置為自身
MyMediaEventEx.SetNotifyWindow(Me.Handle, WMGraphNotify, IntPtr.Zero)
RaiseEvent MediaReady() ’發(fā)出事件通知，表示一切就緒
Catch ex As Exception
CleanUP()
RaiseEvent ErrorEvent(ErrorCodes.LoadError)
End Try
End Sub
'釋放資源函數(shù)
Public Sub CleanUP()
Try
RaiseEvent MediaClean()
CloseInterface()
CurrentState = PlayState.Init
Catch ex As Exception
RaiseEvent ErrorEvent(ErrorCodes.CleanUpMediaError)
End Try
End Sub
'釋放資源
Private Sub CloseInterface()
If MyMediaEventEx IsNot Nothing Then
MyMediaEventEx.SetNotifyWindow(IntPtr.Zero, 0, IntPtr.Zero) ’將監(jiān)視窗口的句柄設為0
MyMediaEventEx = Nothing
End If
If MyMediaControl IsNot Nothing Then MyMediaControl = Nothing
If MediaAudio IsNot Nothing Then MediaAudio = Nothing
If MediaVeido IsNot Nothing Then MediaVeido = Nothing
If MediaVideoWindow IsNot Nothing Then MediaVideoWindow = Nothing
If MediaSeeking IsNot Nothing Then MediaSeeking = Nothing
If MediaPosition IsNot Nothing Then MediaPosition = Nothing
If fg IsNot Nothing Then Marshal.FinalReleaseComObject(fg)
fg = Nothing
GC.Collect() ‘強制垃圾回收器立即進行回收
End Sub
End Class
