Захват видео с WEB камеры и детектор движения

Захват видео с WEB камеры и детектор движения

Довольно часто возникает необходимость определения движения в видеопотоке (например, в охранных целях — это гораздо дешевле и надёжнее, чем ставить живого оператора). Сегодня я вам расскажу, как написать простенький детектор движения, используя только веб камеру.

Так как у нас, программистов, принято разбивать задачи на подзадачи, то у нас есть две подзадачи: первая — научиться захватывать видео с камеры (для простоты возьмём Web-камеру), а вторая, собственно — определять движение.

Скажу сразу, что писать я буду на Delphi. Кому не нравится — могут не читать.

Итак, без лишних слов, приступим.

Захват видео

Всё зависит от типа вашей камеры. Самые распространённые — это web-камеры. Сегодня они есть почти в каждом ноутбуке. Для захвата видео с веб-камеры существует множество инструментов. Наиболее часто используемый — библиотека AVICAP32.DLL, хотя есть и другие.

Создадим и добавим в проект модуль AviCap32Unit.pas, где опишем внешние функции и константы библиотеки AVICAP32.DLL. Нам понадобятся две функции: capGetDriverDescriptionA и capCreateCaptureWindowA. Для чего они нужны — расскажу позже. Ещё нам нужны 4 сообщения: WM_CAP_START, WM_CAP_DRIVER_CONNECT, WM_CAP_GRAB_FRAME и WM_CAP_STOP.

Код модуля AviCap32Unit:

  1. unit AviCap32Unit;
  2. interface
  3. uses windows,Messages;
  4. const
  5.   WM_CAP_START = WM_USER;
  6.   WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
  7.   WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
  8.   WM_CAP_STOP = WM_CAP_START + 68;
  9. function capCreateCaptureWindowA(
  10.   lpszWindowName : PAnsiCHAR;
  11.   dwStyle : longint;
  12.   x : integer;
  13.   y : integer;
  14.   nWidth : integer;
  15.   nHeight : integer;
  16.   ParentWin : HWND;
  17.   nId : integer): HWND; stdcall external 'AVICAP32.DLL';
  18. function capGetDriverDescriptionA(
  19.   wDriverIndex        : UINT;
  20.   lpszName            : LPSTR;
  21.   cbName              : Integer;
  22.   lpszVer             : LPSTR;
  23.   cbVer               : Integer): BOOL; stdcall; external 'AVICAP32.DLL';
  24. implementation
  25. end.

Ну, у нас есть две функции и четыре константы. «Что же с ними делать?» – спросите вы. Можно уже использовать готовые функции, а можно создать класс для работы с Web-камерой. Второй вариант предпочтительней, поскольку вы можете унаследовать ещё класс (например, для IP-камер), в котором механизм захвата устроен по-другому, а нам только надо получить кадр. Напишем модуль CamCaptureUnit. Я думаю, там всё понятно. Если что не понятно — пишите в комментарии.

Код модуля CamCaptureUnit:

  1. unit CamCaptureUnit;
  2. interface
  3. uses Windows,Graphics,AviCap32Unit;
  4. type TCamera=class
  5.       protected
  6.         FWidth    : integer;
  7.         FHeight   : integer;
  8.         FCamIndex : integer;
  9.         Fh        : THandle;
  10.         FName     : string;
  11.         FVer      : string;
  12.       public
  13.         Constructor Create;
  14.         Destructor Destroy; override;
  15.         function Start():boolean;
  16.         function CaptureBMP(bmp:TBitmap):boolean;
  17.         property CamIndex:integer read FCamIndex write FCamIndex;
  18.         property Name:string read FName write FName;
  19.         property Ver:string read FVer write FVer;
  20.       end;
  21.      TCamList=class
  22.       protected
  23.         FList : array of TCamera;
  24.         function FGetCount:integer;
  25.         function FGetItem(index:integer):TCamera;
  26.       public
  27.         procedure Emumerate();
  28.         property count:integer read FGetCount;
  29.         property List[index:integer]:TCamera read FGetItem; default;
  30.       end;
  31.  
  32. implementation
  33.  
  34. Constructor TCamera.Create;
  35. begin
  36.   inherited;
  37.   Fh:=0;
  38.   FWidth:=640;
  39.   FHeight:=480;
  40. end;
  41.  
  42. Destructor TCamera.Destroy;
  43. begin
  44.   if(Fh<>0)then CloseHandle(Fh);
  45.   inherited;
  46. end;
  47.  
  48. function TCamera.Start():boolean;
  49. begin
  50.   Fh:=capCreateCaptureWindowA('test',
  51.     WS_VISIBLE or WS_CHILD,
  52.     10000,
  53.     10000,
  54.     FWidth,
  55.     FHeight,
  56.     GetDesktopWindow,
  57.     0);
  58.   if(fh<>0)then
  59.     begin
  60.     SendMessage(Fh, WM_CAP_DRIVER_CONNECT, 0, 0);
  61.     result:=true;
  62.     end else
  63.     begin
  64.     result:=false;
  65.     end;
  66. end;
  67.  
  68. function TCamera.CaptureBMP(bmp:TBitmap):boolean;
  69. var tdc: HDC;
  70. begin
  71.   SendMessage(Fh, WM_CAP_GRAB_FRAME,0,0);
  72.   bmp.Width:=FWidth;
  73.   bmp.Height:=FHeight;
  74.   tdc := GetDC(Fh);
  75.   BitBlt(bmp.Canvas.Handle, 0, 0, FWidth, FHeight, tdc, 0, 0, SRCCOPY);
  76.   ReleaseDC(Fh, tdc);
  77.   result:=true;
  78. end;
  79.  
  80. function TCamList.FGetCount:integer;
  81. begin
  82.   result:=length(FList);
  83. end;
  84.  
  85. function TCamList.FGetItem(index:integer):TCamera;
  86. begin
  87.   result:=FList[index];
  88. end;
  89.  
  90. procedure TCamList.Emumerate();
  91. var i       : integer;
  92.     name    : array[0..255]of AnsiChar;
  93.     ver     : array[0..255]of AnsiChar;
  94.     cam     : TCamera;
  95. begin
  96.  for i:=0 to 9 do
  97.   begin
  98.   if(capGetDriverDescriptionA(i,@name,SizeOf(name),@ver,SizeOf(ver)))then
  99.      begin
  100.      cam:=TCamera.Create;
  101.      cam.Name:=string(name);
  102.      cam.Ver:=string(ver);
  103.      cam.CamIndex:=i;
  104.      SetLength(FList,length(FList)+1);
  105.      FList[High(FList)]:=cam;
  106.      end;
  107.   end;
  108. end;
  109. end.

