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