Simple Media Player Example for Visual Basic

The following example demonstrates most of the methods and properties available in the ltmmPlayCtrl object:

' name of the source file
Const SourceFile = "c:\source.avi"
' array used for memory source
Dim arr() As Byte
' form resize lock
Dim FormResizeLock As Integer

' declarations for clipboard functions
Const CF_DIB = 8
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

' declarations for global memory source
Const GMEM_MOVEABLE = &H2
Const FILE_SHARE_READ = &H1
Const OPEN_EXISTING = 3
Const INVALID_HANDLE_VALUE = -1
Const GENERIC_READ = &H80000000
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hfile As Long, ByVal lpFileSizeHigh As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hfile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long

Sub FreeSource()
    ' free the source
Dim hglobal As Long

    ltmmPlayCtrl1.Stop
    If ltmmPlayCtrl1.SourceType = ltmmPlay_Source_Array Then
        ltmmPlayCtrl1.ResetSource
        ReDim arr(0)
    ElseIf ltmmPlayCtrl1.SourceType = ltmmPlay_Source_HGlobal Then
        hglobal = ltmmPlayCtrl1.SourceHGlobal
        ltmmPlayCtrl1.ResetSource
        GlobalFree hglobal
    ElseIf ltmmPlayCtrl1.SourceType = ltmmPlay_Source_File Then
        ltmmPlayCtrl1.ResetSource
    End If
End Sub
Private Sub Form_Load()
    ' set up a custom cursor
    ltmmPlayCtrl1.MouseIcon = LoadPicture("c:\icons\playpause.ico")
    ltmmPlayCtrl1.MousePointer = ltmmCustom
    ' match the form scale mode
    ltmmPlayCtrl1.ScaleMode = ScaleMode
    ' enable automatic resizing of the control
    ltmmPlayCtrl1.AutoSize = True
    ' load the source file
    ltmmPlayCtrl1.SourceFile = SourceFile
    If (ltmmPlayCtrl1.UnrenderedStreams <> 0) Then
        MsgBox "Not all of the available streams could be rendered."
    End If
    ' insure that the initial paint is the right size
    On Error Resume Next
    Move Left, Top, ltmmPlayCtrl1.VideoWidth + (Width - ScaleWidth), ltmmPlayCtrl1.VideoHeight + (Height - ScaleHeight) + statusbar.Height
End Sub

Private Sub Form_Resize()
    ' resize the play window
    FormResizeLock = FormResizeLock + 1
    Dim cy As Integer
    If ScaleHeight >= statusbar.Height Then
        cy = ScaleHeight - statusbar.Height
    Else
        cy = 0
    End If
    ltmmPlayCtrl1.Move ScaleLeft, ScaleTop, ScaleWidth, cy
    FormResizeLock = FormResizeLock – 1
End Sub

Private Sub mnuAudioProcessors_Click()
    ' show audio processors dialog
    ltmmPlayCtrl1.ShowDialog ltmmPlay_Dlg_AudioProcessors, hwnd
End Sub

Private Sub mnuAutoRewind_Click()
    ' toggle auto rewind
    ltmmPlayCtrl1.AutoRewind = Not ltmmPlayCtrl1.AutoRewind
End Sub

Private Sub mnuAutoStart_Click()
    ' toggle auto start
    ltmmPlayCtrl1.AutoStart = Not ltmmPlayCtrl1.AutoStart
End Sub

Private Sub mnuClearSelection_Click()
    ' clear the current selection
    ltmmPlayCtrl1.SelectionStart = 0
    ltmmPlayCtrl1.SelectionEnd = ltmmPlayCtrl1.Duration
End Sub