Как видите, тут есть два класса — TCamera и TCamList. Самый необходимый для нас метод — TCamera.CaptureBMP. Он реализует захват кадра с камеры.

На главной форме располагаем один компонент TImage; — для вывода картинки, один ComboBox — для списка камер, одну кнопку (TButton или любую другую) — для запуска или остановки захвата видео, CheckBox — для запуска или остановки анализатора движения, и ещё таймер — для получения кадров. В private формы опишем список камер: CamList : TCamList; и саму камеру: cam: TCamera;

При создании формы, перебираем камеры в системе:

  1. procedure TMainForm.FormCreate(Sender: TObject);
  2. var i:integer;
  3. begin
  4.   CamList:=TCamList.Create;
  5.   CamList.Emumerate;
  6.   if(CamList.count=0)then
  7.     begin
  8.     ShowMessage('No cams detected!');
  9.     Application.Terminate;
  10.     exit;
  11.     end;
  12.   CamListCB.items.BeginUpdate;
  13.   try
  14.     CamListCB.items.Clear;
  15.     for i:=0 to CamList.count-1 do
  16.       CamListCB.items.AddObject(CamList[i].Name,CamList[i]);
  17.     CamListCB.ItemIndex:=0;
  18.   finally
  19.     CamListCB.items.EndUpdate;
  20.   end;
  21. end;

При нажатии на «Старт» — запускаем камеру:

  1. procedure TMainForm.StartButtonClick(Sender: TObject);
  2. begin
  3.   cam:=CamList[CamListCB.ItemIndex];
  4.   if(cam.Start)then
  5.     begin
  6.     CamListCB.Enabled:=false;
  7.     CamTimer1.Enabled:=true;
  8.     end;
  9. end;

По таймеру получаем картинку:

  1. procedure TMainForm.CamTimer1Timer(Sender: TObject);
  2. var BMP  : TBitmap;
  3. begin
  4.   bmp:=TBitmap.Create;
  5.   try
  6.     cam.CaptureBMP(bmp);
  7.     Image1.Picture.Assign(bmp);
  8.   finally
  9.     bmp.Destroy;
  10.   end;
  11. end;

Компилируем, запускаем, наслаждаемся результатом:

Захват видео с Web камеры

Анализ полученных кадров и определение движения

Теперь начинается самое интересное. Пособий о том, как получать изображение с камеры — полным полно в интернете. Нас же интересует определение движения. Скажу вам, что результат захватывает.

Для начала — немного теории. Мы будем использовать самый простой, однако, довольно эффективный и наиболее часто используемый метод — сравнение двух соседних кадров. Что же необходимо для этого?

Самый простой метод сравнения — это, конечно, попиксельное вычитание. Нам просто необходимо из каждого пикселя текущего кадра вычесть каждый пиксель предыдущего. Ну, и если разница = 0, то движения не было вовсе. Однако, на камере всегда присутствуют шумы, иногда пролетают мошки, комары... Поэтому мы не будем сравнивать разницу с нулём, а считать, что движение произошло, если модуль разницы меньше константы D Эта константа определяется опытным путём, числа 50 (из 255 возможных для каждого цвета) вполне достаточно.

Для кадра размером 640x480 и трёх цветов (красный, зелёный, синий) это будет: 640*480*3 = 921600 операций вычитания — почти миллион! И это не раз в секунду, а намного чаще (в идеале - 24 раза, но обычно количество кадров уменьшают до нескольких штук в секунду). Плюс, ещё надо их сравнить. Довольно ресурсоёмко...

Именно поэтому картинку приводят к чёрно-белому варианту и уменьшают в несколько раз. Мы каждый кадр тоже будем обесцвечивать и уменьшать (делить) на константу divisor.

Ну, алгоритм ясен:

  • Получили картинку с камеры;
  • Привели её к оттенкам серого для каждого пикселя: (R+G+B) div 3;
  • Поделили на делитель (например, было 640x480, делитель = 8, итоговый кадр будет 80x60);
  • Из полученной матрицы отнимаем матрицу, полученную на предыдущем кадре - получаем матрицу разницы (diff);
  • Считаем количество элементов diff, значение которых меньше D;
  • Если количество больше предельного K, то подаём сигнал тревоги.

Весь алгоритм реализуем в классе TMotionDetector

  1. unit MotionDetectorUnit;
  2. interface
  3. uses graphics;
  4. type
  5.   TMotionDetector = class
  6.    private
  7.     FOldBMP     : TBitmap;
  8.     FOldMatrix  : array of array of byte;
  9.     FNewMatrix  : array of array of byte;
  10.     FDiffMatrix : array of array of byte;
  11.     FNewBMP     : TBitmap;
  12.     Fdivisor    : integer;
  13.     function FGetWidth():integer;
  14.     function FGetHeight():integer;
  15.     function FGetOldM(x,y:integer):byte;
  16.     function FGetNewM(x,y:integer):byte;
  17.     function FGetDiffM(x,y:integer):byte;
  18.    public
  19.     function PushBitmap(bmp:TBitmap):boolean;
  20.     function DetectMotion():boolean;
  21.     property width:integer read FGetWidth;
  22.     property height:integer read FGetHeight;
  23.     property divisor:integer read Fdivisor write Fdivisor;
  24.     property OldM[X, Y: Integer]:byte read FGetOldM;
  25.     property NewM[X, Y: Integer]:byte read FGetNewM;
  26.     property DiffM[X, Y: Integer]:byte read FGetDiffM;
  27.     constructor Create;
  28.     destructor Destroy; override;
  29.    end;
  30. implementation
  31. uses SysUtils;
  32.  
  33. function TMotionDetector.FGetOldM(x,y:integer):byte;
  34. begin
  35.   if((not Assigned(FOldBMP))or(not Assigned(FNewBMP)))then
  36.     exit(0);
  37.   result:=FOldMatrix[x,y];
  38. end;
  39.  
  40. function TMotionDetector.FGetNewM(x,y:integer):byte;
  41. begin
  42.   if((not Assigned(FOldBMP))or(not Assigned(FNewBMP)))then
  43.     exit(0);
  44.   result:=FNewMatrix[x,y];
  45. end;
  46.  
  47. function TMotionDetector.FGetDiffM(x,y:integer):byte;
  48. begin
  49.   if((not Assigned(FOldBMP))or(not Assigned(FNewBMP)))then
  50.     exit(0);
  51.   result:=FDiffMatrix[x,y];
  52. end;
  53.  
  54. function TMotionDetector.DetectMotion():boolean;
  55. type TRGB=packed record
  56.         R : byte;
  57.         G : byte;
  58.         B : byte;
  59.       end;
  60.      TLine=array[0..65535]of TRGB;
  61.      PLine=^TLine;
  62. var x,y,yy,xx,w,h,i,j  : integer;
  63.     lines           : array of PLine;
  64.     sum             : integer;
  65.     point           : TRGB;
  66.     d_n,d_o         : integer;
  67. begin
  68.   if((not Assigned(FOldBMP))or(not Assigned(FNewBMP)))then
  69.     exit(false);
  70.   w:=length(FNewMatrix);
  71.   SetLength(FOldMatrix,w);
  72.   for x:=0 to w-1 do
  73.     begin
  74.     h:=length(FNewMatrix[x]);
  75.     SetLength(FOldMatrix[x],h);
  76.     for y:=0 to h-1 do
  77.       FOldMatrix[x,y]:=FNewMatrix[x,y];
  78.     end;
  79.   //
  80.   w:=FNewBMP.Width div Fdivisor;
  81.   h:=FNewBMP.Height div Fdivisor;
  82.   //
  83.   SetLength(FNewMatrix,w);
  84.   for x:=0 to w-1 do
  85.     SetLength(FNewMatrix[x],h);
  86.   //Convert New BMP to mask
  87.   SetLength(lines,Fdivisor);
  88.   for y:=0 to h-1 do
  89.     begin
  90.     yy:=y*Fdivisor;
  91.     for i:=0 to Fdivisor-1 do
  92.       lines[i]:=FNewBMP.ScanLine[yy+i];
  93.     for x:=0 to w-1 do
  94.       begin
  95.       xx:=x*Fdivisor;
  96.       sum:=0;
  97.       for i:=0 to Fdivisor-1 do
  98.         for j:=0 to Fdivisor-1 do
  99.           begin
  100.           point:=lines[i][xx+j];
  101.           sum:=sum+((point.R+point.G+point.B)div 3);
  102.           end;
  103.       FNewMatrix[x,y]:=(sum div Fdivisor)div Fdivisor;
  104.       end;
  105.     end;
  106.   SetLength(FNewMatrix,FNewBMP.Width div Fdivisor);
  107.   result:=length(FOldMatrix)=length(FNewMatrix);
  108.   if(result)then
  109.     begin
  110.     SetLength(FDiffMatrix,w);
  111.     for x:=0 to w-1 do
  112.       begin
  113.       SetLength(FDiffMatrix[x],h);
  114.       for y:=0 to h-1 do
  115.         begin
  116.         d_n:=FNewMatrix[x,y];
  117.         d_o:=FOldMatrix[x,y];
  118.         //if(d_n>d_o)
  119.         FDiffMatrix[x,y]:=(abs(d_n-d_o) and $FF);
  120.         end;
  121.       end;
  122.     end;
  123. end;
  124.  
  125. function TMotionDetector.FGetWidth():integer;
  126. begin
  127.   if((not Assigned(FOldBMP))or(not Assigned(FNewBMP)))then
  128.     exit(0);
  129.   result:=FOldBMP.Width div Fdivisor;
  130. end;
  131.  
  132. function TMotionDetector.FGetHeight():integer;
  133. begin
  134.   if((not Assigned(FOldBMP))or(not Assigned(FNewBMP)))then
  135.     exit(0);
  136.   result:=FOldBMP.Height div Fdivisor;
  137. end;
  138.  
  139. function TMotionDetector.PushBitmap(bmp:TBitmap):boolean;
  140. begin
  141.   FreeAndNil(FOldBMP);
  142.   FOldBMP:=FNewBMP;
  143.   FNewBMP:=TBitmap.Create;
  144.   FNewBMP.Width:=bmp.Width;
  145.   FNewBMP.Height:=bmp.Height;
  146.   FNewBMP.PixelFormat:=pf24bit;
  147.   FNewBMP.Assign(BMP);
  148.   result:=true;
  149. end;
  150.  
  151. constructor TMotionDetector.Create;
  152. begin
  153.   inherited;
  154.   Fdivisor:=8;
  155.   FOldBMP:=nil;
  156.   FNewBMP:=nil;
  157. end;
  158.  
  159. destructor TMotionDetector.Destroy;
  160. begin
  161.   inherited;
  162. end;
  163. end.

