CodeItBetter Programming Another VB Programming Blog

'MultiMedia - How to Play AVI File inside Picture Box Control

Option Explicit
 
'Add a module to your project and Insert the following code:
Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" (ByVal lpstrCommand As String, _
    ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Declare Function mciGetErrorString Lib "winmm" Alias "mciGetErrorStringA" (ByVal dwError As Long, _
    ByVal lpstrBuffer As String, ByVal uLength As Long) As Long
Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" _
    (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Const WS_CHILD = &H40000000
 
'Add a Command Button and a Picture Box in your form.

'Insert the following code to your form:
Sub PlayAVIPictureBox(ByVal sFileName As String, ByVal pic As PictureBox)
    Dim RetVal As Long
    Dim CommandString As String
    Dim ShortFileName As String * 260
    Dim deviceIsOpen As Boolean
 
    'Retrieve short file name format
    RetVal = GetShortPathName(sFileName, ShortFileName, Len(ShortFileName))
    sFileName = Left$(ShortFileName, RetVal)
 
    'Open the device
    CommandString = "Open " & sFileName & " type AVIVideo alias AVIFile parent " & CStr(pic.hWnd) _
        & " style " & CStr(WS_CHILD)
    RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
    If RetVal Then GoTo Error
 
    'remember that the device is now open
    deviceIsOpen = True
 
    'Resize the movie to PictureBox size
    CommandString = "put AVIFile window at 0 0 " & CStr(pic.ScaleWidth / Screen.TwipsPerPixelX) _
        & " " & CStr(pic.ScaleHeight / Screen.TwipsPerPixelY)
    RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
    If RetVal <> 0 Then GoTo Error
 
    'Play the file
    CommandString = "Play AVIFile wait"
    RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
    If RetVal <> 0 Then GoTo Error
 
    'Close the device
    CommandString = "Close AVIFile"
    RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
    If RetVal <> 0 Then GoTo Error
 
    Exit Sub
 
Error:
    'An error occurred.
    'Get the error description
    Dim ErrorString As String
    ErrorString = Space$(256)
    mciGetErrorString RetVal, ErrorString, Len(ErrorString)
    ErrorString = Left$(ErrorString, InStr(ErrorString, vbNullChar) - 1)
 
    'close the device if necessary
    If deviceIsOpen Then
        CommandString = "Close AVIFile"
        mciSendString CommandString, vbNullString, 0, 0&
    End If
 
    'raise a custom error, with the proper description
    Err.Raise 999, , ErrorString
End Sub
 
Private Sub Command1_Click()
    'replace "C:\WINDOWS\clock.avi" with the name of the AVI file you want to play
    Call PlayAVIPictureBox("C:\WINDOWS\clock.avi", Picture1)
End Sub