VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDShowControl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' -------------------------------------------------------------------------------
'
'   AVStoDVD - by MrC
'   File: clsDShowControl.cls
'   Purpose: Class that manage DirectShow ActiveMovie control (quartz.dll)
'
' -------------------------------------------------------------------------------



'Option Explicit
'Option Compare Binary
'Option Base 0

Private Const WS_VISIBLE = &H10000000

Private m_objBasicAudio As IBasicAudio
Private m_objBasicVideo As IBasicVideo
Private m_objMediaEvent As IMediaEvent
Private m_objVideoWindow As IVideoWindow
Private m_objMediaControl As IMediaControl
Private m_objMediaPosition As IMediaPosition

Private m_boolVideoRunning As Boolean
Private m_boolHasAudio As Boolean


Public Sub DS_Remove()

    On Local Error GoTo RemoveDShowError
    
    ' If MediaControl has state 1 (pause) or 2 (play), then stop it
    If ObjPtr(m_objMediaControl) > 0 Then
        m_objMediaControl.Stop
    End If
    ' Destroy all objects
    If ObjPtr(m_objBasicAudio) > 0 Then Set m_objBasicAudio = Nothing
    If ObjPtr(m_objBasicVideo) > 0 Then Set m_objBasicVideo = Nothing
    If ObjPtr(m_objMediaControl) > 0 Then Set m_objMediaControl = Nothing
    If ObjPtr(m_objVideoWindow) > 0 Then Set m_objVideoWindow = Nothing
    If ObjPtr(m_objMediaPosition) > 0 Then Set m_objMediaPosition = Nothing
    ' If a VideoWindow instance exists, then remove the link to the render target
    If ObjPtr(m_objVideoWindow) > 0 Then
        m_objVideoWindow.owner = 0
    End If
    
    Exit Sub
    
RemoveDShowError:
Err.Clear

End Sub


Public Sub DS_OpenFile(Filename As String, rectTop As Integer, rectLeft As Integer, rectWidth As Integer, rectHeight As Integer, hWndTarget As Long, Optional ByVal UnloadPrevDS As Boolean = True)
    
    On Local Error GoTo OpenFileError
    
    Screen.MousePointer = vbHourglass
    
    'First clean up
    If UnloadPrevDS = True Then
        Call DS_Remove
    End If
    
    Set m_objMediaControl = New FilgraphManager
    
    Call m_objMediaControl.RenderFile(Filename)
    
    Set m_objBasicAudio = m_objMediaControl
    Set m_objVideoWindow = m_objMediaControl
    Set m_objMediaPosition = m_objMediaControl
    
    m_boolHasAudio = True
    On Local Error GoTo AudioError
    m_objBasicAudio.Volume = 0 'Loudest
    m_objBasicAudio.Balance = 0 'Centered
    
    On Local Error GoTo OpenFileError
    
    m_objVideoWindow.WindowStyle = WS_VISIBLE 'WS_VISIBLE = &H10000000
    m_objVideoWindow.Top = rectTop
    m_objVideoWindow.Left = rectLeft
    m_objVideoWindow.Width = rectWidth
    m_objVideoWindow.Height = rectHeight
    m_objVideoWindow.owner = hWndTarget
    
    m_objMediaPosition.Rate = 1 'Normal forward playback speed
    
    Screen.MousePointer = vbDefault
    
    Exit Sub
    
OpenFileError:
Err.Clear
Resume Next

AudioError:
m_boolHasAudio = False
Resume Next

End Sub


Public Sub DS_Play()
    
    'Play if DShow is initialized and a file is loaded
    If ObjPtr(m_objMediaPosition) > 0 Then
        Screen.MousePointer = vbHourglass
        If CLng(m_objMediaPosition.CurrentPosition) = CLng(m_objMediaPosition.Duration) Then
            m_objMediaPosition.CurrentPosition = 0
        End If
        Call m_objMediaControl.Run
        m_boolVideoRunning = True
        Screen.MousePointer = vbDefault
    End If

End Sub


Public Sub DS_Pause()
    
    'Pause if DShow is initialized and a file is loaded
    If ObjPtr(m_objMediaControl) > 0 Then
        Call m_objMediaControl.Pause
        m_boolVideoRunning = False
    End If

End Sub


