Детектор движения или Delphi + DsPack

Дата публикации: 12-05-2011 | Автор: MelfisFettel | Рубрика: Delphi

DelphiРанее я частенько задавался вопросом как проконтролировать кто подходил к компьютеру, или бродил по кабинету пока меня не было. Ответ нашелся. Этот ответ DsPack + Delphi. Сегодня я покажу как заставить Web камеру следить за помещением, регистрировать движение и записывать все это в виде bmp файлов. Для начала немного о самом пакете DsPack. DSPack представляет собой набор компонентов и классов для создания приложений работающих с мультимедиа использующих MS Direct Show и DirectX технологии. DSPack предназначен для работы с DirectX 9 на Win9x, ME, 2000 и Windows XP операционных системах.

Этот пакет можно скачать с официального сайта http://www.progdigy.com/ или прямо отсюда. По второй ссылке приведен пакет который уже содержит версии для Delphi 5, 6, 7, 2005, 2007 и без проблем ставится на Delphi 2007 которую я и буду использовать.

Установка DsPack

В установке нет ничего сложного. Она описана в файле ReadMe. Но на всякий случай:
0) Распаковываем DsPack архив
1) Запускаем Delphi
2) Открываем настройки Tools -> Options
3) Список каталогов библиотек Delphi Options -> Library — Win32
4) В правой части окна жмем Library Path и добавляем пути к распакованным файлам:
\..\DsPack\src\DirectX9
и
\..\DsPack\src\DSPack

Теперь осталось установить DsPack. Поочередно открываем проекты и компилируем их:
DSPack_D2006.dproj
затем
DirectX9_D2006.dproj
Теперь открываем DSPackDesign_D2006.dproj и жмем Install.
Вот и все. DsPack установлен.

Создание формы

Создаем новый проект Delphi. Кинем на форму TFilterGraph. В свойствах компонента параметр Mode нужно установить в gmCapture.
Так же добавим TVideoWindow из той же закладки DsPack, он будет использоваться для отображения картинки с нашей web камеры. В свойстве FilterGraph установим FilterGraph1.
Далее добавим TFilter, это компонент который будет управлять фильтром. Именно для него источником данных будет web камера. В свойстве FilterGraph выбираем FilterGraph1
Остался только TSampleGrabber. Добавляем его и в свойстве FitlerGraph выбираем FitlerGraph1. Форма готова.

Пишем программу

Для начала подключим в Uses DSUtil и DirectShow9 и объявим переменную которая будет отвечать за получение списка устройств в нашей системе.

1
2
3
4
public
{ Public declarations }
CamItem: TSysDevEnum;
end;
public
{ Public declarations }
CamItem: TSysDevEnum;
end;

Теперь получим список установленных в системе устройств, Сделаем это при создании формы FormCreate(Sender: TObject);

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  CamItem:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
 
  if CamItem.CountFilters > 0 then
  begin
    FilterGraph1.ClearGraph;
    FilterGraph1.Active:=false;
    //Задаем устройство с короторого будем получать изображение
    //0 это индекс устройства общее количесвтво можно узнать при помощи CamItem.CountFilters
    Filter1.BaseFilter.Moniker:=CamItem.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;
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  CamItem:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);

  if CamItem.CountFilters > 0 then
  begin
    FilterGraph1.ClearGraph;
    FilterGraph1.Active:=false;
    //Задаем устройство с короторого будем получать изображение
    //0 это индекс устройства общее количесвтво можно узнать при помощи CamItem.CountFilters
    Filter1.BaseFilter.Moniker:=CamItem.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;
  end;
end;

Теперь можно попробовать запустить программу. После запуска, программа будет использовать первую же найденную камеру и начнет трансляцию в компоненте VideoWindow1.

Детекция движения

Суть детекции будет сводится к получению с камеры двух снимков в разное время, и последующие их сравнение на предмет изменения.
Для реализации этой функции нам понадобится компонент TTimer, а так же добавим на форму компонент Memo для ведения лога, и два компонента Image. Для таймера установим параметр Interval равный 2000 (2 секунды.). При его срабатывании будет получаться изображение с камеры и сравниваться с контрольным изображением. В событии OnTimer1 напишем следующий код:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
procedure TForm1.Timer1Timer(Sender: TObject);
var
//i-координата пикселя по горизонтали
i:integer;
 
//j-координата пикселя по вертикали
j:integer;
 
//Переменные количества различий
k:integer;
r1,g1,b1:Byte;
r2,g2,b2:Byte;
FirstColor,SecondColor:Integer;
Color:TColor;
ChangeDetect:byte;
begin
 
//Делаем первый снимок
if Timer1.Tag=0 then
begin
  SampleGrabber1.GetBitmap(Image1.Picture.Bitmap);
  Timer1.Tag:=1;
  exit;
end;
 
//Через некоторое время - второй, с которым будем сверять
SampleGrabber1.GetBitmap(Image2.Picture.Bitmap);
Timer1.Tag:=0;
k:=0;
 
