PlayAvi

'The following function accepts two params,
'one is a reference to a picture box, the other is the
'path to the avi file to play.
Public Function PlayAVI(ByRef picTarget As PictureBox, _
        ByVal strAVIName As String) As String
    On Error Resume Next
    'Declare our variables
    Dim strAlias As String
    Dim strRect As String
    Dim rctResize As RECT
    Dim lngError As Long
    Dim strTargetWindow As String
    Dim strReturn As String
    Dim lngLenStr As Long
    'Fill our string variable with spaces.
    strReturn = Space(128)
    'Assign a value of 127 to lngLenStr so that the MCI
    'command knows the max value of the return string
    lngLenStr = 127
    'Assign a value to the strAlias variable so the mci
    'has an alias to use
    strAlias = "PLAYAVI"
    'If the AVI file is not provided or found, then exit function
    If strAVIName = "" Or Len(Dir(strAVIName)) = 0 Then
        PlayAVI = strAVIName & " was Not found!"
        Exit Function
    End If
    'Make sure the AVI file name is in quotes
    '(required for long filenames)
    If Left(strAVIName, 1) <> """" Then strAVIName = """" & strAVIName & """"
    'Open the AVI and give it the alias contained in strAlias
    lngError = mciSendString("open " & strAVIName & " Alias " & strAlias, _
        strReturn, lngLenStr, 0)
    If lngError = 289 Then
        lngError = mciSendString("close " & strAlias, strReturn, lngLenStr, 0)
        
        If lngError Then
            PlayAVI = GetMCIError(lngError)
            Exit Function
        End If
        lngError = mciSendString("open " & strAVIName & " Alias " & strAlias, _
            strReturn, lngLenStr, 0)
    End If
    
    If lngError Then
        PlayAVI = GetMCIError(lngError)
        Exit Function
    End If
    'Enable audio
    lngError = mciSendString("set " & strAlias & _
        " audio all on", strReturn, lngLenStr, 0)
    If lngError Then
        PlayAVI = GetMCIError(lngError)
        Exit Function
    End If
    'Set the target window using the alias and the hWnd of the picture box
    strTargetWindow = "window " & strAlias & " handle " & picTarget.hWnd
    lngError = mciSendString(strTargetWindow, strReturn, lngLenStr, 0)
    
    If lngError Then
        PlayAVI = GetMCIError(lngError)
        Exit Function
    End If
    ' Force the target window to realize the palette of its background
    ' window. If you don't do this, then youll see ugly palette
    ' flashes in 256 color mode.
    lngError = mciSendString("realize " & strAlias & _
        " background", strReturn, lngLenStr, 0)
    If lngError Then
        PlayAVI = GetMCIError(lngError)
        Exit Function
    End If
    ' Get the size (in pixels) of the AVI in the form of a string
    strRect = Space$(128)
    lngError = mciSendString("where " & strAlias & " destination", strRect, _
        Len(strRect), 0)
    
    If lngError Then
        PlayAVI = GetMCIError(lngError)
        Exit Function
    End If
    ' Convert the AVI size string into a rect value
    rctResize = StrToRect(Trim(strRect))
    ' Since we are using pixels, set the parent's
    ' scalemode to pixels
    picTarget.Container.ScaleMode = vbPixels
    ' If rctResize contains valid data, then resize picTarget
    If rctResize.Right > 0 Then
        picTarget.Width = rctResize.Right - rctResize.Left
        picTarget.Height = rctResize.Bottom - rctResize.Top
    End If
    ' Refresh the container to avoid ugly painting problems
    picTarget.Container.Refresh
    ' Play the AVI file synchronously
    lngError = mciSendString("play " & strAlias & " wait", _
        strReturn, lngLenStr, 0)
    
    If lngError Then
        PlayAVI = GetMCIError(lngError)
        Exit Function
    End If
    DoEvents
    'Close the AVI file
    lngError = mciSendString("close " & strAlias, strReturn, lngLenStr, 0)
    
    If lngError Then
        PlayAVI = GetMCIError(lngError)
        Exit Function
    End If
    'Return success value
    PlayAVI = "Success"
End Function

Public Function StrToRect(RectDimensions As String) As RECT
    On Error Resume Next
    If Right(RectDimensions, 1) = Chr(0) Then
        RectDimensions = Left(RectDimensions, Len(RectDimensions) - 1)
    End If
    'Variables for holding the needed length of the string
    Dim lngLeftCount, lngTopCount, lngRightCount, lngBottomCount As Long
    'Variables for holding the needed string
    Dim strLeft, strTop, strRight, strBottom As String
    'A variable to hold the values of the rectangle dimensions
    'until we are ready to pass them to the
    function value
        Dim rctTemp As RECT
        'Retrieve the length of the string used for the value of Left (X1)
        lngLeftCount = InStr(1, " ", RectDimensions, vbBinaryCompare) + 1
        'Retrieve the value of Left (X1)
        rctTemp.Left = CLng(Left(RectDimensions, lngLeftCount))
        'Retrieve the string used for the value
        'of Top (Y1) using only the length of the string remaining
        'after retrieving the value of Left (X1)
        strTop = Right(RectDimensions, Len(RectDimensions) - lngLeftCount)
        'Remove any leading or trailing spaces
        strTop = Trim(strTop)
        'Retrieve the length of the string used for the value of Top (Y1)
        lngTopCount = InStr(1, strTop, " ", vbBinaryCompare)
        'Retrieve the value of Top (Y1)
        rctTemp.Top = CLng(Left(strTop, lngTopCount))
        'Retrieve the string used for the value of Right (X2) using only
        'the length of the string remaining after retrieving the value of
        'Top (Y1)
        strRight = Right(strTop, Len(strTop) - lngTopCount)
        'Remove any leading or trailing spaces
        strRight = Trim(strRight)
        'Retrieve the length of the string used for the value of Right (X2)
        lngRightCount = InStr(1, strRight, " ", vbTextCompare)
        'Retrieve the value of Right (X2)
        rctTemp.Right = CLng(Left(strRight, lngRightCount))
        'Retrieve the string used for the value of Bottom (Y2) using only
        'the length of the string remaining after retrieving the value of
        'Right (X2)
        strBottom = Right(strRight, Len(strRight) - lngRightCount)
        strBottom = Trim(strBottom)
        'Retrieve the length of the string used for the value of Bottom (Y2)
        'Retrieve the value of Bottom (Y2)
        rctTemp.Bottom = CLng(strBottom)
        'Pass the values of the rectangle to our function value
        StrToRect = rctTemp
    End Function

'In the event of your choice, insert the following code to play
    'an AVI. Please note that you must have a PictureBox on your form.
    'We will call this picturebox Pic1
    Dim RetVal As String
    RetVal = PlayAVI(Pic1, "C:\MyAVI.AVI")
    'RetVal will contain the return value of the PlayAVI function.
 Inputs:
Accepts two parameters. One is a reference to a 
picture box, the other 
is the path to the AVI file to play.

Returns:
A string indicating success or failure.

Public Declare Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
Public Declare Function mciGetErrorString Lib _
"winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError _
As Long, ByVal lpstrBuffer As String, ByVal uLength As _
Long) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Function GetMCIError(lngError As Long) As String
On Error Resume Next
Dim strError As String
Dim LenStr As Long
'Fill our string variable with spaces.

strError = Space(255)
'Specify the max length of the returned string

LenStr = 254
'Return the error string if one is found, otherwise it

'is an unknown error.

If mciGetErrorString(lngError, strError, LenStr) Then
GetMCIError = RTrim(strError)
Else
GetMCIError = "Unknown MCI Error!"
End If
End Function

'The following function accepts two params,

'one is a reference to a picture box, the other is the

'path to the avi file to play.

Public Function PlayAVI(ByRef picTarget As PictureBox, _
ByVal strAVIName As String) As String
On Error Resume Next
'Declare our variables

Dim strAlias As String
Dim strRect As String
Dim rctResize As RECT
Dim lngError As Long
Dim strTargetWindow As String
Dim strReturn As String
Dim lngLenStr As Long
'Fill our string variable with spaces.

strReturn = Space(128)
'Assign a value of 127 to lngLenStr so that the MCI

'command knows the max value of the return string

lngLenStr = 127
'Assign a value to the strAlias variable so the mci

'has an alias to use

strAlias = "PLAYAVI"
'If the AVI file is not provided or found, then exit function

If strAVIName = "" Or Len(Dir(strAVIName)) = 0 Then
PlayAVI = strAVIName & " was Not found!"
Exit Function
End If
'Make sure the AVI file name is in quotes

'(required for long filenames)

If Left(strAVIName, 1) <> """" Then strAVIName = """" & strAVIName & """"
'Open the AVI and give it the alias contained in strAlias

lngError = mciSendString("open " & strAVIName & " Alias " & strAlias, _
strReturn, lngLenStr, 0)
If lngError = 289 Then
lngError = mciSendString("close " & strAlias, strReturn, lngLenStr, 0)

If lngError Then
PlayAVI = GetMCIError(lngError)
Exit Function
End If
lngError = mciSendString("open " & strAVIName & " Alias " & strAlias, _
strReturn, lngLenStr, 0)
End If

If lngError Then
PlayAVI = GetMCIError(lngError)
Exit Function
End If
'Enable audio

lngError = mciSendString("set " & strAlias & _
" audio all on", strReturn, lngLenStr, 0)
If lngError Then
PlayAVI = GetMCIError(lngError)
Exit Function
End If
'Set the target window using the alias and the hWnd of the picture box

strTargetWindow = "window " & strAlias & " handle " & picTarget.hWnd
lngError = mciSendString(strTargetWindow, strReturn, lngLenStr, 0)

If lngError Then
PlayAVI = GetMCIError(lngError)
Exit Function
End If
' Force the target window to realize the palette of its background

' window. If you don't do this, then youll see ugly palette

' flashes in 256 color mode.

lngError = mciSendString("realize " & strAlias & _
" background", strReturn, lngLenStr, 0)
If lngError Then
PlayAVI = GetMCIError(lngError)
Exit Function
End If
' Get the size (in pixels) of the AVI in the form of a string

