Проигрывание видео из ресурсов

[Strayd]

Вот все нормальные программы если нужно показать анимацию они просто записывают в программу ресурс с AVI а потом воспроизводят его.ПОЖАЛУЙСТА подскажите API для того чтобы это сделать !!!

[MEMBER]

Рой отсюда:
http://bbs.vbstreets.ru/viewtopic.php?t=2295

[Strayd]

Пробовал но на чём его воспроезводить? В этом коде API НА ПРОИГРЫВАНИЕ ЗВУКА а мне нужен API для воспроезведения видео !!!!

[Sebas]

ДА, кстати, мне тоже интересно...

[Sebas]

И тут же наткнулся..... в сочитании с первым примером.

Код: Выделить всё

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


Declare Function mciGetErrorString Lib "winmm" Alias _
"mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _
ByVal uLength As Long) As Long
Declare Function GetShortPathName Lib "kernel32" Alias _
"GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Const WS_CHILD = &H40000000



Этот код напишите в форме проекта: 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

'Изменяем размеры видио в соответствии с Picture
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




[Aleksej]

А если просто использовать класс SysAnimate32

[Strayd]

Да спасибо но при воспроезвидении видео все формы проекта становяться не активными.Подскажите как побороть этот недостаток !!!

[Aleksej]

Используй класс SysAnimate32 :

Код: Выделить всё

Private Declare Function CreateWindowEx Lib "User32" Alias _
                         "CreateWindowExA" (ByVal dwExStyle As Long, _
                                            ByVal lpClassName As String, _
                                            ByVal lpWindowName As String, _
                                            ByVal dwStyle As Long, _
                                            ByVal x As Long, _
                                            ByVal y As Long, _
                                            ByVal nWidth As Long, _
                                            ByVal nHeight As Long, _
                                            ByVal hWndParent As Long, _
                                            ByVal hMenu As Long, _
                                            ByVal hInstance As Long, _
                                            lpParam As Any) As Long
Private Declare Function SendMessage Lib "User32" Alias _
                         "SendMessageA" (ByVal hwnd As Long, _
                                         ByVal wMsg As Long, _
                                         ByVal wParam As Long, _
                                         lParam As Any) As Long
Private Declare Function ShowWindow Lib "User32" (ByVal hwnd As Long, _
                                     ByVal nCmdShow As Long) As Long
Private Declare Function DestroyWindow Lib "User32" _
                                     (ByVal hwnd As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias _
                         "LoadLibraryA" ( _
                         ByVal lpLibFileName As String) As Long

Private Const SW_SHOW = 5
Private Const WS_BORDER = &H800000
Private Const WS_CHILD = &H40000000
Private Const WM_USER = &H400
Private Const ACS_CENTER = &H1
Private Const ACS_TRANSPARENT = &H2
Private Const ACS_AUTOPLAY = &H4
Private Const ACM_OPEN = WM_USER + 100
Private Const ACM_PLAY = WM_USER + 101
Private Const ACM_STOP = WM_USER + 102

Enum AviFile
    SearchFolder = 150
    FindFile = 151
    FindComp = 152
    FileCopy = 161
    FileDelR = 162
    FileDel = 163
    DelFromFolder = 164
    Scan = 165 ' NT & XP
    SearchInternet = 166 ' NT & XP
End Enum
'********************************************************************
'Функция создаёт AVI контрол и возращает его дескриптор
'********************************************************************
Public Function CreateAnimation(Avi As AviFile, _
                                 Form As Form, cx As Long, _
                                 cy As Long, cr As Long, _
                                 cb As Long) As Long

Dim hAvi As Long
Dim hWndAnim As Long
   
    hAvi = LoadLibrary("shell32.dll")
    If hAvi = 0 Then
        CreateAnimation = 0
        Exit Function
    End If
   
    hWndAnim = CreateWindowEx(0, _
                     "SysAnimate32", vbNullString, _
                     WS_CHILD Or ACS_TRANSPARENT Or ACS_CENTER Or _
                     ACS_AUTOPLAY, cx, cy, cr, cb, Form.hwnd, 0, _
                     hAvi, vbNullString)

    Call SendMessage(hWndAnim, ACM_OPEN, hAvi, ByVal Avi)
           
    Call ShowWindow(hWndAnim, SW_SHOW)

    CreateAnimation = hWndAnim
End Function
'******************************************************************
'Процедура проигрывает выбранный Avi файл
'hWndAnim - дескриптор
'******************************************************************
Public Sub PlayAvi(hWndAnim As Long)

    Call SendMessage(hWndAnim, ACM_PLAY, -1, ByVal -1)
End Sub
'******************************************************************
'Процедура закрывает выбранный Avi файл
'hWndAnim - дескриптор
'******************************************************************
Public Sub CloseAvi(hWndAnim As Long)
   
    Call SendMessage(hWndAnim, ACM_OPEN, 0, Null)
    Call DestroyWindow(hWndAnim)
End Sub
'******************************************************************
'Процедура останавливает выбранный Avi файл
'hWndAnim - дескриптор
'******************************************************************
Public Sub StopAvi(hWndAnim As Long)

    Call SendMessage(hWndAnim, ACM_STOP, 0, 0)
End Sub


[Sebas]

НУ и где здесь ресурсы?
И Вообще, где здесь источник AVI файла?

[Aleksej]

Источник - библиотека shell32, а если нужно проиграть AVI файл, то
необходимо заменить: hAvi=OpenFile(......)