Option Explicit  

Private m_objMediaPosition As IMediaPosition  
Private m_objVideoWindow As IVideoWindow  
Private m_objMediaControl As IMediaControl  
Private m_objBasicAudio  As IBasicAudio  

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer  
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)  

Public Sub RunAudio(fName As String, ByVal Volume As Single)  
Dim meVol As Integer  
   meVol = 67 - 67 * Exp((1 - Volume) * 5)  
   If meVol < -9999 Then meVol = -9999  
   If meVol > 0 Then meVol = 0  
    
   Set m_objMediaControl = New FilgraphManager  
   Set m_objBasicAudio = m_objMediaControl  
   m_objMediaControl.RenderFile fName  
   m_objBasicAudio.Volume = meVol  
   m_objMediaControl.Run  
End Sub  

Public Sub RunVideo(fName As String, ByVal Volume As Single)  
Dim d1 As Double, d2 As Double  
Dim meVol As Integer  
   meVol = 67 - 67 * Exp((1 - Volume) * 5)  
   If meVol < -9999 Then meVol = -9999  
   If meVol > 0 Then meVol = 0  
    
   Set m_objMediaControl = New FilgraphManager  
   m_objMediaControl.RenderFile fName  

   Set m_objVideoWindow = m_objMediaControl  
   Set m_objBasicAudio = m_objMediaControl  
   m_objVideoWindow.WindowStyle = CLng(&H6000000)  
   m_objVideoWindow.Top = 0  
   m_objVideoWindow.Left = 0  
   m_objVideoWindow.Width = Screen.Width / Screen.TwipsPerPixelX  
   m_objVideoWindow.Height = Screen.Height / Screen.TwipsPerPixelY  
   m_objVideoWindow.HideCursor -1  
   Set m_objMediaPosition = m_objMediaControl  
   m_objBasicAudio.Volume = meVol  
   m_objMediaControl.Run  
   d2 = -1  
   Do  
     Sleep 50  
     d1 = m_objMediaPosition.CurrentPosition  
     If d1 = d2 Then Exit Do Else d2 = d1  
     If GetAsyncKeyState(vbKeyEscape) < 0 Then Exit Do  
   Loop  
   DShowStop  
End Sub  

Public Sub DShowStop()  
   If Not m_objMediaControl Is Nothing Then  
     m_objMediaControl.Stop  
     Set m_objBasicAudio = Nothing  
     Set m_objMediaPosition = Nothing  
     Set m_objVideoWindow = Nothing  
     Set m_objMediaControl = Nothing  
   End If  
End Sub

Option Explicit  

Private Sub bAudio_Click()  
   RunAudio "1.mp3", 1 'Громкость от 0 до 1  
End Sub  

Private Sub bStop_Click()  
   DShowStop  
End Sub  

Private Sub bVideo_Click()  
   DoEvents  
   RunVideo "1.wmv", 1 'Громкость от 0 до 1  
End Sub  

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)  
   DShowStop  
End Sub