Компилируем, запускаем, наслаждаемся результатом:

Исходник: web-cam-analyzer-src.zip

Exe-шки: web-cam-analyzer-bin.zip

Комментарии

06.02.2013 04:34:44
Avatar of МихаилМихаил
Очень понравилась ваша программа но так как мои познания в delfi далеки от того чтоб написать аналогичную программу не могли бы вы более подробно прокомментировать вашу программу буду вам очень благодарен если вам не сложно скиньте на почту. заранее благодарю вас!
07.02.2013 04:41:11
Avatar of КонсервКонсерв
Спасибо. Приятно что мои труды не остались без внимания.
Прокомментировать - конечно же могу. Возможно даже я расширю статью. Но для начала скажите, что конкретно вам не понятно - как реализуется захват видео (что такое сообщения или что за страшные слова такие stdcall и external) или каким образом работает определение движения?
Какие моменты в статье описаны плохо? Что можно дополнить?
07.02.2013 05:44:24
Avatar of gerefgeref
Огромное спасибо !!!
Перерыл кучу сайтов и только тут нашёл то что искал.
Могу я использовать ваш код в своем приложении ?
07.02.2013 06:01:13
Avatar of КонсервКонсерв
Да, конечно. Иначе я бы его тут не выкладывал :-).
07.02.2013 10:01:54
Avatar of gerefgeref
Здравствуйте.

Как реализовать cam.Stop; , нужно остановить захват с камеры выбрать другую и опять запустить. После cam.Destroy; запуск cam.Start; приводит к ошибке.

Спасибо!

p.s. отличный блог.
08.02.2013 01:22:58
Avatar of КонсервКонсерв
Попробуйте так:

function TCamera.Stop():boolean;
begin
if(Fh<>0)then
begin
SendMessage(Fh, WM_CAP_STOP , 0, 0);
CloseHandle(Fh);
Fh:=0;
end;
end;
08.02.2013 01:53:18
Avatar of gerefgeref
Спасибо, но работает не совсем так )). после cam.stop(); вместо картинки с камеры получается копия экрана. Эффект прикольный.) http://geref.org/i/screen.jpg
08.02.2013 02:03:41
Avatar of КонсервКонсерв
В начало метода TCamera.CaptureBMP добавьте проверку:
if(Fh=0)then
begin
result:=false;
exit;
end;
08.02.2013 01:59:46
Avatar of МихаилМихаил
Спасибо большое за отзывчивость! Принцип программы понятен! но вот процедура сравнения картинок, перевода картинки в черно к оттенкам серого, обрисовка квадратиками областей движения.если вам не сложно то весь алгоритм TMotionDetector если можно по подробнее откомментировать для полных чайников. заранее вам благодарен!!!
12.02.2013 04:30:06
Avatar of denkodenko
пробовал откомпилировать, ничего не получается :(
во-первых, не компилируется, ошибки в модуле детектора
выкусил как мог его из проекта (не нужен),
программа откомпилировалась и запустилась, но легче не стало
у меня в системе 2 устройства, а в списке только одно Microsoft WDM и т.д.
и белый экран вместо картинки
пожалуйста, помогите, очень нужен граббер
если возможно, лучше на е-почту
С уважением,
Котович
16.03.2013 06:58:22
Avatar of tomskfarmtomskfarm
Здравствуйте!

Подскажите, пожалуйста- при компиляции программы Delphi (7) ругается на строки, содержащие "exit(0)" и "exit(false)", а именно "Missing operator or semicolon". Как можно исправить эту ошибку? Заранее спасибо.

19.03.2013 01:51:22
Avatar of ksenon37rusksenon37rus
Доброго времени суток!
Пробую сделать похожим образом (http://ignatiev.su/blog/posts/webcam-borlanddelphi-7) захват видео, но не могу захваченное видео вписать в размеры панели. Ввиду большего разрешения камеры на панели демонстрируется кусок видео, а не вписанное в эти размеры все видео. Подскажите что нужно изменить?
20.03.2013 12:00:46
Avatar of КонсервКонсерв
tomskfarm, exit с параметром возможен лишь в Delphi начиная с версии XE.
Для Delphi 7 пишите

begin
result:=...;
exit;
end;
27.03.2013 09:46:47
Avatar of ДмитрийДмитрий
Доброго дня!
Во-первых: спасибо за труды, очень интересно!

При отображении в режиме видеотрансляции TImage периодически очищается, что приводит к эффекту моргания видео...
Подскажите, как избавиться от данного эффекта?
27.03.2013 10:18:40
Avatar of КонсервКонсерв
Дмитрий, используйте двойную буферизацию :-)
01.04.2013 09:28:46
Avatar of ДмитрийДмитрий
Консерв, а можно подробнее два момента?
1) как реализовать двойную буферизацию
2) каким образом это должно помочь, или, по какой причине сейчас наблюдается такой эффект?