Private Sub mnuControl_Click()
    ' initialize menu options
    Dim caps As Long

    mnuPlay.Enabled = (ltmmPlayCtrl1.State = ltmmPlay_State_Stopped Or ltmmPlayCtrl1.State = ltmmPlay_State_Paused)
    mnuPause.Enabled = (ltmmPlayCtrl1.State = ltmmPlay_State_Running)
    mnuStop.Enabled = (ltmmPlayCtrl1.State = ltmmPlay_State_Running Or ltmmPlayCtrl1.State = ltmmPlay_State_Paused)


    caps = ltmmPlayCtrl1.CheckSeekingCapabilities (ltmmPlay_Seeking_Forward + ltmmPlay_Seeking_Backward + ltmmPlay_Seeking_FrameForward + ltmmPlay_Seeking_FrameBackward)
    mnuSeekStart.Enabled = (caps And ltmmPlay_Seeking_Backward)
    mnuSeekEnd.Enabled = (caps And ltmmPlay_Seeking_Forward)
    mnuNextFrame.Enabled = (caps And ltmmPlay_Seeking_FrameForward)
    mnuPreviousFrame.Enabled = (caps And ltmmPlay_Seeking_FrameBackward)
    mnuSeekSelectionStart.Enabled = ((caps And (ltmmPlay_Seeking_Backward + ltmmPlay_Seeking_Forward)) <> 0)
    mnuSeekSelectionEnd.Enabled = ((caps And (ltmmPlay_Seeking_Backward + ltmmPlay_Seeking_Forward)) <> 0)
    mnuLastFrame.Enabled = (caps And ltmmPlay_Seeking_FrameForward)
    mnuFirstFrame.Enabled = (caps And ltmmPlay_Seeking_FrameBackward)
    mnuStepForward1Second.Enabled = (caps And ltmmPlay_Seeking_Forward)
    mnuStepForward10Percent.Enabled = (caps And ltmmPlay_Seeking_Forward)

    mnuHalfSpeed.Checked = (Abs(ltmmPlayCtrl1.Rate - 0.5) < 0.1)
    mnuNormalSpeed.Checked = (Abs(ltmmPlayCtrl1.Rate - 1#) < 0.1)

    mnuFitToWindow.Checked = (ltmmPlayCtrl1.VideoWindowSizeMode = ltmmFit)
    mnuStretchToWindow.Checked = (ltmmPlayCtrl1.VideoWindowSizeMode = ltmmStretch)

    mnuIncreaseVolume.Enabled = (ltmmPlayCtrl1.Volume < 0)
    mnuDecreaseVolume.Enabled = (ltmmPlayCtrl1.Volume > -10000)

    mnuPanLeft.Enabled = (ltmmPlayCtrl1.Balance > -10000)
    mnuPanRight.Enabled = (ltmmPlayCtrl1.Balance < 10000)

    mnuMute.Checked = ltmmPlayCtrl1.Mute

    mnuAutoRewind.Checked = ltmmPlayCtrl1.AutoRewind

    mnuAutoStart.Checked = ltmmPlayCtrl1.AutoStart

    mnuLoop.Checked = (ltmmPlayCtrl1.PlayCount = 0)

    mnuAudioProcessors.Enabled = ltmmPlayCtrl1.HasDialog (ltmmPlay_Dlg_AudioProcessors)
    mnuVideoProcessors.Enabled = ltmmPlayCtrl1.HasDialog(ltmmPlay_Dlg_VideoProcessors)

    mnuCopyDIB.Enabled = (ltmmPlayCtrl1.RenderedStreams And ltmmPlay_Stream_Video) <> 0
    mnuSavePicture.Enabled = (ltmmPlayCtrl1.RenderedStreams And ltmmPlay_Stream_Video) <> 0

End Sub

Private Sub mnuCopyDIB_Click()
    ' get DIB and copy it to the clipboard
    Dim hdib As Long
    hdib = ltmmPlayCtrl1.GetStillDIB (5000)
    OpenClipboard hwnd
    EmptyClipboard
    SetClipboardData CF_DIB, hdib
    CloseClipboard
End Sub

Private Sub mnuDecreaseVolume_Click()
    ' decrease volume
    If ltmmPlayCtrl1.Volume > (-10000 + 300) Then
        ltmmPlayCtrl1.Volume = ltmmPlayCtrl1.Volume - 300
    Else
        ltmmPlayCtrl1.Volume = -10000
    End If
End Sub

Private Sub mnuFirstFrame_Click()
    ' goto first frame
    ltmmPlayCtrl1.CurrentFramePosition = 0
End Sub

Private Sub mnuFitToWindow_Click()
    ' fit video to window
    ltmmPlayCtrl1.VideoWindowSizeMode = ltmmFit
End Sub

Private Sub mnuFullScreen_Click()
    ' toggle full screen mode
    ltmmPlayCtrl1.ToggleFullScreenMode
End Sub

Private Sub mnuHalfSpeed_Click()
    ' set half speed playback
    ltmmPlayCtrl1.Rate = 0.5
End Sub

Private Sub mnuIncreaseVolume_Click()
    ' increase volume
    If ltmmPlayCtrl1.Volume < (0 - 300) Then
        ltmmPlayCtrl1.Volume = ltmmPlayCtrl1.Volume + 300
    Else
        ltmmPlayCtrl1.Volume = 0
    End If
End Sub

Private Sub mnuLastFrame_Click()
    ' goto last frame
    ltmmPlayCtrl1.CurrentFramePosition = ltmmPlayCtrl1.FrameDuration - 1
End Sub

Private Sub mnuLoop_Click()
    ' toggle looping
    If ltmmPlayCtrl1.PlayCount = 0 Then
        ltmmPlayCtrl1.PlayCount = 1
    Else
        ltmmPlayCtrl1.PlayCount = 0
    End If
End Sub

Private Sub mnuMediaInformation_Click()
    ' display media information
    On Error Resume Next
    MsgBox "Title = '" & ltmmPlayCtrl1.Title & "', Author = '" & ltmmPlayCtrl1.Author & "', Copyright = '" & ltmmPlayCtrl1.Copyright & "', Description = '" & ltmmPlayCtrl1.Description & ", Rating = '" & ltmmPlayCtrl1.Rating & "'"
End Sub

Private Sub mnuMute_Click()
    ' toggle mute
    ltmmPlayCtrl1.Mute = Not ltmmPlayCtrl1.Mute
End Sub

Private Sub mnuNextFrame_Click()
    ' advance one frame
    ltmmPlayCtrl1.NextFrame
End Sub

Private Sub mnuNormalSpeed_Click()
    ' normal playback speed
    ltmmPlayCtrl1.Rate = 1#
End Sub

Private Sub mnuPanLeft_Click()
    ' pan balance left
    If ltmmPlayCtrl1.Balance > (-10000 + 300) Then
        ltmmPlayCtrl1.Balance = ltmmPlayCtrl1.Balance - 300
    Else
        ltmmPlayCtrl1.Balance = -10000
    End If
End Sub

Private Sub mnuPanRight_Click()
    ' pan balance right
    If ltmmPlayCtrl1.Balance > (10000 - 300) Then
        ltmmPlayCtrl1.Balance = ltmmPlayCtrl1.Balance + 300
    Else
        ltmmPlayCtrl1.Balance = 10000
    End If
End Sub

Private Sub mnuPause_Click()
    ' pause
    ltmmPlayCtrl1.Pause
End Sub

Private Sub mnuPlay_Click()
    ' play
    ltmmPlayCtrl1.Run
End Sub

Private Sub mnuPreviousFrame_Click()
    ' back one frame
    ltmmPlayCtrl1.PreviousFrame
End Sub

Private Sub mnuSavePicture_Click()
    ' save picture
    SavePicture ltmmPlayCtrl1.GetStillPicture (5000), "c:\still.bmp"
End Sub

Private Sub mnuSeekEnd_Click()
    ' goto the end
    ltmmPlayCtrl1.SeekEnd
End Sub

Private Sub mnuSeekSelectionEnd_Click()
    ' goto the selection end
    ltmmPlayCtrl1.SeekSelectionEnd
End Sub

Private Sub mnuSeekSelectionStart_Click()
    ' goto the selection start
    ltmmPlayCtrl1.SeekSelectionStart
End Sub

Private Sub mnuSeekStart_Click()
    ' goto the start
    ltmmPlayCtrl1.SeekStart
End Sub

Private Sub mnuSetSelectionEnd_Click()
    ' set selection end to current position
    ltmmPlayCtrl1.MarkSelectionEnd
End Sub

Private Sub mnuSetSelectionStart_Click()
    ' set selection start to current position
    ltmmPlayCtrl1.MarkSelectionStart
End Sub

Private Sub mnuSourceArray_Click()
    ' preload array with file and assign it to control
    Dim fl As Long
    FreeSource
    fl = FileLen(SourceFile)
    ReDim arr(fl)
    Open SourceFile For Binary Access Read As #1
    Get #1, , arr
    Close #1
    ltmmPlayCtrl1.SourceArray = arr
    If (ltmmPlayCtrl1.UnrenderedStreams <> 0) Then
        MsgBox "Not all of the available streams could be rendered."
    End If
End Sub

Private Sub mnuSourceFile_Click()
    ' set file as source
    FreeSource
    ltmmPlayCtrl1.SourceFile = SourceFile
    If (ltmmPlayCtrl1.UnrenderedStreams <> 0) Then
        MsgBox "Not all of the available streams could be rendered."
    End If
End Sub

Private Sub mnuSourceHGlobal_Click()
    ' preload global memory with file and assign it to control
    Dim hglobal As Long
    Dim hfile As Long
    Dim size As Long
    Dim cb As Long
    Dim buffer As Long
    FreeSource

    ' open the source file
    hfile = CreateFile(SourceFile, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, 0, 0)
    If hfile = INVALID_HANDLE_VALUE Then
        Exit Sub
    End If

    ' allocate same-sized global memory
    size = GetFileSize(hfile, 0)

    hglobal = GlobalAlloc(GMEM_MOVEABLE, size)
    If hglobal = 0 Then
        CloseHandle hfile
        Exit Sub
    End If

    ' read entire source into memory
    buffer = GlobalLock(hglobal)
    If (ReadFile(hfile, buffer, size, cb, 0) = 0 Or cb <> size) Then
        MsgBox CStr(GetLastError())
        GlobalUnlock hglobal
        CloseHandle hfile
        GlobalFree hglobal
        Exit Sub
    End If

    GlobalUnlock hglobal

    ' close file
    CloseHandle hfile


    ltmmPlayCtrl1.SourceHGlobal = hglobal

    If (ltmmPlayCtrl1.UnrenderedStreams <> 0) Then
        MsgBox "Not all of the available streams could be rendered."
    End If

End Sub

Private Sub mnuStepForward10Percent_Click()
    ' advance by 10 percent
    ltmmPlayCtrl1.CurrentTrackingPosition = ltmmPlayCtrl1.CurrentTrackingPosition + 1000
End Sub

Private Sub mnuStepForward1Second_Click()
    ' advance by 1 second
    ltmmPlayCtrl1.CurrentPosition = ltmmPlayCtrl1.CurrentPosition + 1#
End Sub

Private Sub mnuStop_Click()
    ' stop playback
    ltmmPlayCtrl1.Stop
End Sub

Private Sub mnuStretchToWindow_Click()
    ' stretch video to window
    ltmmPlayCtrl1.VideoWindowSizeMode = ltmmStretch
End Sub

Private Sub mnuVideoProcessors_Click()
    ' show video processor dialog
    ltmmPlayCtrl1.ShowDialog ltmmPlay_Dlg_VideoProcessors, hwnd
End Sub

Private Sub play_Click ()
' remove comment to debug
'    MsgBox "Click fired"
End Sub

Private Sub play_DblClick ()
' remove comment to debug
'    MsgBox "DblClick fired"
End Sub

Private Sub play_ErrorAbort (ByVal ErrorCode As Long)
    ' display playback error
    MsgBox "A playback error occured... Error " & CStr(ErrorCode)
End Sub

Private Sub play_KeyDown (KeyCode As Integer, ShiftState As Integer)
    ' escape from full screen mode
    If KeyCode = vkEscape And ltmmPlayCtrl1.FullScreenMode Then
        ltmmPlayCtrl1.FullScreenMode = False
    End If
End Sub

Private Sub play_KeyPress (KeyAscii As Integer)
' remove comment to debug
'    MsgBox "KeyPress fired - KeyAscii = " & CStr(KeyAscii)
End Sub

Private Sub play_KeyUp (KeyCode As Integer, ShiftState As Integer)
' remove comment to debug
'    MsgBox "KeyUp fired - KeyCode = " & CStr(KeyCode) & " ShiftState = " & CStr(ShiftState)
End Sub

Private Sub play_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' toggle pause/play if clicked within video
    If Button = 1 Then
        If X >= ltmmPlayCtrl1.VideoWindowLeft And X < (ltmmPlayCtrl1.VideoWindowLeft + ltmmPlayCtrl1.VideoWindowWidth) And Y >= ltmmPlayCtrl1.VideoWindowTop And Y < (ltmmPlayCtrl1.VideoWindowTop + ltmmPlayCtrl1.VideoWindowHeight) Then
            If ltmmPlayCtrl1.State = ltmmPlay_State_Running Then
                ltmmPlayCtrl1.Pause
            ElseIf ltmmPlayCtrl1.State = ltmmPlay_State_Paused Or ltmmPlayCtrl1.State = ltmmPlay_State_Stopped Then
                ltmmPlayCtrl1.Run
            End If

        End If
    End If
End Sub

Private Sub play_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
' remove comment to debug
'    MsgBox "MouseMove fired - Button = " & CStr(Button) & " Shift = " & CStr(Shift) & " X = " & CStr(X) & " Y = " & CStr(Y)
End Sub

Private Sub play_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
' remove comment to debug
'    MsgBox "MouseUp fired - Button = " & CStr(Button) & " Shift = " & CStr(Shift) & " X = " & CStr(X) & " Y = " & CStr(Y)
End Sub

Private Sub play_Resize ()
   ' if not in the form resize event, then size the form to the control
   If FormResizeLock = 0 Then
' remove comment to debug
'       MsgBox "Resize fired - ScaleLeft = " & CStr(ltmmPlayCtrl1.ScaleLeft) & " ScaleTop = " & CStr(ltmmPlayCtrl1.ScaleTop) & " ScaleWidth = " & CStr(ltmmPlayCtrl1.ScaleWidth) & " ScaleHeight = " & CStr(ltmmPlayCtrl1.ScaleHeight)
       Move Left, Top, ltmmPlayCtrl1.VideoWindowWidth + (Width - ScaleWidth), ltmmPlayCtrl1.VideoWindowHeight + (Height - ScaleHeight) + statusbar.Height
   End If
End Sub

Private Sub play_StateChanged (ByVal LastState As Long, ByVal State As Long)
    ' display current state
    If State = ltmmPlay_State_NotReady Then
        statusbar.Panels(1).Text = "Not Ready"
    ElseIf State = ltmmPlay_State_Stopped Then
' uncomment the following line to view the graph with DirectShow GraphEdit
' ltmmPlayCtrl1.EditGraph
        statusbar.Panels(1).Text = "Stopped"
        If ltmmPlayCtrl1.SourceType = ltmmPlay_Source_File Then
            Caption = "[" & ltmmPlayCtrl1.SourceFile & "]"
        ElseIf ltmmPlayCtrl1.SourceType = ltmmPlay_Source_Array Then
            Caption = "[array]"
        ElseIf ltmmPlayCtrl1.SourceType = ltmmPlay_Source_HGlobal Then
            Caption = "[hglobal]"
        End If
    ElseIf State = ltmmPlay_State_Paused Then
        statusbar.Panels(1).Text = "Paused"
    ElseIf State = ltmmPlay_State_Running Then
        statusbar.Panels(1).Text = "Running"
    End If
End Sub

Private Sub play_TrackingPositionChanged (ByVal Position As Long)
    ' display current position
    statusbar.Panels(2).Text = "Time " & CStr(ltmmPlayCtrl1.CurrentPosition) & "/" & CStr(ltmmPlayCtrl1.Duration)
    On Error Resume Next
    statusbar.Panels(3).Text = "Frame " & CStr(ltmmPlayCtrl1.CurrentFramePosition + 1) & "/" & CStr(ltmmPlayCtrl1.FrameDuration)
    statusbar.Panels(4).Text = "Track " & CStr(ltmmPlayCtrl1.CurrentTrackingPosition)

End Sub

Private Sub play_TrackingSelectionChanged (ByVal SelStart As Long, ByVal SelEnd As Long)
    ' show current selection
    statusbar.Panels(5).Text = "Select " & CStr(ltmmPlayCtrl1.SelectionStart) & " - " & CStr(ltmmPlayCtrl1.SelectionEnd)
    statusbar.Panels(6).Text = "Trk. Select " & CStr(ltmmPlayCtrl1.TrackingSelectionStart) & " - " & CStr(ltmmPlayCtrl1.TrackingSelectionEnd)
End Sub

Private Sub Play_MediaEvent (ByVal EventCode As Long, ByVal Param1 As Long, ByVal Param2 As Long) 
    Select Case EventCode
        Case ltmmEC_DVD_DISC_INSERTED
            statusbar.Panels(1).Text = "Disc inserted." 
        Case ltmmEC_DVD_DISC_EJECTED
            statusbar.Panels(1).Text = "Disc ejected." 
        Case ltmmEC_DVD_TITLE_CHANGE
            statusbar.Panels(1).Text = "Title changed to " + Str(Param1) + "."
        Case ltmmEC_DVD_CHAPTER_START
            statusbar.Panels(1).Text = "Chapter " + Str(Param1) + " started playing." 
        Case ltmmEC_DVD_ERROR
            statusbar.Panels(1).Text = "An error occured. Code = " + Str(Param1) + "."
    End Select
End Sub