Как записать видео и звук с WEB-Camera

[Vova_2581]

Здравствуйте!
И снова возникла у меня вот такая производственная необходимость. Для прохождения аккредитации в нашем ВУЗе спец. комиссия обязала нас сделать видео и аудио регистрацию учебного процесса для объективности оценивания знаний студентов. Короче, делать им не хрен и нас напрягают. В общем, помогите кто чем может, Христа ради! Получать видео картинку, пока без звука, с WEB камеры у меня получилось по такому вот коду...

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

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 capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName 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 nID As Long) As Long
Private mCapHwnd As Long
Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private Const GET_FRAME As Long = 1084
Private Const COPY As Long = 1054

Private Sub Form_Load()
Clipboard.Clear
STARTCAM
End Sub

Sub STARTCAM()
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 0, 0, Me.hwnd, 0)
DoEvents
SendMessage mCapHwnd, CONNECT, 0, 0
Timer.Enabled = True
End Sub

Sub STOPCAM()
DoEvents
SendMessage mCapHwnd, DISCONNECT, 0, 0
Timer.Enabled = False
End Sub

Private Sub Timer_Timer() 'Interval - 50 msec
On Error Resume Next
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Picture = Clipboard.GetData
Clipboard.Clear
End Sub

Private Sub Form_Unload(Cancel As Integer)
STOPCAM
End Sub

Подскажите, пожалуйста, как можно получить еще и звук и потом все это записать в какой-нибудь AVI-файл??? Это очень сложно сделать или как два пальца???..

[Vova_2581]

В интернете на форумах по Delphi нашел то, что нужно: в этом коде (см. приложение)... все захватывается и видео и звук и пишется в AVI, но я в Delphi ничего не смыслю. Если кто разбирается, посмотрите, как можно переделать этот код под VB???

[Teranas]

Посмотри в архиве там набор для Web камер, может что подойдёт.

[Vova_2581]

Я посмотрел архив, но про запись видео там ничего не нашел. Так... воспроизводить с WEB, писать в JPEG и BMP, чаты всякие и все. Это немного не то.

[Vova_2581]

Да... и еще: неплохо было бы узнать, как именно можно выбирать устройство для захвата изображения? А то у меня на тестовой машине их два - TV Tuner и USB-видеоустройство. Так иногда эти устройства путаются и программа ничего не отображает, поскольку пытается захватить видео с TV Tuner'a на котором никакой камеры нет, вместо USB камеры.

[Vova_2581]

Кажется начинаю немного "врубаться"... Если я правильно понимаю, то функция сapCreateCaptureWindow создает некий объект для захвата изображения с камеры и возвращает его манипулятор. А далее мы можем управлять уже этим объектом посредством WM_CAP_ХХХ неких инструкций к определенным действиям объекта, и передаваемые объекту через функцию SendMessage. Так вот, инструкция, которая заставит объект записывать видео и звук на диск, именуется вроде как WM_CAP_FILE_SET_CAPTURE_FILEA. Попробую покопать в этом направлении, может чего и получится.

[Vova_2581]

Ха!! Все получилось!! Немного доработаю и выложу сюда код.

[Teranas]

Ждём с нетерпением...

[Vova_2581]

В общем, программу я немного переделал. Во-первых, я ошибся: WM_CAP_FILE_SET_CAPTURE_FILEA только создает файл, а записывает видео другая инструкция WM_CAP_SEQUENCE. Во-вторых, я убрал таймер и отвязался от системного буфера обмена. Он, по сути, не нужен. В-третьих, добавил кнопку выбора видеоустройства. Дело в том, что, как я уже говорил ранее, их в системе может быть несколько. Теперь можно выбирать источник видеосигнала с настройками изображения. В-четвертых, кнопкой «Записать видео»... в корневом каталоге создается файл с определенным именем в формате «День_Месяц_Год Часы_Минуты_Секунды» начало создания видео-файла с расширением AVI.
Все работает более-менее сносно, правда периодически глючит. Не могу понять, почему запись идет только тогда, когда окно моей программы с захваченным изображением с камеры находится в фокусе, а как только я переключаюсь куда-либо в другое окно (меняю фокус) – все... запись тут же прекращается??? Почему это происходит не могу понять. Может, кто знает из ГУРУ??? Как этого избежать???
Вот весь переделанный код...

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

Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName 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 nID As Long) 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 mCapHwnd As Long
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WM_USER = 1024
Private Const WM_CAP_START = WM_USER
Private Const WM_CAP_STOP = WM_CAP_START + 68
Private Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Private Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
Private Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Private Const WM_CAP_SET_PREVIEW = WM_USER + 50
Private Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52
Private Const PREVIEWRATE = 30 '30 msec
Private Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42
Private Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23
Private Const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20
Private Const WM_CAP_SEQUENCE = WM_CAP_START + 62

