Attribute VB_Name = "ActiveMovieControl"
 
OPTION Explicit
OPTION BASE 0
OPTION Compare Text

Private m_dblRate AS DOUBLE                'Rate in Frames Per Second
Private m_bstrFileName AS STRING           'Loaded Filename
Private m_dblRunLength AS DOUBLE           'Duration in seconds
Private m_dblStartPosition AS DOUBLE       'Start position in seconds
Public m_boolVideoRunning AS Boolean       'Flag used to trigger clock
Private dblPosition AS DOUBLE              ' Current Play position
Private m_objBasicAudio  AS IBasicAudio      'Basic Audio Object
Private m_objBasicVideo AS IBasicVideo       'Basic Video Object
Private m_objMediaEvent AS IMediaEvent       'MediaEvent Object
Private m_objVideoWindow AS IVideoWindow     'VideoWindow Object
Private m_objMediaControl AS IMediaControl   'MediaControl Object
Private m_objMediaPosition AS IMediaPosition 'MediaPosition Object
           
           
                     
     'Main Video Loading codes
     'method to load video file
SUB RunVideoContent(BYVAL path AS STRING, Optional BYVAL DontMaintainRatio AS Boolean, Optional BYVAL FullScreen AS Boolean)
    DIM nCount AS LONG
    DIM sScale AS DOUBLE
    DIM topMod AS LONG
    ON LOCAL ERROR GOTO ErrLine
     
        ' NOTE: to get the clip duration use - m_dblRunLength

        ' Initialize global variables based on the
        ' contents of the file:
        '   m_bstrFileName - name of file name selected by the user
        '   m_dblRunLength = length of the file; duration
        '   m_dblStartPosition - point at which to start playing clip
        '   m_objMediaControl, m_objMediaEvent, m_objMediaPosition,
        '   m_objBasicAudio, m_objVideoWindow - programmable objects
   
        'clean up memory (in case a file was previously opened)
    UnloadActiveMovieControl
   
        ' Setting file to object
    m_bstrFileName = path
   
        'Instantiate a filter graph for the requested
        'file format.
    Set m_objMediaControl = New FilgraphManager
    CALL m_objMediaControl.RenderFile(m_bstrFileName)
   
        'Setup the IBasicAudio object (this
        'is equivalent to calling QueryInterface()
        'on IFilterGraphManager). Initialize the volume
        'to the maximum value.
   
        ' Some filter graphs don't render audio
        ' In this sample, skip setting volume property
    Set m_objBasicAudio = m_objMediaControl
    m_objBasicAudio.Volume = 0
    m_objBasicAudio.Balance = 0
   
        'Setup the IVideoWindow object. Remove the
        'caption, border, dialog frame, and scrollbars
        'from the default window. Position the window.
        'Set the parent to the app's form.
    Set m_objVideoWindow = m_objMediaControl
    m_objVideoWindow.WindowStyle = CLNG(&H6000000)
    m_objVideoWindow.Left = 0
        ' Getting Scale Ratio
    sScale = m_objVideoWindow.Height / m_objVideoWindow.WIDTH
        ' Setting object width
    m_objVideoWindow.WIDTH = Video_ActiveMovie.Video.WIDTH
    IF NOT (DontMaintainRatio) THEN
        m_objVideoWindow.Height = Video_ActiveMovie.Video.WIDTH * sScale
        topMod = (Video_ActiveMovie.Video.Height - m_objVideoWindow.Height) / 2
    ELSE
        m_objVideoWindow.Height = Video_ActiveMovie.Video.Height
    END IF
    m_objVideoWindow.Top = topMod
        ' Setting FullScreen Mode
    m_objVideoWindow.FullScreenMode = FullScreen
        'reset the video window owner - The surface the video is implemented upon
    m_objVideoWindow.Owner = Video_ActiveMovie.Video.hWnd
   
        'Setup the IMediaEvent object for the
        'sample toolbar (run, pause, play).
    Set m_objMediaEvent = m_objMediaControl
   
        'Setup the IMediaPosition object so that we
        'can display the duration of the selected
        'video as well as the elapsed time.
    Set m_objMediaPosition = m_objMediaControl
   
        'set the playback rate given the desired optional
    m_objMediaPosition.Rate = 1 ' Normal play rate
                                ' NOTE: you can set values like 1.5 for 150% speed, pretty nice
        ' Use user-established playback rate
    m_dblRate = m_objMediaPosition.Rate
        ' getting play length
    m_dblRunLength = Round(m_objMediaPosition.Duration, 2)
        ' Reset start position to 0
    m_dblStartPosition = 0
   
        ' Play the file
    PlayActiveMovie
    EXIT SUB
   
ErrLine:
    ERR.CLEAR
    RESUME NEXT
END SUB
           
    ' ****************************************************
    ' ****   Unloading Control from memory
    ' ****
SUB UnloadActiveMovieControl()
    ON LOCAL ERROR GOTO ErrLine
   
    'stop playback
    m_boolVideoRunning = False
    DoEvents
    'cleanup media control
    IF NOT m_objMediaControl IS Nothing THEN
        m_objMediaControl.STOP
    END IF
    'clean-up video window
    IF NOT m_objVideoWindow IS Nothing THEN
        m_objVideoWindow.Left = SCREEN.WIDTH * 8
        m_objVideoWindow.Height = SCREEN.Height * 8
        m_objVideoWindow.Owner = 0          'sets the Owner to NULL
    END IF
           
    'clean-up & dereference
    IF NOT m_objBasicAudio IS Nothing THEN Set m_objBasicAudio = Nothing
    IF NOT m_objBasicVideo IS Nothing THEN Set m_objBasicVideo = Nothing
    IF NOT m_objMediaControl IS Nothing THEN Set m_objMediaControl = Nothing
    IF NOT m_objVideoWindow IS Nothing THEN Set m_objVideoWindow = Nothing
    IF NOT m_objMediaPosition IS Nothing THEN Set m_objMediaPosition = Nothing
    EXIT SUB
           
ErrLine:
    ERR.CLEAR
END SUB
           

    ' ****************************************************
    ' ****   Control Methods
    ' ****      Play,Pause & Stop

SUB PlayActiveMovie()
    ON LOCAL ERROR GOTO errHandle
   
    'Invoke the MediaControl Run() method
    'and pause the video that is being
    'displayed through the predefined
    'filter graph.
   
    'Assign specified starting position dependent on state
    IF CLNG(m_objMediaPosition.CurrentPosition) < CLNG(m_dblStartPosition) THEN
        m_objMediaPosition.CurrentPosition = m_dblStartPosition
    ELSEIF CLNG(m_objMediaPosition.CurrentPosition) = CLNG(m_dblRunLength) THEN
        m_objMediaPosition.CurrentPosition = m_dblStartPosition
    END IF
   
    m_boolVideoRunning = True
    CALL m_objMediaControl.RUN
   
   
    EXIT SUB
errHandle:
    ERR.CLEAR
    RESUME NEXT
    'logerror
END SUB

SUB PauseActiveMovie()
    ON LOCAL ERROR GOTO errHandle
        ' Validating state
    IF NOT (m_boolVideoRunning) THEN EXIT SUB
        ' Pausing
    CALL m_objMediaControl.Pause
        ' setting state
    m_boolVideoRunning = False
   
    EXIT SUB
errHandle:
    ERR.CLEAR
    'logerror
END SUB

SUB StopActiveMovie()
    ON LOCAL ERROR GOTO errHandle
        ' Validating state
    IF NOT (m_boolVideoRunning) THEN EXIT SUB
        ' Stopping
    CALL m_objMediaControl.STOP
        ' setting state
    m_boolVideoRunning = False
        ' reset to the beginning of the video
    m_objMediaPosition.CurrentPosition = 0
   
    EXIT SUB
errHandle:
    ERR.CLEAR
    'logerror
END SUB
                       

    ' ****************************************************
    ' ****   Various Setting methods
    ' ****
SUB SetActiveMovieBalance(BYVAL Value AS LONG)
    ON LOCAL ERROR GOTO ErrLine
    'Set the balance using the slider
    IF NOT m_objMediaControl IS Nothing THEN _
        m_objBasicAudio.Balance = Value
    EXIT SUB
ErrLine:
    ERR.CLEAR
END SUB

SUB SetActiveMovieVolume(BYVAL Value AS LONG)
    ON LOCAL ERROR GOTO ErrLine
           
    'Set the volume using the slider
    IF NOT m_objMediaControl IS Nothing THEN _
        m_objBasicAudio.Volume = Value
    EXIT SUB
       
ErrLine:
    ERR.CLEAR
END SUB
           
    ' ****************************************************
    ' ****   Info retrival Functions
    ' ****
FUNCTION GetVideoLength() AS DOUBLE
    GetVideoLength = m_dblRunLength
END FUNCTION
   
FUNCTION GetVideoPos() AS DOUBLE
    dblPosition = m_objMediaPosition.CurrentPosition
    GetVideoPos = dblPosition
END FUNCTION

FUNCTION VideoRunning() AS Boolean
    VideoRunning = m_boolVideoRunning
END FUNCTION
           
    ' ****************************************************
    ' ****   The Timer event
    ' ****
Public SUB ActiveMovieTimerEvent()
    DIM nReturnCode AS LONG
   
    ON LOCAL ERROR GOTO errHandle
   
    IF m_boolVideoRunning = True THEN
            'obtain return code
        CALL m_objMediaEvent.WaitForCompletion(100, nReturnCode)
               
               
        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
            Video_ActiveMovie.VideoFinishedEvent
        END IF
    END IF
    EXIT SUB
errHandle:
    'NOTE: Keep this as this method repeatedly raises errors
    '      without caring for my mental health
    ERR.CLEAR
    RESUME NEXT
END SUB