|
Детектор движения из вэб камеры
|
|
C@T
|
Дата: Суббота, 25.12.2010, 02:19 | Сообщение # 1
|
Авторитетный
Зарегистрирован: 06.03.2010
Группа: Модераторы
Сообщений: 265
Статус: Offline
|
Детектор движения из вэб камеры
Я знаю что данная тема не один рас поднималась, и на эту тему есть много статей но всеже я решил написать мини статью, так как на данном форуме эта тема еще не появлялась
начнем с вывода изображения с вэб камеры на экран
первый способ:
кидаем на форму панельку(TPanel),кнопку,и таймер
и пишем такой код:
Code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls,ShellAPI;
type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const WM_CAP_START = WM_USER;
WM_CAP_STOP = WM_CAP_START + 68;
WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
WM_CAP_SAVEDIB = WM_CAP_START + 25;
WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
WM_CAP_SEQUENCE = WM_CAP_START + 62;
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
function capCreateCaptureWindowA(lpszWindowName : PCHAR;
dwStyle : longint;
x : integer;
y : integer;
nWidth : integer;
nHeight : integer;
ParentWin : HWND;
nId : integer): HWND;
stdcall external 'AVICAP32.DLL';
var
Form1: TForm1;
hWnd:THandle;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
hWnd := capCreateCaptureWindowA('Capture Window',
WS_CHILD or WS_VISIBLE ,
0,
0,
Panel1.Width,
Panel1.Height,
Panel1.Handle,
0); //создаем область для вывода получаемых в будущем картинок =)
if hWnd <> 0 then //если при создании области ошибок не возникло, то сопкойно начинаем забирать данный с веб-камеры
SendMessage(hWnd, WM_CAP_DRIVER_CONNECT, 0, 0); //забираем картинку с вебкамеры
Timer1.Enabled:=True;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if hWnd <> 0 then
SendMessage(hWnd, WM_CAP_GRAB_FRAME, 0, 0);
end;
end.
кликаем на кнопку, и видем себя 
но с помощью этого способа проблематично почучить битмап из карда, потомучто если просто копировать то что нарисовано на форме то для получения битмапа будет необходимо чтобы программа всегда была развернутой(на экране было видно картинку с вэб камеры)
поэтому я привожу два способа
второй способ:
это способ с использованием нестаного набора компонентов называемого как DSpack(скачать можно тут http://code.google.com/p/dspack/downloads/list )
Code
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DSPack,DSUtil,DirectShow9, StdCtrls, ExtCtrls;
type
PPixelArray = ^TpixelArray;//указатель на масив байтов
TPixelArray = array [0..0] of byte;//масив байтов
type
TForm1 = class(TForm)
FilterGraph1: TFilterGraph;
VideoWindow1: TVideoWindow;
Filter1: TFilter;
SampleGrabber1: TSampleGrabber;
ComboBox1: TComboBox;
Timer1: TTimer;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
VideoDevice:TSysDevEnum;
OldPixelsBuf:PPixelArray;
SelectedX:integer;
SelectedY:integer;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
VideoDevice := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);//получаем список устров с которых можно принять видео поток(получаем список веб камер)
if VideoDevice.CountFilters > 0 then//если есть хоть один девайс
for i:=0 to VideoDevice.CountFilters - 1 do// то добавляем девайсы в список для выбора
ComboBox1.Items.Add(VideoDevice.Filters[i].FriendlyName);
FilterGraph1.ClearGraph;//настраеваем фильтр
FilterGraph1.Active := false;
Filter1.BaseFilter.Moniker:=VideoDevice.GetMoniker(0);//выводим изображение с первого девайса
FilterGraph1.Active := true;
//задайом что откуда нужно получать и что куда должно выводится
with FilterGraph1 as ICaptureGraphBuilder2 do
RenderStream(@PIN_CATEGORY_PREVIEW,nil,
Filter1 as IBaseFilter,
SampleGrabber1 as IBaseFilter,
VideoWindow1 as IbaseFilter);
//выводим изображение
FilterGraph1.Play;
//VideoWindow1.Visible := false;
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
FilterGraph1.ClearGraph;
FilterGraph1.Active := false;
Filter1.BaseFilter.Moniker:=VideoDevice.GetMoniker(ComboBox1.ItemIndex);//меняем девайс на выбранный
FilterGraph1.Active := true;
//Ica
with FilterGraph1 as ICaptureGraphBuilder2 do
RenderStream(@PIN_CATEGORY_PREVIEW,nil,
Filter1 as IBaseFilter,
SampleGrabber1 as IBaseFilter,
VideoWindow1 as IbaseFilter);
FilterGraph1.Play;
OldPixelsBuf := nil;
end;
Function GetPixelsArrayFromBitmap(h:HBITMAP;Width,Height:integer):PPixelArray;//функция получения масива пикселей из битмапа
var
n:integer;
TempByte:Byte;
i:integer;
BMInfo:TBitmapInfo;
Buf: PPixelArray;
MemDC:hdc;
begin
FillChar(BMInfo,SizeOf(BMInfo),0);
BMInfo.bmiHeader.biSize:=SizeOf(TBitmapInfoHeader);
BMInfo.bmiHeader.biBitCount := 24;
BMInfo.bmiHeader.biWidth := Width;
BMInfo.bmiHeader.biHeight := Height;
n := BMInfo.bmiHeader.biWidth * BMInfo.bmiHeader.biHeight;
BMInfo.bmiHeader.biPlanes := 1;
BMInfo.bmiHeader.biCompression := BI_RGB;
MemDC := CreateCompatibleDC(0);
GetMem(Buf,n*3);
GetDIBits(MemDC,h,0,BMInfo.bmiHeader.biHeight,Buf,BMInfo,DIB_RGB_COLORS);
for i:=0 to n do begin
TempByte := Buf[i*3];
Buf[i*3] := Buf[i*3 + 2];
Buf[i*3 + 2] := TempByte;
end;
Result := Buf;
end;
procedure TForm1.Timer1Timer(Sender: TObject);//процедура таймера
var
b:tbitmap;
n:integer;//кол-во пикселей
PixelsAreChanged:integer;//количество измененных пикселей
i:integer;
PixelsBuf: PPixelArray;//масив пикселей
r1,g1,b1:byte;//RGB текущего кадра
r2,g2,b2:byte;//RGB перведущего кадра
begin
b:=TBitmap.Create;//создайом битмап
SampleGrabber1.GetBitmap(b);//получаем битмап из битмап из текущего кадра
PixelsBuf:=GetPixelsArrayFromBitmap(b.Handle,b.Width,b.Height);//получаем масив пикселей этого битмапа(можно конечноже использовать и b.Canvas.Pixels[x,y] но это негативно скажется на быстродействии программы)
n:=b.Width*b.Height;//считаем кол-во пикселов
PixelsAreChanged := 0;
if OldPixelsBuf <> nil then//если преведущий кадр существует то
for i := 0 to n do//начинаем сравнивать текущий кадр с преведущим
begin
r1:=PixelsBuf[i*3];
g1:=PixelsBuf[i*3 + 1];
b1:=PixelsBuf[i*3 + 2];
r2:=OldPixelsBuf[i*3];
g2:=OldPixelsBuf[i*3 + 1];
b2:=OldPixelsBuf[i*3 + 2];
if (r1-r2)>20 then Inc(PixelsAreChanged);//если произошли изменеия то увеличеваем счетчик изменений
if (g1-g2)>20 then Inc(PixelsAreChanged);
if (b1-b2)>20 then Inc(PixelsAreChanged);
end;
FreeMem(OldPixelsBuf);//освобождаем память старого масива пикселей
OldPixelsBuf:=PixelsBuf;//текущий масив пикселей(пиксели текущего кадра) становится старым масивом
if PixelsAreChanged > 2000 then//проверяем сколько произошло изменений
MessageBeep(MB_OK);//если изменений произошло больше нормы то подайом звуковой сигнал
b.Free;//освобождаем битмап
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled := true;//старт
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Timer1.Enabled:=false;//стоп
end;
end.
в итоге у нас получится програмка трещащая на движения как счетчик гейгера
|
| |
|
|
|
|
|
gravitas
|
Дата: Воскресенье, 09.01.2011, 00:18 | Сообщение # 2
|
Авторитетный
Зарегистрирован: 01.05.2010
Группа: Пользователи
Сообщений: 385
Статус: Offline
|
А вот вам простой код получения и сохранения скрина чтобы лишний раз не заниматься сексом со своим мозгом 
Code
var CaptureWindow:thandle;
begin
CaptureWindow := capCreateCaptureWindowA('CaptureWindow', WS_CHILD or WS_VISIBLE, 0, 0, 0, 0, GetDesktopWindow, 0);
if CaptureWindow <> 0 then
begin
SendMessage(CaptureWindow, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(CaptureWindow, WM_CAP_GRAB_FRAME, 0, 0);
SendMessage(CaptureWindow, WM_CAP_SAVEDIB, 0, longint(pchar('выходной файл.bmp')));
SendMessage(CaptureWindow, WM_CAP_DRIVER_DISCONNECT, 0, 0);
CaptureWindow := 0;
TheDeduction
Для ускорения получения ответов на ваши вопросы рекомендуется подкармливание в виде +'ов в рейтинг :)
|
| |
|
|
|
|
|
C@T
|
Дата: Воскресенье, 09.01.2011, 12:59 | Сообщение # 3
|
|
Авторитетный
Зарегистрирован: 06.03.2010
Группа: Модераторы
Сообщений: 265
Статус: Offline
|
задача этой проги не получения скрина как файла а сохранение его в память для последующей обработки, а если загружать каждый новый кадр из файла то можно очень сильно уменьшить скорость обработки кадров(FPS), данная программа показывает в среднем 50 FPS
|
| |
|
|
|
|
|
gravitas
|
Дата: Воскресенье, 09.01.2011, 14:36 | Сообщение # 4
|
|
Авторитетный
Зарегистрирован: 01.05.2010
Группа: Пользователи
Сообщений: 385
Статус: Offline
|
Quote (C@T)
задача этой проги не получения скрина как файла а сохранение его в память для последующей обработки, а если загружать каждый новый кадр из файла то можно очень сильно уменьшить скорость обработки кадров(FPS), данная программа показывает в среднем 50 FPS
Я всего лишь показал готовый пример, который можно юзать в троях и т.д.
TheDeduction
Для ускорения получения ответов на ваши вопросы рекомендуется подкармливание в виде +'ов в рейтинг :)
|
| |
|
|
|
|
|
C@T
|
Дата: Вторник, 11.01.2011, 20:59 | Сообщение # 5
|
|
Авторитетный
Зарегистрирован: 06.03.2010
Группа: Модераторы
Сообщений: 265
Статус: Offline
|
Quote (gravitas)
который можно юзать в троях и т.д.
хм в троях сохрянять изображение с вебкамеры , это что-то новое
|
| |
|
|
|
|
|
XSPY
|
Дата: Среда, 12.01.2011, 16:46 | Сообщение # 6
|
Продвинутый
Зарегистрирован: 28.01.2010
Группа: Пользователи
Сообщений: 263
Статус: Offline
|
не новое)
Я не крекер,а программист!
Я не преступник-я свободный человек!
Лучше один раз накодить,чем сто раз качать билды!
|
| |
|
|
|
|
|
gravitas
|
Дата: Среда, 12.01.2011, 19:21 | Сообщение # 7
|
|
Авторитетный
Зарегистрирован: 01.05.2010
Группа: Пользователи
Сообщений: 385
Статус: Offline
|
Я всегда сначала сохраняю во временную папку => передаю => удаляю.
З.Ы. код взят из отцовского бэка...
TheDeduction
Для ускорения получения ответов на ваши вопросы рекомендуется подкармливание в виде +'ов в рейтинг :)
|
| |
|
|
|
|
|
dolphin
|
Дата: Среда, 12.01.2011, 22:55 | Сообщение # 8
|
Администратор
Сообщений: 904
Статус: Offline
|
В зеусе если я не ошибаюсь используют
Система: Windows 10 x64, Windows XP
Среды программирования: Delphi 7, Delphi 10 Seattle
Я не профессионал, я всего лишь любитель
Я не вредитель, я всего лишь теоретик
|
| |
|
|
|
|
|
REMiX
|
Дата: Воскресенье, 16.01.2011, 21:22 | Сообщение # 9
|
Был не раз
Зарегистрирован: 11.01.2010
Группа: Пользователи
Сообщений: 22
Статус: Offline
|
хм...полезная вещица...))хДа звук как-нибудь можно перегонять?
Начинающий программист, DELPHI user, а так же могу помочь с фотошопом.
|
| |
|
|
|
|
|
gravitas
|
Дата: Воскресенье, 16.01.2011, 22:48 | Сообщение # 10
|
|
Авторитетный
Зарегистрирован: 01.05.2010
Группа: Пользователи
Сообщений: 385
Статус: Offline
|
Quote (REMiX)
хм...полезная вещица...))хДа звук как-нибудь можно перегонять?
"Звук с веб камеры" ?)) Звук забирается с микрофона. Сей код есть в google .
TheDeduction
Для ускорения получения ответов на ваши вопросы рекомендуется подкармливание в виде +'ов в рейтинг :)
|
| |
|
|
|
|
|
C@T
|
Дата: Понедельник, 17.01.2011, 20:30 | Сообщение # 11
|
|
Авторитетный
Зарегистрирован: 06.03.2010
Группа: Модераторы
Сообщений: 265
Статус: Offline
|
в DSpack-е можно и звук записывать, там есть стандартная демка которая записует и видео и аудио поток
|
| |
|
|
|
|
|
REMiX
|
Дата: Вторник, 18.01.2011, 23:44 | Сообщение # 12
|
|
Был не раз
Зарегистрирован: 11.01.2010
Группа: Пользователи
Сообщений: 22
Статус: Offline
|
gravitas, в гугле есть все, здесь же как бы форум, и обсуждаются определенные темы, я конечно немного не в тему написал, но всё же думаю этим можно заняться. Сейчас с 3G, многие используют ноуты, а на ноутах обычно стоит и микрофон и вебка. Так, что актуально.
Начинающий программист, DELPHI user, а так же могу помочь с фотошопом.
|
| |
|
|
|
|
|
xXxSh@dowxXx
|
Дата: Четверг, 16.02.2012, 21:21 | Сообщение # 13
|
Авторитетный
Зарегистрирован: 22.01.2012
Группа: Модераторы
Сообщений: 702
Статус: Offline
|
где то я уже видел этот пример кода приведенный в первом посте,я бы сказал что он уж слишком банален
и уж тем более не актуален вовсе,так как скорость обработки изменения кадров просто убивает,
да и подобный метод просто невозможно использовать для нормальной работы...
более менее нормальный вариант который можно рассматривать для написания программ такого рода,
это использование компонентов вот с этого сайта: http://www.mitov.com/html/visionlab.html
их компоненты очень даже неплохи,и используются для написания хороших качественных программ записи,обработки,
детектирования,обнаружения и многого другого....
а на счет ноутбуков и троянов использующих оборудования типа камер,то в ноутах сейчас стали специально делать индикаторы работы оборудования,и как только камера задействуется то загорается индикатор показывающий пользователю что его камера работает и снимает в данный момент,я думаю более менее внимательный пользователь полюбому что нибудь заподозрит
Сообщение отредактировал xXxSh@dowxXx - Четверг, 16.02.2012, 21:30
|
| |
|
|
|