Private Sub Form_Load()
On Error Resume Next
'Создаем объект захвата видео и привязываем его к нашему PictureBox (PictureView)...
mCapHwnd = capCreateCaptureWindow("WebcamCapture", WS_CHILD Or WS_VISIBLE, 0, 0, _
PictureView.ScaleWidth, PictureView.ScaleHeight, PictureView.hwnd, 0)
DoEvents
If mCapHwnd = 0 Then
  MsgBox "Не удалось подключиться к видеоустройству", vbExclamation, App.Title
  End
Else 'Подключаем драйвер камеры...
  SendMessage mCapHwnd, WM_CAP_DRIVER_CONNECT, 0, 0
End If
STARTCAM 'Захват видео с камеры
End Sub

Sub STARTCAM()
  'Устанавливаем масштаб...
  'SendMessage mCapHwnd, WM_CAP_SET_SCALE, True, 0
  'Выводим изображение с камеры на объект PictureBox (PictureView)...
  SendMessage mCapHwnd, WM_CAP_SET_PREVIEW, True, 0
  SendMessage mCapHwnd, WM_CAP_SET_PREVIEWRATE, PREVIEWRATE, 0 'PREVIEWRATE - число миллисекунд
End Sub

Private Sub cmd_VideoSource_Click()
'Вызываем диалог выбора источника видеосигнала с настройками...
SendMessage mCapHwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0
End Sub

Private Sub cmd_SaveToFile_Click()
'Записываем видео и звук с камеры в формате AVI...
Dim strDate, strTime, NameVideoFile As String
strDate = CStr(Replace(Date, ".", "_", 1))
strTime = CStr(Replace(Time, ":", "_", 1))
NameVideoFile = strDate & " " & strTime
SendMessage mCapHwnd, WM_CAP_FILE_SET_CAPTURE_FILEA, 0, ByVal NameVideoFile & ".avi"
SendMessage mCapHwnd, WM_CAP_SEQUENCE, 0, 0 'Начало записи
DoEvents
End Sub

Sub STOPCAM()
'Останавливаем захват с камеры...
SendMessage mCapHwnd, WM_CAP_STOP, 0, 0
DoEvents
End Sub

Private Sub cmd_Stop_Click() 'Остановить запись...
STOPCAM
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call STOPCAM
'Отключаемся от видеоустройства...
SendMessage mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
End Sub


[Vova_2581]

И еще... по кнопке "Остановить запись" нужно кликать два раза. Тогда остановка происходит сразу, а иначе зависает... Тоже не понятно почему?

[Vova_2581]

Я, кажется, понял в чем дело. Попробую сам догнать, потом отпишусь...

[Vova_2581]

Итак, продолжим... Может, кому будет нужно, хотя... судя по тому, как мне тут отвечают, я так понял, эта тема вообще никому не нужна и не интересна. Ладно, тогда грядущим поколениям посвящается...
Итак, в MSDN указывается некая структура под названием CAPTUREPARMS. Именно с этими настройками, если мы ничего не меняем, то запускается управление процессом потокового видеозахвата. Так вот, в этой структуре есть ряд нужных нам параметров: fAbortLeftMouse, fAbortRightMouse и vKeyAbort – они предназначены для прекращения потокового захвата. fAbortLeftMouse и fAbortRightMouse по-умолчанию имеют значение TRUE, а vKeyAbort настроен на виртуальную клавишу ESC. То есть, получается так, что любой клик левой или правой клавишей мышки, а так же нажатие на кнопку ESC прекращает процесс видеозахвата - вот в чем была загадка! Следовательно, нам нужно отключить это свойство и назначить свою комбинацию клавиш для остановки... например - Ctrl+Shift+End. Ну а сделать мы все это сможет через сообщения WM_CAP_GET_SEQUENCE_SETUP и соответственно - WM_CAP_SET_SEQUENCE_SETUP перед вызовом WM_CAP_SEQUENCE. У меня все получилось по такому коду...

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

Private Type CAPTUREPARMS
    dwRequestMicroSecPerFrame As Long
    fMakeUserHitOKToCapture As Long
    wPercentDropForError As Long
    fYield As Long
    dwIndexSize As Long
    wChunkGranularity As Long
    fUsingDOSMemory As Long
    wNumVideoRequested As Long
    fCaptureAudio As Long
    wNumAudioRequested As Long
    vKeyAbort As Long
    fAbortLeftMouse As Long
    fAbortRightMouse As Long
    fLimitEnabled As Long
    wTimeLimit As Long
    fMCIControl As Long
    fStepMCIDevice As Long
    dwMCIStartTime As Long
    dwMCIStopTime As Long
    fStepCaptureAt2x As Long
    wStepCaptureAverageFrames As Long
    dwAudioBufferSize As Long
    fDisableWriteCache As Long
    AVStreamMaster As Long
End Type

Private Const Ctrl = &H8000
Private Const Shift = &H4000
Private Const VK_END = 35

‘ В процедуре...
Dim capParms As CAPTUREPARMS
SendMessage mCapHwnd, WM_CAP_GET_SEQUENCE_SETUP, Len(capParms), capParms
With capParms
   .fAbortLeftMouse = 0   ‘Отключаем левую клавишу мышки
   .fAbortRightMouse = 0  ‘Отключаем правую клавишу мышки
   .vKeyAbort = Ctrl Or Shift Or VK_END ‘Наши горячие клавиши Ctrl+Shift+End
End With   

‘и применяем...
SendMessage mCapHwnd, WM_CAP_SET_SEQUENCE_SETUP, Len(capParms), capParms
SendMessage mCapHwnd, WM_CAP_SEQUENCE, 0, 0 ‘Начало записи


Теперь все работает, как нужно именно нам!

Но есть еще ряд проблем... Например, после начала записи видеопотока наше приложение как бы «застывает», блокируются все элементы управления на форме, невозможно нажать ни одну кнопку, вывести в динамике какую-нибудь информацию в Label, например, таймер... и так далее. Ничего невозможно сделать пока запись не остановиться. Это большой минус!
А так же сообщение WM_CAP_DLG_VIDEOFORMAT вызывает окно диалога настройки видеоформата, в котором есть ограничение в разрешении. С одной стороны это, конечно, разумно, поскольку снимает ряд проблем и глюков при работе с высоким разрешением, и, видимо, так и задумано, но с другой стороны, когда вы подключаете хорошую дорогую WEB камеру, поддерживающую качество HD или даже Full HD, и не можете его использовать, поскольку окно диалога не пускает вас выше 640х480 (480р) – это так же не есть хорошо. Благо эти проблемы решаемы.

Первая проблема с «тормозами» решается через параметр fYield все той же структуры CAPTUREPARMS. Если этот параметр включен (TRUE), то объект создает окно захвата в отдельном фоновом потоке. И тогда все наши элементы управления на форме становятся доступны для использования. Правда MSDN нас честно предупреждает: «Applications that set this flag must handle potential reentry issues because the controls in the application are not disabled while capture is in progress.». Могут быть проблемы, так что на ваш страх и риск...

А для решения второй проблемы... есть сообщения WM_CAP_GET_VIDEOFORMAT и соответственно WM_CAP_SET_VIDEOFORMAT. В этом случаи нам нужно будет использовать целую «матрешку» структур и начинается она со структуры BITMAPINFO. Далее переходим на структуру BITMAPINFOHEADER, а уже в ней находятся интересующие нас параметры biWidth и biHeight – ширина и высота растрового изображения в пикселях, которые мы можем указать и которые поддерживаются аппаратно вашей WEB камерой.

Иными словами, для того чтобы установить и записать видео с максимальным разрешением, которое только поддерживает ваша камера (в моем случае Full HD 1920x1080 (1080p)) нужно проделать следующие действия...
Сначала описать структуры и константы...

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

Private Type RGBQUAD
    rgbBlue As Long
    rgbGreen As Long
    rgbRed As Long
    rgbReserved As Long
End Type

Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long   'Ширина растрового изображения в пикселях
    biHeight As Long  'Высота растрового изображения в пикселях
    biPlanes As Long
    biBitCount As Long
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

