急，用DIRECTSHOW制作视频播放程序的时候如何才能捕捉EC_COMPLETE消息以达到自动循环播放的效果？

Question

用DIRECTSHOW制作一个视频播放的VB程序，但是其本身没有提供循环播放的参数，查了资料当FilgraphManager播放结束时会释放一个为EC_COMPLETE的消息，再查资料看到应该是要调用WindowProc函数来捕捉，小弟初学VB不久，试了多种网上的代码都不能正常使用
时间比较紧，有朋友能帮我直接改下代码么？
万分感谢  QQ  282224306
FORM代码如下
Option ExplicitPrivate TextLine  As String  '文字信息
Private Index     As Long    '字符索引Private Scrolling As Boolean '滚动标志
Private t         As Long    '帧延时Private RText     As RECT
Private RClip     As RECT
Private RUpdate   As RECTPrivate Const WS_CHILD = &H40000000
Private Const WS_CLIPCHILDREN = &H2000000Private m_FilGraph     As FilgraphManager
Private m_Video     As IVideoWindowPrivate Function VideoPlay()             '视频播放
        Dim strFileName     As String
        
'        strFileName = App.Path & "\魅力杭州.mpg"     '电影的地址
        strFileName = VIDEOPATH
        
        Set m_FilGraph = New FilgraphManager
        
        m_FilGraph.RenderFile strFileName
        
        Set m_Video = m_FilGraph
        With m_Video
                .Owner = Picture1.hwnd              
                .WindowStyle = WS_CHILD Or WS_CLIPCHILDREN
                .Top = 0
                .Left = 0
                .Width = Picture1.Width / Screen.TwipsPerPixelX
                .Height = Picture1.Height / Screen.TwipsPerPixelY
        End With
        m_FilGraph.Run
End FunctionPrivate Sub cmdExit_Click()         '退出
Set m_FilGraph = Nothing
Set m_Video = Nothing
Unload Me
End SubPrivate Sub Form_Load()              '初始化窗口视频尺寸和公告
VideoPlayer.Left = 0
VideoPlayer.Top = 0
VideoPlayer.Width = Screen.Width
VideoPlayer.Height = Screen.Height
VideoPlayer.AutoRedraw = True
Picture1.AutoRedraw = True
Picture1.Left = 0
Picture1.Top = 0
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
Timer1.Enabled = True
Timer1.Interval = 100
TextLine = ALERTTEXT & "     "End SubPrivate Sub Form_Unload(Cancel As Integer)
    Scrolling = 0 '!
End SubPrivate Function Scroll()      '公告滚动  Dim Char As String    Scrolling = -1
    Index = 1    With iScroll
         SetRect RClip, 1, 2, .ScaleWidth, .ScaleHeight
         SetRect RText, .ScaleWidth, 2, .ScaleWidth + .TextWidth(Left$(TextLine, 1)), .ScaleHeight
    End With    Char = Left$(TextLine, 1)    With iScroll        Do
            If (timeGetTime - t >= 30) Then                t = timeGetTime                If (RText.Right <= .ScaleWidth) Then                    Index = Index + 1
                    Char = Mid$(TextLine, Index, 1)
                    SetRect RText, .ScaleWidth, 2, .ScaleWidth + .TextWidth(Mid$(TextLine, Index, 1)), .ScaleHeight
                End If                DrawText .hdc, Char, 2, RText, &H0                OffsetRect RText, -1, 0                ScrollDC .hdc, -1, 0, RClip, RClip, 0, RUpdate
                iScroll.Line (.ScaleWidth - 2, 0)-(.ScaleWidth - 2, .ScaleHeight - 1), .BackColor
            End If            If (Index > Len(TextLine)) Then Index = 0
            DoEvents        Loop Until Scrolling = 0
    End With
End FunctionPrivate Sub Timer1_Timer()    '播放计时触发Timer1.Enabled = False
Timer1.Interval = 0
VideoPlay
Timer2.Interval = 500
Timer2.Enabled = TrueEnd SubPrivate Sub Timer2_Timer()    '滚动计时触发Timer2.Enabled = False
Timer2.Interval = 0
Scroll
End Submodule代码如下
Public VIDEOPATH As String
Public ALERTTEXT As StringPublic Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End TypePublic Const EM_FMTLINES As Long = &HC8Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function timeGetTime Lib "winmm.dll" () As Long
Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Declare Function ScrollDC Lib "user32" (ByVal hdc As Long, ByVal dx As Long, ByVal dy As Long, lprcScroll As RECT, lprcClip As RECT, ByVal hrgnUpdate As Long, lprcUpdate As RECT) As Long
Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

Answer 1

需要用IMediaEventEx接口设定接收事件的窗口， 然后子类化窗口就可以了。 你可以参考directshow SDK 中的 playerwndswf 示例

Answer 2

没必要搞那么复杂，根据播放时间来判断。Timer中怎么没有计时的程序？

Answer 3

有2种方法：
1。
Private m_objMediaEvent As IMediaEvent       'MediaEvent Object
在你的Timer中调用：
If nReturnCode = 0 Then ' Playing
   'get the current position for display
    dblPosition = m_objMediaPosition.CurrentPosition
Else    ' Stopped
    ' NOTE: only occurs when clip FINISHES playin
    ' Set State
     m_boolVideoRunning = False
    ' Send event
    RaiseEvent VideoFinishedEvent()
 End If2.
Private m_objMediaControl As IMediaControl   'MediaControl Object
同样，在你的Timer中调用
m_objMediaControl.GetState(30，iFilterState)
'2 --- Running
'1---- Pause
'0---- Stop
'See MSDN

Answer 4

你的结贴率太低了，50% only.

Answer 5

3。
Private evEx          As IMediaEventEx
' Event Notifications
    Set evEx = graph
    evEx.SetNotifyFlags 0
    evEx.SetNotifyWindow Me.hWnd, WM_GRAPHEVENT, 0你可以Subclass WM_GRAPHEVENT,Call DirectShowEventCallbackPublic Sub DirectShowEventCallback()
    Dim lngEvent    As Long
    Dim lngParam1   As Long
    Dim lngParam2   As Long    On Error GoTo ExitSub
    Do
        evEx.GetEvent lngEvent, lngParam1, lngParam2, 0
        If lngEvent = 1 Then    ' complete
            Debug.Print "complete"
            graph.Pause
        Else
            Debug.Print "Event: " & lngEvent
        End If
        evEx.FreeEventParams lngEvent, lngParam1, lngParam2
    LoopExitSub:
End Sub