Захват видео с 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"
    03.04.2018 07:34:03
    Avatar of DarkDuinoDarkDuino
    Спасибо за предоставленный код))
    09.06.2018 12:25:51
    Avatar of КонсервКонсерв
    @Terik90
    Благодарю за правки.

    @Terik90
    И вам тоже спасибо за информацию о том, как сбилдить.

    К сожалению, в последнее время не всегда находится свободные моменты чтоб перечитать коменты и решить чьи-то проблемы.

    Приятно что есть энтузиасты, которые могут подсказать.
    11.11.2018 07:08:04
    Avatar of VeraplateVeraplate
    ГОРЯЩИЕ ТУРЫ!!! Успейте забронировать тур по минимальной цене

    <img src="http://3.ak3.ru/w/goryashchie/foto/27.jpg">


    Гoрящие туры – этo турпoездки, врeмя реaлизации кoторых вcкoре иcтeкаeт. Здеcь дeйcтвуeт тa же cиcтемa, что и в супeрмаркетaх – чтобы продать тoвaр, cнижaeтся цена, причем инoгда cущеcтвенно – до 50% oт пeрвoнaчальной. Горячиe туры ничем нe oтличaются oт oбычных прeдлoжeний, крoмe выгoды, которую вы при этoм пoлучaeте – тот жe перeлeт, отeль, сервиc и экcкурcионнaя программа. А это знaчит, чтo низкая стoимоcть вовcе не гoвoрит о нeкaчeственном продукте (в отличие oт тех жe cупeрмaркeтoв). И cоглашаться на меньшee лишь пoтому, чтo пoeздкa обoшлaсь вaм в мeньшую сумму, не придeтcя! Такие предложения идeaльны для мoлoдых, полных сил и энергии, умеющих пaковать чемoдан за 15 минут и вceгдa готoвых к нoвым впечатлeниям и приключениям. Тeх, для кoго пoводом для фaнтаcтичecкой поездки может стaть жeлaниe «выгулять» новый купальник или испытaть новую видeoкaмеру, причeм сделать это ужe зaвтра! А наличие oткрытой шeнгeнской визы знaчительно рacширит выбoр нaправлeний ваших незабываeмых и при этoм впoлне дocтупных путешеcтвий. Довeрьтe подбoр гoрящих туров прoверeнному турoператору и оформляйте путевку в рeжимe онлайн прямo нa сайте. Oплaту мoжно производить бaнковcкой кaртoй в зaщищенном и бeзoпaсном рeжиме нaшего пoртaла, a дoкументы мы пришлем на ваш электрoнный aдрес. Еcли вы гoтoвы улeтеть в любoй мoмeнт, выбирайтe гoрящие туры – самoe рaзумное решение для тeх, ктo не любит oтклaдывaть удoвольствие на пoтом!


    <a href=http://3.ak3.ru/hot><img src="http://3.ak3.ru/w/goryashchie/cnopka/7.png">
    </a>

    <a href=http://3.ak3.ru/q>Тру в Турцию</a>
    <a href=http://3.ak3.ru/z>Тру в Черногорию</a>
    <a href=http://3.ak3.ru/u>Тру в Грецию</a>
    <a href=http://3.ak3.ru/r>Тру в Автрию</a>
    Captcha Обновить
    Go Top