Login | Register   
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


Tip of the Day
Language: VB4/32,VB5,VB6
Expertise: Intermediate
Jan 22, 2000

PlayAVIPictureBox - Play an AVI file in a PictureBox

Const WS_CHILD = &H40000000

Private 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

Private Declare Function mciGetErrorString Lib "winmm" Alias _
    "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _
    ByVal uLength As Long) As Long

Private 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 box

Sub 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, , ErrorString

End Sub
Alberto Falossi
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap