Виктор Маковчик

Private Declare Function mciSendCommand Lib "winmm.dll" _
		Alias "mciSendCommandA" (ByVal wDeviceID As Long, ByVal uMessage As Long, _
		ByVal dwParam1 As Long, ByRef dwParam1 As Any) As Long

В процессе работы мультимедиа могут возникать различные ошибки - например, отсутствуют соответствующие кодеки либо параметры экрана не позволяют воспроизводить видео и т.д.
Для обработки возможных ошибок воспроизведения воспользуемся еще одной функцией из той же библиотеки:

Private Declare Function mciGetErrorString Lib "winmm.dll" _
Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _
ByVal uLength As Long) As Long

Вспомогательные переменные опишем как скрытые свойства объекта.

'Имя видеофайла
Private AVIFile As String

'Ссылка на открытый AVI-файл
Private hAVI As Long

'Код ошибки
Private hErr As Long

Так как воспроизведение видео (в отличие от звука;) должно происходить в каком-нибудь окне, то по умолчанию зарегистрированный в Windows проигрыватель создает свое собственное окно. Если надо организовать вывод в окно приложения, надо передать в MCI ссылку на него. В данном примере будем пользоваться окном формы. Оно будет активным, например, в момент нажатия кнопки воспроизведения. Поэтому, чтобы получить ссылку на окно, воспользуемся функцией WinAPI - GetActiveWindow. Она возвращает ссылку на текущее активное окно.

Private Declare Function GetActiveWindow _
Lib "user32" () As Boolean

Для определения размеров области вывода внутри окна опишем еще одну функцию Windows.

Private Declare Function GetClientRect Lib "user32" _
(ByVal hWnd As Long, lpRect As RECT) As Long

Теперь перейдем непосредственно к программированию команд MCI. Для этого нам понадобится список всех типов и констант этого интерфейса. В рамках газетной статьи приводить его бессмысленно, т.к. эту информацию легко можно найти в любом серьезном help'е по WinAPI.
А проще всего скачать готовый работающий пример вместе с исходниками с сайта http://brestmedia.f2s.com/.

Свойство-метод Error, возвращающее описание ошибки, используется только для чтения внутри других методов объекта.

Property Get Error()
	Dim strBuffer As String
	Dim lngPos As Long
	Dim lngRet As Long
	
	If hErr <> 0 Then
		'Создать пустую строку как буфер
		strBuffer = Space(1024)
		
		'Получить сообщение по коду ошибки
		Call mciGetErrorString(hErr, strBuffer, 1024)
		hErr=0
	End If
	Error = Trim(strBuffer)
End Property

Свойство-метод Play, при присваивании ему имени AVI-файла начинает воспроизводить видео в текущем активном окне.

Property Let Play(ByVal strAVIFileName As String)
	'Описание переменных для работы с MCI
	Dim mci As MCI_OPEN_PARMS
	Dim mpp As MCI_PLAY_PARMS
	Dim mow As MCI_OVLY_WINDOW_PARMS
	Dim morSource As MCI_OVLY_RECT_PARMS
	Dim morDest As MCI_OVLY_RECT_PARMS
	
	'Описание переменных для работы с окном
	Dim mhWnd As Long
	Dim rc As RECT
	
	mhWnd = 0
	
	'Имя видеофайла
	AVIFile = strAVIFileName
	
	'Открытие мультимедиа-устройства
	With mci
		.strDeviceType = "avivideo"
		.strElementName = strAVIFileName
	End With

	If hAVI <> 0 Then
		CloseDevice
	End If
	
	hErr = mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE Or MCI_OPEN_ELEMENT, mci)
	If hErr = 0 Then
		hAVI = mci.lngDeviceID
	Else
		'Вывод сообщения об ошибке
		Err.Raise hErr, "VideoPlayer::Play", Error 'OpenDevice
	End If
	
	'Установка активного окна для воспроизведения
	Dim lngFlags As Long
		
		If hAVI Then
			'Установка флагов по умолчанию
			lngFlags = MCI_OVLY_WINDOW_HWND Or _
				MCI_OVLY_WINDOW_ENABLE_STRETCH
				' MCI_OVLY_WINDOW_DISABLE_STRETCH
			
			'Получить ссылку на активное окно
			mhWnd = GetActiveWindow()
			mow.hWnd = mhWnd
			
			'Установка названия окна
			'mow.strText = mstrCaption
			'lngFlags = lngFlags Or MCI_OVLY_WINDOW_TEXT
			
			'Запуск MCI_WINDOW команды
			'для указания окна
			hErr = mciSendCommand(hAVI, MCI_WINDOW, _
			lngFlags, mow)
			
			If hErr <> 0 Then
				Err.Raise hErr, "VideoPlayer::Play", Error
			End If
		End If
	
	'Центрирование внутри области вывода окна
		If Len(strAVIFileName) > 0 And (mhWnd <> 0) Then
		
			' Запуск MCI_WHERE команды для получения
			' размера области вывода .AVI файла
			hErr = mciSendCommand(hAVI, MCI_WHERE, _
			MCI_OVLY_WHERE_SOURCE, morSource)
			If hErr = 0 Then

				' Получить размеры доступной области окна для вывода
				If CBool(GetClientRect(mhWnd, rc)) Then
				
					' Центрирование
					With rc
						morDest.rc.Top = (.Bottom -.Top - _
						morSource.rc.Bottom) / 2
						morDest.rc.Left = (.Right -.Left - _
						morSource.rc.Right) / 2
					End With
					
					' Запуск MCI_PUT команды для размещения
					' области вывода в расчитанной позиции
					' указанного окна
					hErr = mciSendCommand(hAVI, _
					MCI_PUT, MCI_OVLY_PUT_DESTINATION Or _
					MCI_OVLY_RECT, morDest)
					If hErr <> 0 Then
						Err.Raise hErr, "VideoPlayer::Play", Error
					End If
				Else
						Err.Raise hErr, "VideoPlayer::Play", Error
				End If
			Else
				Err.Raise hErr, "VideoPlayer::Play", Error
			End If
		End If
	
	
	'Воспроизведение
	If hAVI Then
		hErr = mciSendCommand(hAVI, MCI_PLAY, 0&, 0&)
			If hErr <> 0 Then
				Err.Raise hErr, "VideoPlayer::Play", Error
			End If
	End If
	
End Property


'Метод закрывает мультимедиа-устройство
'Доступен для вызова из других объектов
Public Sub CloseDevice()
	If hAVI Then
		' Если видео воспроизводится - остановить
		If IsPlaying Then
			StopPlaying
		End If
		
		' Закрыть устройство
		hErr = mciSendCommand(hAVI, MCI_CLOSE, 0&, 0&)
		If hErr = 0 Then
			hAVI = 0
		Else
			Err.Raise hErr, "VideoPlayer::CloseDevice", Error
		End If
	End If
End Sub

'Метод прерывает воспроизведение
'Доступен для вызова из других объектов
Public Sub StopPlaying()
		If hAVI Then
			hErr = mciSendCommand(hAVI, MCI_STOP, 0&, 0&)
			If hErr <> 0 Then
				Err.Raise hErr, "VideoPlayer::StopPlaying", Error
			End If
		End If
End Sub

'Свойство-метод, возвращает истину
'если идет воспроизведение
Property Get IsPlaying() As Boolean
		Dim mst As MCI_STATUS_PARMS
		
		If hAVI Then
			With mst
				.lngItem = MCI_STATUS_MODE
				.lngTrack = 0
			End With
				'Получить состояние устройства
				hErr = mciSendCommand(hAVI, MCI_STATUS, _
					MCI_STATUS_ITEM, mst)
			If hErr = 0 Then
				IsPlaying = (mst.lngReturn = MCI_MODE_PLAY)
			Else
				Err.Raise hErr, "VideoPlayer::IsPlaying", Error
			End If
		End If
End Property

'Удаление класса
Private Sub Class_Terminate()
		CloseDevice
End Sub

Для использования VideoPlayer в редакторе Visual Basic откройте для редактирования форму ownMediaPlayer.
Добавьте кнопку проигрывания видео и двойным щелчком мыши по форме перейдите в окно редактирования исходного текста формы.
В разделе описаний добавьте строку:

Dim AVIPlayer As VideoPlayer '- объект типа VideoPlayer

'Метод инициализации формы уже будет выглядеть так:
Private Sub UserForm_Initialize()
		'Создание экземпляра объекта
		Set AVIPlayer = New VideoPlayer
		Set dlgFiler = New dlgFileOpen
End Sub

'Метод обработки события -
'нажатия кнопки выбора файла
Private Sub CommandButton2_Click()
		TextBox1.Value = dlgFiler.OpenFile
		("AVI-Файлы" & vbNullChar & "*.AVI",,, "Выбирайте видеозапись")
End Sub

'Нажатие кнопки проигрывания видео
Private Sub CommandButton1_Click()
		AVIPlayer.Play = TextBox1.Value
End Sub


Метод UserForm_QueryClose выполняется перед закрытием формы,
 поэтому воспроизведение видео необходимо прервать и закрыть устройство.

Private Sub UserForm_QueryClose(Cancel As Integer, _
	CloseMode As Integer)
		AVIPlayer.CloseDevice
End Sub

Сохраните набранные программы, перейдите в таблицу Excel и нажмите кнопку запуска формы. Нажмите кнопку выбора файла и укажите AVI-файл. В поле ввода формы появится его полное имя. Теперь нажмите кнопку воспроизведения и откиньтесь на спинку кресла...
Приведенная методика проигрывания видео работает на всех версиях Windows, начиная с 95, независимо от установленных компонентов. Все остальные компоненты и объекты, облегчающие применение мультимедиа при разработке приложений в таких средах, как Delphi или C++, так или иначе используют те же приемы, но требуют дополнительно наличия соответствующих .OCX или .DLL файлов. Поэтому, может, надежней сделать самому?