Private Const WM_USER = 1024
Private Const WM_CAP_START = WM_USER
Private Const WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44
Private Const WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45

Затем в процедуре...

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

Dim capParmsBMI As BITMAPINFO
SendMessage mCapHwnd, WM_CAP_GET_VIDEOFORMAT, Len(capParmsBMI), capParmsBMI
With capParmsBMI 'Full HD 1080p
    .bmiHeader.biWidth = 1920
    .bmiHeader.biHeight = 1080
End With

ReturnErr = SendMessage(mCapHwnd, WM_CAP_SET_VIDEOFORMAT, Len(capParmsBMI), capParmsBMI)
If ReturnErr Then
   MsgBox "Разрешение успешно установлено!", vbInformation, App.Title
Else
   MsgBox "Видеоустройство не поддерживает выбранное разрешение!", vbCritical, App.Title
End If


Вот и все! Свою задачу я решил. Моя программа получилась такой...
Ну, а всем удачи и успехов в творчестве!

P.S. Совет... если изображение предпросмотра после запуска программы вдруг начнет мигать... нажмите «Установить формат» и измените «Глубину цвета и сжатие». Должно заработать.

[kibernetics]

Может, кому будет нужно, хотя... судя по тому, как мне тут отвечают, я так понял, эта тема вообще никому не нужна и не интересна.

Не волнуйся, все тебя внимательно слушают. Просто шифруются лёжа на печке
Пиши, не стесняйся!

(Шёпотом) Выложи сорс

[Vova_2581]

"сорс" ...???... А что это за слово такое? Я не могу его перевести.

[kibernetics]

"сорс" ...???... А что это за слово такое? Я не могу его перевести.

Source code

[Vova_2581]

А... Вам нужен мой исходный код. Хорошо... Сейчас не могу, на работе... чуть позже выложу.
P.S. Я просто думал никому не надо, вот и выложил просто exe-шник, как результат... а так... все основные моменты описал в теории. Ну, если этого недостаточно, ок... выложу весь код.

[Vova_2581]

Вот мой исходник... Извините за задержку, обстоятельства...

[pronto]

Немного изменил способ установки времени автоматического завершения записи. Предыдущий способ был менее удобный и менее точный.

[kibernetics]

Вот мой исходник... Извините за задержку, обстоятельства...

А ты молодец, слово держишь.

[Teranas]

Вот мой исходник... Извините за задержку, обстоятельства...

Да, тем более вещь полезная, УВАЖУХА!

[Vova_2581]

Немного изменил способ установки времени автоматического завершения записи. Предыдущий способ был менее удобный и менее точный.

Да, любопытно... Ну можно и так даже лучше.

А ты молодец, слово держишь.

Да, тем более вещь полезная, УВАЖУХА!

Спасибо! Ну, знаете как говорят: мужик сказал - мужик сделал! Дал слово, значит сдержал, если мужик. Спасибо, еще раз! Всем удачи!

[pronto]

Пользуйтесь Option Explicit!
И внесите поправку в строку Txt_Second.Text = Format$(Hour(st), "00") + ":" + _. Должно быть Txt_Second.Text = Format$(Hour(dt), "00") + ":" + _

[qwertyhp]

Спасибо большое! Без сомнения, тоже пригодится! Буду ждать дальнейшего развития Ваших проектов!

[giaber]

Спасибо большое! Мне очень нужная тема и своевременная! Ещё раз спасибо!

UPD
Записывает прекрасно, но окно превью всё время чёрное - в чём может быть проблема?

[Vova_2581]

То есть окно превью черное, но запись идет... как это у Вас так хитро получается?? У меня такое (черный экран) бывало только, когда я запускал программу БЕЗ(!) подключенной вебкамеры. Поробуйте передернуть разьем подключения камеры или покрутить настройками... изменить разрешение, например, или цветовой формат.

[Vova_2581]

Записывает прекрасно, но окно превью всё время чёрное - в чём может быть проблема?

Здравствуйте, уважаемые господа!
Хотел бы рассказать Вам одну маленькую историю, касательно данной темы в дополнение ко всему уже сказанному. Так сказать – раскрыть некий небольшой секрет. ?))
Начну с предыстории...

