Блин, маразм напал... Помню, что где-то видел статью, помню что на комп себе сохранял... А вот где видел и куда сохранял - не помню!
Люди, кто знает, где лежит статья про то, как проиграть AVI в PictureBox'е??
Option Explicit
Private Declare Function mciSendString& Lib "winmm" Alias "mciSendStringA" (ByVal lpstrCommand$, ByVal lpstrReturnString$, ByVal uReturnLength&, ByVal hwndCallback&)
Private Declare Function mciGetErrorString& Lib "winmm" Alias "mciGetErrorStringA" (ByVal dwError&, ByVal lpstrBuffer$, ByVal uLength&)
Private Declare Function GetShortPathName& Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath$, ByVal lpszShortPath$, ByVal cchBuffer&)
Private Const WS_CHILD As Long = &H40000000
Sub PlayAVIPictureBox(FileName$, ByVal Window As PictureBox)
Dim RetVal&, CommandString$, ShortFileName As String * 260, 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$
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
Сейчас этот форум просматривают: SemrushBot и гости: 11