Последние записи
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
- Взаимодействие через командную строку
- Перенести программу из Delphi в Lazarus
- Определить текущую ОС
- Автоматическая смена языка (раскладки клавиатуры)
- Сравнение языков на массивах. Часть 2
- wprintf как напечатать кириллицу
- Взаимодействие через командную строку
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
17th
Май
Получение картинки с веб-камеры
Posted by Chas under Delphi
Снимаю картинку с веб-камеры через SendMessage(hWndC, WM_CAP_GRAB_FRAME, 0, 0). Всё получается, если только указать Handle при инициализации на форму или элемент управления формой (кнопка, панель), а надо поместить картинку на Image.
raxp
В обработчике сообщений главного окна после создания назначаем обработчик FrameCallBack:
var
DC : HDC;
Bt : BITMAPINFO;
h_wnd : HWND;
h_cam : HWND;
buf : array [0..640 * 480 * 3] of Byte; // изображение-эталон
...
// создание главного окна приложения
with wnd do
begin
cbSize := SizeOf(wnd);
lpfnWndProc := @WndProc;
...
// создание невидимого окна захвата
h_cam := capCreateCaptureWindowA(nil, WS_CHILD or WS_VISIBLE, 0, 0, 0, 0, h_wnd, 0);
// получаем идентификаторы графического контекста главного окна
DC := GetDC(h_wnd);
// настройка драйвера
if SendMessage(h_cam, WM_CAP_DRIVER_CONNECT, 0, 0) <> 0 then
begin
SendMessage(h_cam, WM_CAP_GET_VIDEOFORMAT, SizeOf(Bt), LongInt(@Bt));
Bt.bmiHeader.biWidth := 320;
Bt.bmiHeader.biHeight := 240;
Bt.bmiHeader.biSize := SizeOf(Bt.bmiHeader);
Bt.bmiHeader.biPlanes := 1;
Bt.bmiHeader.biBitCount := 24;
SendMessage(h_cam, WM_CAP_SET_VIDEOFORMAT, SizeOf(Bt), LongInt(@Bt));
SendMessage(h_cam, WM_CAP_SET_CALLBACK_FRAME, 0, Integer(@FrameCallback));
end
...
function WndProc(hwnd: DWORD; message: UINT; wParam: Longint; lParam: LongInt): LongInt; stdcall;
begin
case message of
...
// получаем кадр по таймеру
WM_TIMER : SendMessage(h_cam, WM_CAP_GRAB_FRAME, 0, 0);
end;
Result := DefWindowProc(hwnd, message, wParam, lParam);
end;
И сам кадр уже в каллбэке:
function FrameCallback(hWnd: HWND; lpVHdr: PVIDEOHDR): DWORD; stdcall;
type
TByteArray = array [0..1] of Byte;
PByteArray = ^TByteArray;
var
i, j : Integer;
sum : Single;
status : TCapStatus;
str : string;
begin
Result := 0;
// информация о изображении
SendMessage(hwnd, WM_CAP_GET_STATUS, SizeOf(status), Integer(@status));
// получаем эталон
if first then
begin
Move(lpVHdr^.lpData^, buf, lpVhdr^.dwBytesUsed);
first := False;
end;
// вычисление объектов
for i := 0 to status.uiImageWidth * status.uiImageHeight - 1 do
begin
sum := 0;
for j := 0 to 2 do
sum := sum + abs(buf - PbyteArray(lpVHdr^.lpData));
sum := sum / 3;
if sum > SENS then
begin
PbyteArray(lpVHdr^.lpData) := (buf + PbyteArray(lpVHdr^.lpData)) div 4;
PbyteArray(lpVHdr^.lpData) := (buf + PbyteArray(lpVHdr^.lpData)) div 4;
PbyteArray(lpVHdr^.lpData) := min(buf + PbyteArray(lpVHdr^.lpData), 255);
end else
for j := 0 to 2 do
PbyteArray(lpVHdr^.lpData) := buf;
end;
// вывод результата в окно
bt.bmiHeader.biWidth := status.uiImageWidth;
bt.bmiHeader.biHeight := status.uiImageHeight;
StretchDIBits(DC, 0, 0, 640, 480, 0, 0, status.uiImageWidth, status.uiImageHeight, lpVHdr.lpData, bt, 0, SRCCOPY);
end;
Похожие статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)