Заранее спасибо.
01.04.2013 01:00:08
Avatar of КонсервКонсерв
У меня данный эффект не наблюдается, но я часто встречал, что при некоторых настройках ОС бывает "моргание".

Это происходит потому, что процесс прорисовки картинки занимает некоторое время и этот процесс видим на экране.

Двойная буферизация - это такой приём, при котором изображение сначала рисуется в видеопамяти, которая не отображается на экране, а затем происходит довольно быстрое переключение указателя экрана в этот буфер.

Вам следует смотреть в сторону обработчика таймера (CamTimer1Timer). Вероятнее всего грешит Image1.Picture.Assign(bmp); Попробуйте использовать внутренний механизм двойной буферизации Delphi:

Image1.Parent.DoubleBuffered := true;

или вручную рисовать на канве с помощью BitBlt.
01.04.2013 03:33:57
Avatar of ДмитрийДмитрий
Консерв, спасибо, это помогло. Думаю, данную модификацию можно добавить в тело статьи)
08.04.2013 10:45:24
Avatar of ДмитрийДмитрий
Доброго дня!
Теперь вылезла другая проблема, спустя примерно час работы программы программа виснет, изображение замораживается, часы на форме тоже замораживаются, работать это дело дальше не хочет....
Судя по симптому, что-то где-то переполняется....
Есть идеи куда смотреть в таком случае?
Заранее спасибо, с уважением, Дмитрий.
08.04.2013 12:26:20
Avatar of ДмитрийДмитрий
Пытался сделать Cam.Stop с последующим Cam.Start, но по приведенному коду Cam.Stop вообще не отрабатывает почему-то....

function TCamera.Stop():boolean;
begin
if(Fh<>0)then
begin
SendMessage(Fh, WM_CAP_STOP , 0, 0);
CloseHandle(Fh);
Fh:=0;
end;
end;

вылетает с ошибкой Project raised exception class $C0000008 with message 'system exception (code 0xc0000008) at 0x771112f7'
22.05.2013 09:26:00
Avatar of ЮляЮля
Спасибо за статью,но если это возможно могли бы и вы мне на почту программу с комментариями скинуть
22.05.2013 09:29:53
Avatar of ЮляЮля
Очень понравилась ваша программа !!! могли бы подробно прокомментировать программу,и скинуть на почту
28.06.2013 03:45:32
Avatar of НикитаНикита
Спасибо большое)) А как подгрузить библиотеку AVICAP32.DLL динамически? т.е. она бы подгрузилась тогда, когда нам нужно будет сделать захват изображения с вебки..
20.07.2013 12:39:17
Avatar of sliderslider
Могли бы вы выложить исходник для скачивания. В котором идет захват кадра и показ его на Image без записи в файл и все
20.07.2013 12:54:48
Avatar of sliderslider
при компиляции дает ошибку в строке
CamList:=TCamList.Create;
22.07.2013 02:48:21
Avatar of КонсервКонсерв
@Юля
Ответил по почте на все вопросы.

@Никита
Вопрос выходит за рамки данного поста.
Используйте LoadLibrary и GetProcAddress.

@slider
Исходник имеется.
Получение картинки происходит в обработчике таймера формы (TMainForm.CamTimer1Timer).
Опишите ошибку подробнее. Какая у Вас версия Delphi?
Напоминаю что исходник дан для Delphi XE и выше. Если необходима поддержка версий ниже XE, сообщите.
22.07.2013 06:56:18
Avatar of sliderslider
делфи 7.
ваша программа показывает белый экран и нет настроек драйвера
22.07.2013 07:16:14
Avatar of sliderslider
как добавить в программу функции
SendMessage(h_cam, WM_CAP_DLG_VIDEOSOURCE, SizeOf(Bt), LongInt(@Bt));
SendMessage(h_cam, WM_CAP_DLG_VIDEOFORMAT, SizeOf(Bt), LongInt(@Bt));
09.09.2013 06:11:01
Avatar of AlexAlex
Как сделать что бы только делала фото и сохраняла в нужный каталог!??
10.09.2013 04:34:11
Avatar of КонсервКонсерв
@slider
Вместо h_cam использовать соответствующее поле класса. Определить константы WM_CAP_DLG_VIDEOSOURCE и WM_CAP_DLG_VIDEOFORMAT. И ещё структуру Bt (или что это такое?) описать.
К сожалению, в скором будущем за Delphi 7 взяться не смогу. Если очень надо - можете сами портировать.