strRect = Space$(128)
lngError = mciSendString("where " & strAlias & " destination", strRect, _
Len(strRect), 0)

If lngError Then
PlayAVI = GetMCIError(lngError)
Exit Function
End If
' Convert the AVI size string into a rect value

rctResize = StrToRect(Trim(strRect))
' Since we are using pixels, set the parent's

' scalemode to pixels

picTarget.Container.ScaleMode = vbPixels
' If rctResize contains valid data, then resize picTarget

If rctResize.Right > 0 Then
picTarget.Width = rctResize.Right - rctResize.Left
picTarget.Height = rctResize.Bottom - rctResize.Top
End If
' Refresh the container to avoid ugly painting problems

picTarget.Container.Refresh
' Play the AVI file synchronously

lngError = mciSendString("play " & strAlias & " wait", _
strReturn, lngLenStr, 0)

If lngError Then
PlayAVI = GetMCIError(lngError)
Exit Function
End If
DoEvents
'Close the AVI file

lngError = mciSendString("close " & strAlias, strReturn, lngLenStr, 0)

If lngError Then
PlayAVI = GetMCIError(lngError)
Exit Function
End If
'Return success value

PlayAVI = "Success"
End Function

Public Function StrToRect(RectDimensions As String) As RECT
On Error Resume Next
If Right(RectDimensions, 1) = Chr(0) Then
RectDimensions = Left(RectDimensions, Len(RectDimensions) - 1)
End If
'Variables for holding the needed length of the string

Dim lngLeftCount, lngTopCount, lngRightCount, lngBottomCount As Long
'Variables for holding the needed string

Dim strLeft, strTop, strRight, strBottom As String
'A variable to hold the values of the rectangle dimensions

'until we are ready to pass them to the

function value
Dim rctTemp As RECT
'Retrieve the length of the string used for the value of Left (X1)

lngLeftCount = InStr(1, " ", RectDimensions, vbBinaryCompare) + 1
'Retrieve the value of Left (X1)

rctTemp.Left = CLng(Left(RectDimensions, lngLeftCount))
'Retrieve the string used for the value

'of Top (Y1) using only the length of the string remaining

'after retrieving the value of Left (X1)

strTop = Right(RectDimensions, Len(RectDimensions) - lngLeftCount)
'Remove any leading or trailing spaces

strTop = Trim(strTop)
'Retrieve the length of the string used for the value of Top (Y1)

lngTopCount = InStr(1, strTop, " ", vbBinaryCompare)
'Retrieve the value of Top (Y1)

rctTemp.Top = CLng(Left(strTop, lngTopCount))
'Retrieve the string used for the value of Right (X2) using only

'the length of the string remaining after retrieving the value of

'Top (Y1)

strRight = Right(strTop, Len(strTop) - lngTopCount)
'Remove any leading or trailing spaces

strRight = Trim(strRight)
'Retrieve the length of the string used for the value of Right (X2)

lngRightCount = InStr(1, strRight, " ", vbTextCompare)
'Retrieve the value of Right (X2)

rctTemp.Right = CLng(Left(strRight, lngRightCount))
'Retrieve the string used for the value of Bottom (Y2) using only

'the length of the string remaining after retrieving the value of

'Right (X2)

strBottom = Right(strRight, Len(strRight) - lngRightCount)
strBottom = Trim(strBottom)
'Retrieve the length of the string used for the value of Bottom (Y2)

'Retrieve the value of Bottom (Y2)

rctTemp.Bottom = CLng(strBottom)
'Pass the values of the rectangle to our function value

StrToRect = rctTemp
End Function

'In the event of your choice, insert the following code to play

'an AVI. Please note that you must have a PictureBox on your form.

'We will call this picturebox Pic1

Dim RetVal As String
RetVal = PlayAVI(Pic1, "C:\MyAVI.AVI")
'RetVal will contain the return value of the PlayAVI function.

Inputs:
Accepts two parameters. One is a reference to a
picture box, the other
is the path to the AVI file to play.

Returns:
A string indicating success or failure.