Public Sub DS_Stop()
    
    'Stop if DShow is initialized and a file is loaded
    If (ObjPtr(m_objMediaControl) > 0) And (ObjPtr(m_objMediaPosition) > 0) Then
        Call m_objMediaControl.StopWhenReady
        m_objMediaPosition.CurrentPosition = 0
        m_boolVideoRunning = False
    End If

End Sub


Public Sub DS_Seek(Amount As Double)
    
    'Seek if DShow is initialized and a file is loaded
    If ObjPtr(m_objMediaPosition) > 0 Then
        'if position is out of bounds then correct
        If m_objMediaPosition.CurrentPosition + Amount < 0 Then
            m_objMediaPosition.CurrentPosition = 0
        ElseIf m_objMediaPosition.CurrentPosition + Amount > _
               m_objMediaPosition.Duration Then
            m_objMediaPosition.CurrentPosition = m_objMediaPosition.Duration
        Else
            'else just set the new position
            m_objMediaPosition.CurrentPosition = m_objMediaPosition.CurrentPosition + Amount
        End If
        DoEvents
    End If

End Sub


Public Function DS_GetRate() As Double
    
    'Get rate if DShow is initialized and file is loaded
    If ObjPtr(m_objMediaPosition) > 0 Then DS_GetRate = m_objMediaPosition.Rate

End Function


Public Sub DS_SetRate(newRate As Double)
    
    'rate must not be <= 0!
    If newRate <= 0 Then newRate = 0.1
    'Set rate if DShow is initialized and file is loaded
    If ObjPtr(m_objMediaPosition) > 0 Then m_objMediaPosition.Rate = newRate

End Sub


Public Function DS_GetDuration() As Double
    
    On Error GoTo Err_Handling
    
    'Get duration if DShow is initialized and file is loaded
    If ObjPtr(m_objMediaPosition) > 0 Then DS_GetDuration = m_objMediaPosition.Duration
    
    Exit Function

Err_Handling:
Select Case Err.Number
Case 9999
    Resume
Case Else
    DS_GetDuration = 0
    Err.Clear
End Select

End Function


Public Function DS_GetPosition() As Double
    
    'Get position if DShow is initialized and file is loaded
    If ObjPtr(m_objMediaPosition) > 0 Then DS_GetPosition = m_objMediaPosition.CurrentPosition

End Function


Public Sub DS_SetPosition(newPosition As Double)
    
    'Set position if DShow is initialized and file is loaded
    If ObjPtr(m_objMediaPosition) > 0 Then
        Screen.MousePointer = vbHourglass
        'if newPosition is out of bounds then correct
        If newPosition < 0 Then newPosition = 0
        If newPosition >= m_objMediaPosition.Duration Then newPosition = m_objMediaPosition.Duration
        m_objMediaPosition.CurrentPosition = newPosition
        Screen.MousePointer = vbDefault
    End If

End Sub


Public Function DS_GetVolume() As Long
    
    'Get volume if DShow is initialized and file has audiostream
    If ObjPtr(m_objBasicAudio) > 0 Then DS_GetVolume = m_objBasicAudio.Volume

End Function


Public Sub DS_SetVolume(newVolume As Long)
    
    'Volume must be between 0 (loudest) and -10000 (disabled)
    If newVolume > 0 Then newVolume = 0
    If newVolume < -10000 Then newVolume = -10000
    'Set volume if DShow is initialized and file has audiostream
    If ObjPtr(m_objBasicAudio) > 0 Then m_objBasicAudio.Volume = newVolume

End Sub


Public Function DS_GetBalance() As Long
    
    'Get balance if DShow is initialized and file has audiostream
    If ObjPtr(m_objBasicAudio) > 0 Then DS_GetBalance = m_objBasicAudio.Balance

End Function


Public Sub DS_SetBalance(newBalance As Long)
    
    'balance must be between -10000 (left) and +10000 (right)
    If newBalance < -10000 Then newBalance = -10000
    If newBalance > 10000 Then newBalance = 10000
    'Set balance if DShow is initialized and file has audiostream
    If ObjPtr(m_objBasicAudio) > 0 Then m_objBasicAudio.Balance = newBalance

End Sub


Public Property Get DS_VideoRunning() As Boolean

    DS_VideoRunning = m_boolVideoRunning

End Property


Public Property Get DS_HasAudio() As Boolean

    DS_HasAudio = m_boolHasAudio

End Property

Public Property Let DS_HasAudio(value As Boolean)

    DS_HasAudio = value
    
End Property