@Alex
cam.CaptureBMP(bmp);
bmp.savetofile(<путь к файлу>);
08.12.2013 01:52:16
Avatar of СергейСергей
Народ как сделать запись,т.е сохранение видео в реальном времени видео с Image1?
11.12.2013 10:17:30
Avatar of КонсервКонсерв
@Сергей
Всё не так просто. Это — тема для отдельной статьи.
27.03.2014 07:36:54
Avatar of АлександрАлександр
Здравствуйте! Я с программированием не знаком. Можете ли вы доработать вашу программу? Необходимо проконтролировать что делает ребенок на компьютере. Можно организовать запись экрана, только тогда когда там что-то происходит? Программ записывающих непрерывно много, соответственно и размер файла там огромный, а таких не нашел. Буду очень благодарен если создадите такую программу, и наверно не только я.
18.05.2014 07:27:54
Avatar of РоманРоман
системе 2 устройства, а в списке только одно Microsoft WDM. Показывает черный экран. Что можно сделать?
18.05.2014 08:23:46
Avatar of ЯЯ
Автор очень "хороший" человек!
Выложил исходник без exe файла!
19.05.2014 11:49:43
Avatar of КонсервКонсерв
@Роман
Сталкивался с таким на некоторых ноутбуках. После 3-4 перезапусков софта заработало.

Может быть, у меня какой-то баг? Я его не нашел. Или же проблема в том, что библиотека AVICAP32.DLL попросту устарела.


Программа писалась ещё во времена Windows XP, в семёрке у меня тоже глючит, вот я чуток поправил захват видео - проверьте последние EXE-шки. Если всё будет ок - обновлю исходник.

В серьёзных проектах сейчас используют DirectShow - этот способ удобнее и универсальнее. У меня в планах было разобраться с DirectShow и когда до этого дойдут руки, я обязательно выложу исходник.
19.05.2014 12:36:56
Avatar of КонсервКонсерв

Вот, пожалуйста. Скомпилировал и добавил ссылку в конец статьи.
19.05.2014 03:29:39
Avatar of РоманРоман
Нет, результат тот же: Microsoft WDM Image Capture (Win32) и все.

Наверное действительно какие-то существенные изменения претерпел AVICAP32.DLL. Запускаю на ноутбуке под Windows 8.1
22.05.2014 05:26:41
Avatar of КонсервКонсерв
@Роман
Возможно. К сожалению, из всех тех компьютеров, которые меня окружают, ни на одном нет Windows 8.

Давно собирался разобраться с DirectShow, всё никак руки не доходят. В последнее время практически на 100% пересел на управление проектами и Web.
01.06.2014 01:50:01
Avatar of LeoLeo
подскажите пожалуйста как сделать так что бы в delphi записывалась видео с камеры и сохранялось в X папке.если возможно сделайте пример программы.премного благодарен
13.06.2014 04:01:46
Avatar of АнтонАнтон
Очень интересный пример, спасибо большое, однако неплохо было бы прокомментировать исходник ;)
А так, нигде рабочих примеров не находил, кроме вашего, спасибо)
31.07.2014 09:26:02
Avatar of TeliSTeliS
Исходник хороший, как раз то что я искал =). Вы не против если я его немного переделаю под детектор движения?
p/s Больше пояснений явно не помешало бы, хоть я и знаю делфи но не на таком уровне =)(Взял бы у вас уроки =))
22.08.2014 11:59:30
Avatar of КонсервКонсерв
Ребята, исходник берите, переделывайте.

Объяснять много не могу чисто физически, по моему, и так понятно. Если есть конкретные вопросы - задавайте, отвечу.
01.09.2014 02:07:38
Avatar of АлександрАлександр
Все норм, но вот утечка памяти - это не хорошо) Так лучше:
procedure TCamera.CaptureBMP(bmp: TBitmap);
var
tdc: HDC;
begin
SendMessage(Fh, WM_CAP_GRAB_FRAME, 0, 0);
bmp.Width := FWidth;
bmp.Height := FHeight;
tdc := GetDC(Fh);
BitBlt(bmp.Canvas.Handle, 0, 0, FWidth, FHeight, tdc, 0, 0, SRCCOPY);
ReleaseDC(Fh, tdc);
end;
02.09.2014 10:02:33
Avatar of КонсервКонсерв
@Александр
Спасибо, поправил :-).
14.10.2014 07:39:01
Avatar of МаксимМаксим
Белый экран появляется если использовать 32 битную программу на 64 битной системе. Вопрос: чем отличаются исходные коды предоставленных выше 2х ехе? WebCam_x32.exe и WebCam_x64.exe. Или как скомпилировать 64 разрядную версию?
14.10.2014 09:38:40
Avatar of МаксимМаксим
С компиляцией разобрался. Но проблема осталась. Белый экран. Ваш же ехе х64 работает отлично.
08.01.2015 02:37:33
Avatar of КонсервКонсерв
@Максим
Может быть, проблема в том, что библиотека AVICAP32.DLL попросту устарела?

