- Код: Выделить всё
Err.Raise 999, , ErrorString
З.Ы. как сделать что бы он проигрывался бесконечно, точнее до определенного события?
Зарание спасибо.
З.Ы.Ы.
Вот код:
- Код: Выделить всё
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
Const WS_CHILD = &H40000000
Sub PlayAVIPictureBox(Filename As String, ByVal Window As PictureBox)
On Error Resume Next
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
'Err.Raise 1, "send.avi", ErrorString
'Err.Clear
End Sub
Private Sub Command1_Click()
PlayAVIPictureBox "send.avi", Picture1
End Sub