Разделы
Главная

Windows API
Реестр
MS Access
Visual Basic
Download
Форум
Гостевая книга
Ссылки

E-mail

Партнерская программа WWW.PORTA.RU (on-line магазин портативной аудио, видео, фототехники). Самая щедрая, самая честная, самая популярная. Приглашаем всех веб-мастеров к участию!



Submitter.ru - Free promoting
Visual Basic

вернуться назад Как воспроизвести AVI-файл?
Текст модуля:

' воспроизведение AVI-файла
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


Текст формы:

' воспроизведение AVI-файла
' для работы необходимо добавить:
' PictureBox и CommandButton


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

'Retrieve short file name format
RetVal = GetShortPathName(FileName, ShortFileName, Len(ShortFileName))
FileName = Left$(ShortFileName, RetVal)

'Open the device
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

'remember that the device is now open
deviceIsOpen = True

'Resize the movie to PictureBox size
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

'Play the file
CommandString = "Play AVIFile wait"
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal <> 0 Then GoTo error

'Close the device
CommandString = "Close AVIFile"
RetVal = mciSendString(CommandString, vbNullString, 0, 0&)
If RetVal <> 0 Then GoTo error

Exit Sub

error:
'An error occurred.
'Get the error description

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

'close the device if necessary
If deviceIsOpen Then
CommandString = "Close AVIFile"
mciSendString CommandString, vbNullString, 0, 0&
End If

'raise a custom error, with the proper description
Err.Raise 999, , ErrorString
End Sub

Private Sub Command1_Click()
Dim FileName As String
FileName = "C:\Мои документы\Разработки\VB\PlayAVI\10.avi"
Call PlayAVIPictureBox(FileName, Picture1)
End Sub

Private Sub Form_Load()
Command1.Caption = "Проиграть AVI-файл"
Me.Caption = "Проиграть AVI-файл"
End Sub

Воспроизведение AVI-файла (5 889 байт)