Přehrávání AVI souboru v PictureBoxu

Postup:
Do projektu přidejte modul. v něm zapište:

Const WS_CHILD = &H40000000

Private 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

' FileName musí obsahovat jméno souboru včetně celé cesty.
' Window je PictureBox ve kterém chcete AVI přehrát
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

    RetVal = GetShortPathName(FileName, ShortFileName, Len(ShortFileName))
    FileName = Left$(ShortFileName, RetVal)
    
    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
        deviceIsOpen = True
        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
   
    CommandString = "Play AVIFile wait"
    RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
    If RetVal <> 0 Then GoTo error
    
    CommandString = "Close AVIFile"
    RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
    If RetVal <> 0 Then GoTo error

    Exit Sub
    
error:
    Dim ErrorString As String
    ErrorString = Space$(256)
    mciGetErrorString RetVal, ErrorString, Len(ErrorString)
    ErrorString = Left$(ErrorString, InStr(ErrorString, vbNullChar) - 1)

    If deviceIsOpen Then
        CommandString = "Close AVIFile"
        mciSendString CommandString, vbNullString, 0, 0&
    End If

    Err.Raise 999, , ErrorString

End Sub

Použití:
Private Sub Command1_Click() 

   PlayAVIPictureBox "c:\winnt\clock.avi", Picture1 

End Sub

Zpět