Попробуйте убрать хак со скрытием окна камеры - в capCreateCaptureWindowA вместо 10000 поставьте 0.
20.01.2015 10:20:56
Avatar of niknik
Все предложеное высше учел, но после компиляции белый экран. Мой EXE-шник не такой как Ваш. (Скинте исходник). Спасибо.
05.02.2015 01:29:42
Avatar of ВиталийВиталий
Добрый день.
Направил на тестер, работает.
Есть пример на распознавания на MatLab.
http://www.cyberforum.ru/measuring-devices/thread1364812.html
Для дальнейшей работы выбран Excel, чтобы исходники виделись на каждой машине.
Вам осталось совсем немного до распознавания цифр и тестеры вместе с другими цифровыми у Вас в кармане.
Спасибо
Виталий
19.02.2015 06:19:23
Avatar of NickNick
Хорошая реализация, спасибо за исходники. А не подскажете, есть ли возможность не включать светодиод подсветки при захвате изображения с камеры?
20.02.2015 07:13:44
Avatar of КонсервКонсерв
@Nick
Я не уверен, но мне кажется что нет.
03.05.2015 04:51:43
Avatar of СаняСаня
Добрый день,тема моей работы "Обнаружение и выделение движущегося объекта в последовательности изображений". Дело в том, что изображения по условию мне получать не надо они уже есть, даже уже и черно-белые.(хотя можно и оставить цветные, с переделкой под оттенки серого). Не могли бы Вы, Консерв, с комментариями прислать часть TMotionDetector, просто хочу переделать под делфи 2006, и не пойму с какого места начать. Заранее большое спасибо
23.06.2015 11:47:50
Avatar of skaleckiyskaleckiy
Я у вас в коде нашел ошибку, даже если по вашему сделать очищение объекта память будет все равно загружаться! Для избежания это проблемы я советовал бы очищать объекты в таймере, где они и создаются.

procedure TMainFormCamera.CamTimer1Timer(Sender: TObject);
var BMP,orig : TBitmap;
begin
bmp:=TBitmap.Create;
bmp.PixelFormat:=pf24bit;
cam.CaptureBMP(bmp);
orig:=TBitmap.Create;
orig.Width:=bmp.Width;
orig.Height:=bmp.Height;
orig.Assign(bmp);
orig.Free;
bmp.free;

end;
11.09.2015 09:23:13
Avatar of SeregaSerega
Здравствуйте! Подскажите пожалуйста, как с Web-камеры снять изображение, засунуть в TMemoryStream и транслировать его, допустим на клиент (TCPServer/TCPClient)?
14.09.2015 11:22:17
Avatar of КонсервКонсерв
@Serega
Расскажу вкратце:
cam.CaptureBMP(bmp);
bmp.savetostream(stream);

Далее транслируем наш stream по своему протоколу в TCPServer/TCPClient.