Не так давно ко мне обратилась одна моя знакомая. Зовут Света. Так вот, Света попросила меня посмотреть ее ноутбук. Что-то там с ним случилось, толком объяснить не могла, в компьютерах не разбирается. Сказала только, что ее сын что-то там делал и теперь ничего не работает. Сын тоже не признавался в том, что конкретно он там нахерячил? Я не стал лезть в душу, может на «интересных» сайтах сидел... не знаю, ну это не важно. В общем, пришел к ней домой, глянул на это четырех-ядерное чудо компании DELL. Пробовал запустить... загрузка системы обрывалась с криками о фатальных ошибках и т.д. Ничего не помогало. Восстановления точек... откаты... оригинальный CD с файлами системы – до фени, ничего вообще! Я ей говорю: «тут нужно переустанавливать систему, программы и все остальное...». Она посмотрела на меня таким жалобным и тоскливым взглядом, что аж сердце в груди защемило. Я чуть слезу не пустил. Ну, женщины это умеют, блин... лучше всех! Ладно, думаю, сделаю...
И вот, когда я все переустановил и наладил... кстати, Света попросила поставить 7-ку, вот тут возник один вопрос: мне нужно было проверить, работает ли фронтальная WEB-камера на ноуте? Блин... как это сделать на 7-ке голыми руками (в смысле средствами самой системы)? Понятия не имел. Я не работаю на 7-ке, мне как-то привычней XP. В XP это можно сделать просто из Проводника и все, а 7-ка - хрен знает. Крутил, мутил... не нашел нигде. Короче, взял я свою программу... ту, что здесь выкладывал, чтобы долго не искать другие. Да и зачем? Запустил... класс!! Камера работает, все ок! Я продолжил доставлять ПО. Когда все было готово, решил еще раз проверить камеру на последок, так сказать, и... опа-ча! черный экран Малевича. Я сразу же вспомнил уважаемого giaber и его вопрос на форуме, который мне в начале был непонятен.
Так-так, начал я анализировать, что же вдруг пошло не так? Почему все работало и вдруг перестало??? Что же я делал последним? Выяснил, что последним из ПО я ставил кодеки на видео. Небезызвестный пакет K-Lite Codec Pack 1290 Mega. Попробовал деинсталлировать пакет полностью и повторно проверить камеру. После деинсталляции, моя программа снова заработала, как надо. Все без проблем! Ахренеть! Я не знаю в чем конкретно прикол этих кодеков, вроде и без них нельзя, но какие-то модули или DLL-ки там просто «отключают» WEB-камеру, словно ее и нет!!! Хотя система обнаруживает камеру как Integrated Webcam и на этом Out... Дальше ничего... Вот почему capCreateCaptureWindow не может создать объект, и, соответственно, создается такой эффект, словно камера не подключена, как результат – черный экран.
Ну и как же быть в таком случаи? Я очень долго чесал свою лысину, гладил бороду, рвал волосы на поп... короче, не важно. Надувал щеки, бился в истерике, и даже бегал вокруг ноута с бубном и варганом в зубах – что только не делал, ничего не помогало, пока через пару часов нечеловеческих страданий снизошла на меня благодать Всевышнего и не открылась мне истина бытия! Темные тучи надо мною по мановению разошлись по сторонам, и ослепительно белый луч Божьего света пал на путь истинный. Какая-то неведомая мне сила двигала мою руку и направляла помыслы мои в нужное русло! Все, что я успел сделать – включить Screen Camer’у и записать на видео все происходящее на экране. То есть, мне была открыта истина, как включать и отключать эту самую WEB-камеру на ноуте. Потом я погрузился в нирвану и больше ничего не помню. Очнулся под столом, за окном уже утро, а на рабочем столе ноута отснятый AVI-шник от экранной камеры. Что это было? Я не знаю. Но на душе было так спокойно и легко от того, что все получилось! Я шел по улицам вприпрыжку, улыбаясь удивленным прохожим. Отдал ноут Светлане, и получил свои заслуженные чмоки-чмоки за обе щеки. Вот такие приключения, господа!
Именно это видео я решил сегодня прикрепить к моему посту здесь...
Так что, пожалуйста, смотрите...
Как включить камеру

[kibernetics]

История интересная. Спасибо. Жаль не видно самой Светы, а только люминесцентные лампы вместо нее.

[Vova_2581]

Спасибо. Жаль не видно самой Светы, а только люминесцентные лампы вместо нее.

Ну, если серьезно, то я это все на работе делал, потому и лампы... вместо Светы.