[原]vb.net使用Directshow.net寫的播放控件_Jerry's DotNe...

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   ‘用于获取媒体现在的播放位置
    Private CurrentState As PlayState    ’用于保存播放状态
    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

    '定义播放状态
    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

    '获取现在的播放状态
    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的通知，并激发相应事件
    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

    '获取播放进度的百分数
    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

    '获取现在所播放的时间
    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

    '实现按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

    '媒体载入及初始化函数
    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)    ’设置窗口模式，这里设置为子窗口且停靠于父容器

                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()   ’发出事件通知，表示一切就绪

        Catch ex As Exception
            CleanUP()
            RaiseEvent ErrorEvent(ErrorCodes.LoadError)
        End Try

    End Sub

    '释放资源函数
    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)    ’将监视窗口的句柄设为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