devxlogo

PlayAVIPictureBox – Play an AVI file in a PictureBox

PlayAVIPictureBox – Play an AVI file in a PictureBox

Const WS_CHILD = &H40000000Private Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" _    (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _    ByVal uReturnLength As Long, ByVal hwndCallback As Long) As LongPrivate Declare Function mciGetErrorString Lib "winmm" Alias _    "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _    ByVal uLength As Long) As LongPrivate Declare Function GetShortPathName Lib "kernel32" Alias _    "GetShortPathNameA" (ByVal lpszLongPath As String, _    ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long' Play an AVI file in a PictureBox synchronously.'' FileName is a string containing the full path of the file.' Window is the PictureBox in which you want that the movie' is played; the movie is automatically resized to the picture boxSub PlayAVIPictureBox(FileName As String, ByVal Window 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(FileName, ShortFileName, Len(ShortFileName))    FileName = Left$(ShortFileName, RetVal)        ' Open the device    CommandString = "Open " & FileName & " type AVIVideo alias AVIFile parent " _        & CStr(Window.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(Window.ScaleWidth / _        Screen.TwipsPerPixelX) & " " & CStr(Window.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, , ErrorStringEnd Sub

devx-admin

Share the Post: