Замучал склероз

Все вопросы «а не подскажете, где мне найти...» обсуждаются только здесь.
Ariman
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 817
Зарегистрирован: 02.09.2003 (Вт) 16:23
Откуда: Великая наша держава, г.Москва

Замучал склероз

Сообщение Ariman » 06.02.2005 (Вс) 18:08

Блин, маразм напал... Помню, что где-то видел статью, помню что на комп себе сохранял... А вот где видел и куда сохранял - не помню! :?

Люди, кто знает, где лежит статья про то, как проиграть AVI в PictureBox'е??

A.A.Z.
Член-корреспондент академии VBStreets
Член-корреспондент академии VBStreets
 
Сообщения: 3035
Зарегистрирован: 30.06.2003 (Пн) 13:38

Сообщение A.A.Z. » 06.02.2005 (Вс) 19:11

Статью не видел, но проиграть можно так:
Код: Выделить всё
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

Ariman
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 817
Зарегистрирован: 02.09.2003 (Вт) 16:23
Откуда: Великая наша держава, г.Москва

Сообщение Ariman » 07.02.2005 (Пн) 20:12

Спасибо!
Сейчас времени нет, а как будет обязательно гляну код.


Вернуться в Народный поиск

Кто сейчас на конференции

Сейчас этот форум просматривают: SemrushBot и гости: 11

    TopList