Вторник, 27.06.2017, 18:42 Приветствую вас Гость | Группа "Гости" 


[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
Страница 1 из 11
Модератор форума: Anton93, Волк-1024, xXxSh@dowxXx 
delfcode » Delphi » Программы на Delphi » Детектор движения из вэб камеры
Детектор движения из вэб камеры
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.

кликаем на кнопку, и видем себя smile
но с помощью этого способа проблематично почучить битмап из карда, потомучто если просто копировать то что нарисовано на форме то для получения битмапа будет необходимо чтобы программа всегда была развернутой(на экране было видно картинку с вэб камеры)
поэтому я привожу два способа

второй способ:

это способ с использованием нестаного набора компонентов называемого как 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.

в итоге у нас получится програмка трещащая на движения как счетчик гейгера

Прикрепления: Move_Detector.rar(190Kb)


 
gravitasДата: Воскресенье, 09.01.2011, 00:18 | Сообщение # 2
Авторитетный
Зарегистрирован: 01.05.2010
Группа: Пользователи
Сообщений: 385
Статус: Offline
А вот вам простой код получения и сохранения скрина чтобы лишний раз не заниматься сексом со своим мозгом biggrin
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)
который можно юзать в троях и т.д.

хм в троях сохрянять изображение с вебкамеры , это что-то новое biggrin


 
XSPYДата: Среда, 12.01.2011, 16:46 | Сообщение # 6
Продвинутый
Зарегистрирован: 28.01.2010
Группа: Пользователи
Сообщений: 258
Статус: Offline
не новое)

Я не крекер,а программист!
Я не преступник-я свободный человек!
Лучше один раз накодить,чем сто раз качать билды!
 
gravitasДата: Среда, 12.01.2011, 19:21 | Сообщение # 7
Авторитетный
Зарегистрирован: 01.05.2010
Группа: Пользователи
Сообщений: 385
Статус: Offline
Я всегда сначала сохраняю во временную папку => передаю => удаляю.
З.Ы. код взят из отцовского бэка...


TheDeduction

Для ускорения получения ответов на ваши вопросы рекомендуется подкармливание в виде +'ов в рейтинг :)
 
dolphinДата: Среда, 12.01.2011, 22:55 | Сообщение # 8
Администратор
Сообщений: 902
Статус: 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
 
delfcode » Delphi » Программы на Delphi » Детектор движения из вэб камеры
Страница 1 из 11
Поиск:

delfcode.ru © 2008 - 2017 Хостинг от uCoz