Воспроизведение из объекта OLE кодом

OLE1.Action = 7

Option Explicit
'
'Mp3-Player Micro
'by the Fever Brain
'
Option Compare Text
Dim WithEvents CB As CommandButton, WithEvents vl As CommandButton
Dim WithEvents CBX As ComboBox, WithEvents pb As PictureBox
Dim CD As Object, MPlayer As Object
Dim File$, InitD$, mVol&, i&, v
 
Private Sub vl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static yy&, Vol&
    If Button = 1 Then
        Vol = yy + Y - 90
        If Vol > 0 And Vol < 390 Then
            vl.Top = yy + Y - 90
            mVol = -((Vol - 390) * 20 + 7500)
            MPlayer.Volume = mVol
        End If
    End If
    yy = vl.Top
End Sub
 
Sub PlayerAction(Optional Action$)
    Debug.Print MPlayer.Volume
    On Error Resume Next
    Static s$, ps
    ps = MPlayer.PlayState
    Select Case Action
    Case "Open"
        If CBX.ListCount = 0 Then s = "000"
        If CD.ShowOpen Then
            File = CD.FileName
            CD.InitialDir = Left(File, InStrRev(File, "") - 1)
            Select Case Right$(File, 4)
            Case ".mp3", ".wav"
                CBX.AddItem File, 0
                s = "001":
                CBX.ListIndex = 0
            End Select
            MPlayer.Volume = mVol
        End If
    Case "Стоп": MPlayer.Open "": s = "001"
    Case "Пауза": MPlayer.Pause: s = "001"
    Case "Воспр"
        If ps = 6 Or CBX.Text <> MPlayer.FileName Then
            MPlayer.Open CBX.Text
        ElseIf ps = 0 Or ps = 1 Then
            MPlayer.Play
        End If
        s = "110"
    End Select
    For i = 1 To 3: Controls("cb" & i).Enabled = Mid$(s, i, 1): Next
End Sub
 
Private Sub CBX_Click()
    CBX.SelStart = 255
    Call PlayerAction("Воспр")
End Sub
 
Private Sub CB_Click()
    PlayerAction (CB.Caption)
End Sub
 
Private Sub Form_Load()
    Set MPlayer = CreateObject("MediaPlayer.MediaPlayer.1")
    MPlayer.AutoStart = 1
    Const w = 900
    
    Set CD = CreateObject("UserAccounts.CommonDialog")
    Const mz = "*.mp3;*.wav"
    CD.Filter = "Музыка " & mz & "|" & mz & "|Все файлы (*.*)|*.*"
    CD.FilterIndex = 1
    Set CBX = Controls.Add("vb.ComboBox", "CBX"): With CBX
        .Move 0, 0, w * 4
        .Visible = 1
    End With
    
    For Each v In Array("Open", "Стоп", "Пауза", "Воспр")
        With Controls.Add("vb.CommandButton", "cb" & i)
            .Caption = v
            .Move i * w, CBX.Height, w, 300
            .Enabled = (i = 0)
            .Visible = 1
        End With
        i = i + 1
    Next
    Set pb = Controls.Add("vb.picturebox", "pb"): With pb
        .Move w * 4, 0, 300, CBX.Height * 2
        .BackColor = vbWhite
        .Visible = 1
    End With
    Set vl = Controls.Add("vb.CommandButton", "vl", Controls("pb")): With vl
        .Move 0, 180, 260, 30
        .Visible = 1
    End With
    mVol = MPlayer.Volume
    Caption = "Mp3-Player micro"
    Width = CBX.Width + vl.Width: Width = Width + (Width - ScaleWidth)
    Height = CBX.Height * 2: Height = Height + (Height - ScaleHeight)
End Sub
 
Private Sub CB_LostFocus()
    Set v = ActiveControl
    Select Case TypeName(v)
    Case "CommandButton"
        If v.Name <> "vl" Then Set CB = v
    End Select
End Sub
Private Sub vl_LostFocus(): CB_LostFocus: End Sub
Private Sub pb_LostFocus(): CB_LostFocus: End Sub
Private Sub CBX_LostFocus(): CB_LostFocus: End Sub
Private Sub CBX_KeyPress(KeyAscii As Integer): KeyAscii = 0: End Sub
Private Sub Form_Unload(Cancel As Integer): PlayerAction "Стоп": End Sub

Option Explicit
'
'Mp3-Player Micro
'by the Fever Brain
'
Option Compare Text
Const r = 90, rr = r * 3, w = r * 10, AppKey = "Mp3-Player Micro"
 
Const pFilter = "*.mp3;*.wav"
Const pOpen = "Файл"
Const pStop = "Стоп"
Const pPause = "Пауза"
Const pPlay = "Воспр"
Const bCount = 4 'Количество кнопок
 
Dim WithEvents CB As CommandButton, WithEvents vS As VScrollBar
Dim WithEvents CBX As ComboBox, WithEvents pb As PictureBox
Dim CD As Object, MPlayer As Object
Dim File$, InitD$, i&, v
 
Private Sub vS_Scroll()
    MPlayer.Volume = -vS.Value
End Sub
 
Sub PlayerAction(Optional Action$)
    Debug.Print MPlayer.Volume
    On Error Resume Next
    Static s$, ps&
    ps = MPlayer.PlayState
    Select Case Action
    Case pOpen
        If CBX.ListCount = 0 Then s = "000"
        If CD.ShowOpen Then
            File = CD.FileName
            CD.InitialDir = Left(File, InStrRev(File, "") - 1)
            Select Case Right$(File, 4)
            Case ".mp3", ".wav"
                CBX.AddItem File, 0
                s = "001":
                CBX.ListIndex = 0
            End Select
        End If
    Case pStop: MPlayer.Open "": s = "001"
    Case pPause: MPlayer.Pause: s = "001"
    Case pPlay
        If ps = 6 Or CBX.Text <> MPlayer.FileName Then
            MPlayer.Open CBX.Text
        ElseIf ps = 0 Or ps = 1 Then
            MPlayer.Play
        End If
        s = "110"
    End Select
    For i = 1 To 3: Controls("cb" & i).Enabled = Mid$(s, i, 1): Next
End Sub
 
Private Sub CBX_Click()
    CBX.SelStart = 255
    Call PlayerAction(pPlay)
End Sub
 
Private Sub CB_Click()
    PlayerAction (CB.Caption)
End Sub
 
Private Sub Form_Load()
    Set MPlayer = CreateObject("MediaPlayer.MediaPlayer.1")
    MPlayer.AutoStart = 1
    Set CD = CreateObject("UserAccounts.CommonDialog")
    CD.Filter = "Музыка " & pFilter & "|" & pFilter & "|Все файлы (*.*)|*.*"
    CD.FilterIndex = 1
    Set CBX = Controls.Add("vb.ComboBox", "CBX"): With CBX
        .Move 0, 0, w * bCount
        .Visible = 1
    End With
    For Each v In Array(pOpen, pStop, pPause, pPlay)
        With Controls.Add("vb.CommandButton", "cb" & i)
            .Caption = v
            .Move i * w, CBX.Height, w, CBX.Height
            .Enabled = (i = 0)
            .Visible = 1
        End With
        i = i + 1
    Next
    Set pb = Controls.Add("vb.picturebox", "pb"): With pb
        .Move w * bCount, 0, rr + 60, CBX.Height * 2
        .BackColor = vbWhite
        .Visible = 1
    End With
    Set vS = Controls.Add("vb.VScrollBar", "vS", pb): With vS
        .Move 0, -rr, rr, r * 12
        .Min = 0
        .Max = 9000
        .Value = GetSetting(AppKey, "vs", 0, .Max \ 2)
        .Visible = 1
    End With
    MPlayer.Volume = -vS.Value
    Caption = AppKey
    Width = CBX.Width + pb.Width: Width = Width + (Width - ScaleWidth)
    Height = CBX.Height * 2: Height = Height + (Height - ScaleHeight)
End Sub
 
Private Sub CB_LostFocus()
    Set v = ActiveControl
    Select Case TypeName(v)
    Case "CommandButton"
        If v.Name <> "vS" Then Set CB = v
    End Select
End Sub
 
Private Sub vS_LostFocus(): CB_LostFocus: End Sub
Private Sub pb_LostFocus(): CB_LostFocus: End Sub
Private Sub CBX_LostFocus(): CB_LostFocus: End Sub
Private Sub CBX_KeyPress(KeyAscii As Integer): KeyAscii = 0: End Sub
Private Sub Form_Unload(Cancel As Integer):
    SaveSetting AppKey, "vs", 0, vS.Value
    PlayerAction pStop
End Sub

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByRef lpszSoundName As Any, ByVal uFlags As Long) As Long
Private Sub Form_Load()
    Dim d() As Byte
    d = LoadResData(101, "CUSTOM")
    sndPlaySound d(0), 4
End Sub

Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
 
Private Sub Form_Load()
    mciExecute "play C:\Temp\Project007.avi"
End Sub

Private Player As New FilgraphManager
Private Sub Form_Load()
    Player.RenderFile "D:\Толик\Фильмы\I ROBOT.flv"
    Player.Run
End Subb