//Начинаем попиксельное сравнение
for i := 1 to Image1.Picture.Bitmap.Height do
begin
  for j := 1 to Image1.Picture.Bitmap.Width do
    begin
      ChangeDetect:=0;
 
      //Получаем цвет текущего пикселя первой картинки
      FirstColor:=Image1.Picture.Bitmap.Canvas.Pixels[i,j];
 
      //Получаем составляющие RGB
 
      r1:=GetRValue(FirstColor);
      g1:=GetGValue(FirstColor);
      b1:=GetBValue(FirstColor);
 
      SecondColor:=Image2.Picture.Bitmap.Canvas.Pixels[i,j];
 
      r2:=GetRValue(SecondColor);
      g2:=GetGValue(SecondColor);
      b2:=GetBValue(SecondColor);
 
      //Начинаем проверку различий между двумя картинками
 
      if Abs(r1-r2)>20 then inc(ChangeDetect);
        if Abs(g1-g2)>20 then inc(ChangeDetect);
          if Abs(b1-b2)>20 then inc(ChangeDetect);
            //Если изменения существенные, то увеличиваем счетчик
            if ChangeDetect=3 then k:=k+1;
              Application.ProcessMessages;
end;
end;
 
//Если изменений больше 1500 то сообщаем об этом
if k>1500 then
begin
  Memo1.Lines.Add(FormatDateTime('hh:nn:ss',Now)+' Обнаружено движение!');
  Image2.Picture.Bitmap.SaveToFile('alerts\'+FormatDateTime('hhnnss',Now)+'.bmp');
end;
 
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
//i-координата пикселя по горизонтали
i:integer;

//j-координата пикселя по вертикали
j:integer;

//Переменные количества различий
k:integer;
r1,g1,b1:Byte;
r2,g2,b2:Byte;
FirstColor,SecondColor:Integer;
Color:TColor;
ChangeDetect:byte;
begin

//Делаем первый снимок
if Timer1.Tag=0 then
begin
  SampleGrabber1.GetBitmap(Image1.Picture.Bitmap);
  Timer1.Tag:=1;
  exit;
end;

//Через некоторое время - второй, с которым будем сверять
SampleGrabber1.GetBitmap(Image2.Picture.Bitmap);
Timer1.Tag:=0;
k:=0;

//Начинаем попиксельное сравнение
for i := 1 to Image1.Picture.Bitmap.Height do
begin
  for j := 1 to Image1.Picture.Bitmap.Width do
    begin
      ChangeDetect:=0;

      //Получаем цвет текущего пикселя первой картинки
      FirstColor:=Image1.Picture.Bitmap.Canvas.Pixels[i,j];

      //Получаем составляющие RGB

      r1:=GetRValue(FirstColor);
      g1:=GetGValue(FirstColor);
      b1:=GetBValue(FirstColor);

      SecondColor:=Image2.Picture.Bitmap.Canvas.Pixels[i,j];

      r2:=GetRValue(SecondColor);
      g2:=GetGValue(SecondColor);
      b2:=GetBValue(SecondColor);

      //Начинаем проверку различий между двумя картинками

      if Abs(r1-r2)>20 then inc(ChangeDetect);
        if Abs(g1-g2)>20 then inc(ChangeDetect);
          if Abs(b1-b2)>20 then inc(ChangeDetect);
            //Если изменения существенные, то увеличиваем счетчик
            if ChangeDetect=3 then k:=k+1;
              Application.ProcessMessages;
end;
end;

//Если изменений больше 1500 то сообщаем об этом
if k>1500 then
begin
  Memo1.Lines.Add(FormatDateTime('hh:nn:ss',Now)+' Обнаружено движение!');
  Image2.Picture.Bitmap.SaveToFile('alerts\'+FormatDateTime('hhnnss',Now)+'.bmp');
end;

end;

И для большей гибкости создадим на форме один CheckBox. Он будет отвечать за включение таймера и начало отслеживания изменений. Напишем код для события OnClick для компонента CheckBox:

1
2
3
4
5
6
7
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked = true then
    Timer1.Enabled:=true
  else
    Timer1.Enabled:=false;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked = true then
    Timer1.Enabled:=true
  else
    Timer1.Enabled:=false;
end;

Вот что у меня получилось:

Внешний вид формы с компонентами DSPack

Вот и все. Приложение готово. В следующей статье я рассмотрю как получить изображение с web камеры и сохранить его на жестком диске в формате avi.

Тут можно скачать готовую программу с исходным кодом.

Понравилась статья? Расскажи друзьям:


Комментариев (6)

Странно… Всё по-порядку делал, но…
RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter1 as IBaseFilter, SampleGrabber1 as IBaseFilter, VideoWindow1 as IbaseFilter) — Вот из-за этой строчки вылетает ошибка ‘interface not supported’

1) Вероятнее всего Ваша веб камера является несовместимым устройством. (Определяется как два устройства или как составное.)
2) Попробуйте обновить драйвера для Вашей веб камеры.
Вся статья писалась с использованием камеры Logitech C200, а так же тестировалось на WebCam SC-0311139N (Интегрированная в ноутбук)

у videowindow в filtergraf ставь filtergraf1

ток начал разбираться,но пока видео не отображается,вот ищу в чем проблема

Кое как но я все таки поставил этот DsPack )))
А как просто одно изображение по кнопке получить? какой код на кнопку написать?

Поторопился че- то
Код тут есть сразу незаметил.

Добрый день.
Может кто подскажет?
При запуске на строчек «FilterGraph1.Active:=true;» вылетает ошибка: «External exception C0000008″. Не могу понять почему и как исправить.

Обсудить