Лучше, конечно, предварительно перекодировать в JPEG.
13.10.2015 11:22:50
Avatar of PatrikPatrik
Очень прикольная программа. Очень хочу в ней разобраться но я не могу скомпилировать программу выдает ошибки которые я не знаю как исправить. Пожалуйста сбросте программу с кодом на почту. Буду очень благодарен
13.10.2015 11:26:39
Avatar of PatrikPatrik
Здравствуйте! Очень понравилась программа. Хотел разобраться как она работает но не могу откомпелировать. Пожалуйста сбросте программу с кодом на почту. Буду очень благодарен
13.10.2015 03:43:20
Avatar of КонсервКонсерв
@Patrik
Ссылки на исходник и EXE-шник есть в конце статьи.
14.10.2015 11:54:19
Avatar of PatrikPatrik
Спасибо! EXE-шник работает но код не компелируется. [url=http://pixs.ru/showimage/Bezimyanni_3536047_19134117.jpg][img]http://i11.pixs.ru/thumbs/1/1/7/Bezimyanni_3536047_19134117.jpg[/img][/url]
14.10.2015 11:55:15
Avatar of PatrikPatrik
http://pixs.ru/showimage/Bezimyanni_3536047_19134117.jpg
16.10.2015 09:42:47
Avatar of PatrikPatrik
Так вы можете помочь мне с моей проблемой?
16.10.2015 09:53:56
Avatar of PatrikPatrik
Проблема решена! Извините за беспокойство. Только изображения нету, все черное
16.10.2015 04:02:58
Avatar of КонсервКонсерв
@Patrik
По поводу вашей проблемы читайте мой комментарий от
20.03.2013.

Delphi 7 уже очень сильно устарела, лучше используйте любую более-менее современную версию.

По поводу чёрного экрана. 1. Вы кнопку "Start" нажимали?
2. Возможно, вы некорректно закрыли устройство в прошлый раз или веб-камера уже используется другими программами? Перезагрузите компьютер и запустите программу "начисто". Попробуйте на другом компьютере.
3. Веб камера настроена и работает? Другие программы для работы с камерой работают?
4. Какая у вас версия Windows?
17.10.2015 12:55:19
Avatar of PatrikPatrik
По поводу ошибки с EXIT я уже разобрался. Перешел на Embrakadero. На ноутбуке у меня камера встроена но идет как USB-видеоустройство и выдает черный экран на Image, хоть при нажатии на кнопку "Start" информация о веб-камере дается. Перезагружал и ничего не помогало. Пробовал на других ПК с Windows 7 и там работает. На ноутбуке тоже Windows 7. Другие программы для работы с веб-камерой не работают, даже Skype закрыл и ничего.
03.11.2015 11:02:27
Avatar of PatrikPatrik
Недавно узнал что картинка с камеры снимается но не выводится на Image. В чем может быть дело?
24.11.2015 10:05:32
Avatar of АнатолийАнатолий
Здравствуйте, как корректно поменять разрешение камеры? При замене в модуле CamCaptureUnit строк
FWidth:=1280;
FHeight:=800;
Отображается не полный Image, картинка занимает примерно четверть. Для Image сделал ресайз под 1280х800. Камера поддерживает такое разрешение, проверял.
24.11.2015 10:59:41
Avatar of КонсервКонсерв
@Анатолий
Странно. Должно работать.

У меня 640x480. Проверить на "большей" камере, к сожалению, не могу.
24.11.2015 11:10:23
Avatar of КонсервКонсерв
@Patrik
Библиотека AVICAP32 устарела. Я замечал проблемы при неправильном закрытии программы (без кнопки отправки сообщения WM_CAP_STOP). Бывали проблемы при повторном открытии программы.

Думаю, Microsoft просто "забила" на поддержку AVICAP32. На MSDN давно уже пишут о проблемах с чёрным экраном на Windows 7 и выше.
https://msdn.microsoft.com/ru-ru/library/windows/desktop/dd756879(v=vs.85).aspx

AVICAP32 - это больше так, поиграться. Серьёзные проекты (типа Skype) используют DirectShow. Опыта использования DirectShow у меня нет.
27.11.2015 10:33:24
Avatar of PatrikPatrik
Спасибо за ответ. Очень жаль что поддержка AVICAP32 больше нет.
Просто тут все хорошо расписано.
27.06.2016 09:08:11
Avatar of Terik90Terik90
Добрый день. Скажите при вызове
Fh:=capCreateCaptureWindowA('test', WS_VISIBLE or WS_CHILD,10000,10000, FWidth,FHeight,GetDesktopWindow,0);
Открывается новое окно, не смотря на то что окно за границами экрана (координаты 10000,10000), на панели задач оно видно. Иожно ли как-то скрыть его?
27.06.2016 09:30:38
Avatar of Terik90Terik90
Разобрался, если кому-то нужно будет, то после
Fh:=capCreateCaptureWindowA('test', WS_VISIBLE,10000,10000, FWidth,FHeight,GetDesktopWindow,0);

Добавьте
ShowWindow(Fh,SW_HIDE);
SetWindowLong(Fh, GWL_EXSTYLE,
GetWindowLong(Fh, GWL_EXSTYLE) OR WS_EX_TOOLWINDOW);
ShowWindow(Fh,SW_SHOW);
27.03.2017 08:01:37
Avatar of НурикНурик
Я открыл программу на дельфи ХЕ 5. Но не компилируется. Вот такая ошибка выходит. Module Load: CLBCatQ.DLL. No Debug Info. Base Address: $76FD0000. Process WebCam.exe (1980). Я сделал Build Configuration на Release. и на Debug. Но все равно какие-то вот такие ошибки. Что делать. Помоги пожалюсто
10.07.2017 03:05:40
Avatar of oninymasakoninymasak
XE3 собирается на раз:

dcc32.exe WebCam.dpr -M -B --no-config -$J+,R-,I-,Q-,Y-,B-,A+,W-,U-,T-,H+,X+,P+,V+,G+ -AWinTypes=Winapi.Windows;WinProcs=Win
api.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;Generics.Collections=System.Generics.Collections;Generics.Defaults=System.
Generics.Defaults -W-SYMBOL_PLATFORM -W-UNIT_PLATFORM -W-GARBAGE -NSSystem;Xml;Data;Datasnap;Web;Web.Win;Soap.Win;Winapi;Sys
tem.Win;Data.Win;BDE;Xml.Win;Web.Win;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Shell;VCLTee -$D- -GD -U".;c:\delphi\2013\lib\win32\debug
;c:\delphi\2013\lib\win32\release;c:\delphi\2013\imports;c:\delphi\2013\projects\bpl;c:\delphi\2013\source\toolsapi;c:\delph
i\2013\lib\win32\indy10" -I".;c:\delphi\2013\lib\win32\debug;c:\delphi\2013\lib\win32\release;c:\delphi\2013\imports;c:\delp
hi\2013\projects\bpl;c:\delphi\2013\source\toolsapi;c:\delphi\2013\lib\win32\indy10" -R".;c:\delphi\2013\lib\win32\debug;c:\
delphi\2013\lib\win32\release;c:\delphi\2013\imports;c:\delphi\2013\projects\bpl;c:\delphi\2013\source\toolsapi;c:\delphi\20
13\lib\win32\indy10"
Captcha Обновить
Go Top