Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Мультимедиа
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 09.02.2008, 15:21
KapKan KapKan вне форума
Прохожий
 
Регистрация: 09.02.2008
Сообщения: 10
Репутация: 5
По умолчанию Delphi и веб-камера

Всем Здраствуйте.
Вопрос который я встречал на многих сайтах да собственно и сам им задовался: с помощью чего произвести захват картинки с веб-камеры?
Ответ я нашел, как мне козалось, в журнале Хакер №103 - Программерская сигнализация. В итоге после написания кода, программа почему то не выводила картинку. Программа основана на компоненте DSpack. Помогите разобраться.

Вот собственно сам код:
Код:
unit Camera;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, DSPack, DSUtil, DirectShow9, ExtCtrls;

type
  TForm1 = class(TForm)
    FilterGraph: TFilterGraph;
    VideoWindow1: TVideoWindow;
    Filter1: TFilter;
    SampleGrabber1: TSampleGrabber;
    ComboBox1: TComboBoxEx;
    Label1: TLabel;
    ButtonStopPlay: TButton;
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    CheckBox1: TCheckBox;
    Timer1: TTimer;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ButtonStopPlayClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  VideoDevice: TSysDevEnum;

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);
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
 FilterGraph.ClearGraph;
 FilterGraph.Active := false;
 Filter1.BaseFilter.Moniker := VideoDevice.GetMoniker(ComboBox1.ItemIndex);
 FilterGraph.Active := true;
 with FilterGraph as ICaptureGraphBuilder2 do
 RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter1 as IBaseFilter, SampleGrabber1 as IBaseFilter, VideoWindow1 as IbaseFilter);
 FilterGraph.Play;
 ButtonStopPlay.Enabled:=True;
end;

procedure TForm1.ButtonStopPlayClick(Sender: TObject);
begin
 if ButtonStopPlay.Caption='Смотреть' then
  begin
   FilterGraph.Play;
   ButtonStopPlay.Caption:='Остановить';
  end
 else
  begin
   FilterGraph.Stop;
   ButtonStopPlay.Caption:='Смотреть';
  end;
end;




procedure TForm1.Button1Click(Sender: TObject);
begin
  SampleGrabber1.GetBitmap(Image1.Picture.Bitmap);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
 i:integer;
 j:integer;
 k:integer;
 r1,g1,b1:Byte;
 r2,g2,b2:Byte;
 FirstColor,SecondColor:Integer;
 Color:TColor;
 PriznakChange: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
     PriznakChange:=0;
     FirstColor:=Image1.Picture.Bitmap.Canvas.Pixels[i,j];
     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(PriznakChange);
     if Abs(g1-g2)>20 then inc(PriznakChange);
     if Abs(b1-b2)>20 then inc(PriznakChange);
     if PriznakChange=3 then k:=k+1;
     Application.ProcessMessages;
    end;
  end;
 if k>2000 then
  begin
   Memo1.Lines.Add(FormatDateTime('hh:nn:ss',Now)+' Зафиксированы изменения по периметру! ');
   Image2.Picture.Bitmap.SaveToFile('log\'+FormatDateTime('hhnnss',Now)+'.bmp');
  end;
end;


end.

Последний раз редактировалось Admin, 09.02.2008 в 15:45.
Ответить с цитированием
  #2  
Старый 09.02.2008, 15:30
Аватар для Admin
Admin Admin вне форума
Администратор
 
Регистрация: 03.10.2005
Адрес: Россия, Москва
Сообщения: 1,560
Версия Delphi: Delphi 7
Репутация: выкл
По умолчанию

Не забываем читать Правила форума и выделять код тегом [СODE]...[/СODE].
Ответить с цитированием
  #3  
Старый 09.02.2008, 18:19
KapKan KapKan вне форума
Прохожий
 
Регистрация: 09.02.2008
Сообщения: 10
Репутация: 5
По умолчанию

Спасибо учту
Ответить с цитированием
  #4  
Старый 10.02.2008, 08:45
KapKan KapKan вне форума
Прохожий
 
Регистрация: 09.02.2008
Сообщения: 10
Репутация: 5
По умолчанию

Я так понимаю никто не сталкивался с программированием для веб-камеры?
Ответить с цитированием
  #5  
Старый 10.02.2008, 09:28
Аватар для moo2k
moo2k moo2k вне форума
Активный
 
Регистрация: 05.12.2006
Адрес: где-то там...
Сообщения: 321
Репутация: 35
По умолчанию

Вот подправил ошибки, которые нашел. У меня работает. Компилил на D2007.
Вложения
Тип файла: zip Camera.zip (5.8 Кбайт, 2152 просмотров)
__________________
Программирование - это искусство и наш смысл жизни.
Ответить с цитированием
  #6  
Старый 20.02.2008, 08:25
KapKan KapKan вне форума
Прохожий
 
Регистрация: 09.02.2008
Сообщения: 10
Репутация: 5
По умолчанию

попробую разобраться спасибо!
Теперь другой вопрос: с помщью демок, которые шли вместе с DSpack
пытаюсь записывать с камеры в файл AVI и при этом снять картинку и сохранить в отдельный файл (не останавливая запись), но че то не получается. Если кто-нибудь сталкивался подскажите методы. Пока пробую с помощью samplegrabber.
Ответить с цитированием
  #7  
Старый 10.05.2008, 08:04
KapKan KapKan вне форума
Прохожий
 
Регистрация: 09.02.2008
Сообщения: 10
Репутация: 5
По умолчанию

До сих пор не разобрался как писать видео скамеры и при этом спокойно снимать от туда картинку с сохранением в файл jpg
подскажите люди добрые
Ответить с цитированием
  #8  
Старый 10.05.2008, 13:23
Аватар для moo2k
moo2k moo2k вне форума
Активный
 
Регистрация: 05.12.2006
Адрес: где-то там...
Сообщения: 321
Репутация: 35
По умолчанию

А что если использовать второй samplegrabber и получать картину с веб-камеры вторым потоком?
__________________
Программирование - это искусство и наш смысл жизни.
Ответить с цитированием
  #9  
Старый 08.09.2008, 13:14
DSL88 DSL88 вне форума
Новичок
 
Регистрация: 08.09.2008
Адрес: Пермь
Сообщения: 51
Репутация: 10
По умолчанию

И у меня есть вопрос: Как выдавать данное вещь в поток?
__________________
Жизнь - игра: сюжет фигня... Зато какая графика!!!
Ответить с цитированием
  #10  
Старый 02.10.2009, 17:20
Аватар для TolAlik
TolAlik TolAlik вне форума
Прохожий
 
Регистрация: 02.10.2009
Сообщения: 41
Репутация: 10
По умолчанию

Hi! опробовал описанный выше пример кода и обнаружил, при выборе утройства веб-камеры выскакивает ошибка "External exception с0000008" если выполняется строчка "FilterGraph1.Active := true", а при выборе устройства тв-тюнера работает все отлично.
Вроде все правильно, но понять ни чего не могу...

Код:
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  FilterGraph1.ClearGraph;
  FilterGraph1.Active := false;
  //Задаем устройство, с которым будем работать
  Filter1.BaseFilter.Moniker :=VideoDevice.GetMoniker(ComboBox1.ItemIndex);
  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;

Последний раз редактировалось TolAlik, 02.10.2009 в 19:44.
Ответить с цитированием
  #11  
Старый 02.10.2009, 17:20
Аватар для TolAlik
TolAlik TolAlik вне форума
Прохожий
 
Регистрация: 02.10.2009
Сообщения: 41
Репутация: 10
По умолчанию

заранее спасиб

Последний раз редактировалось TolAlik, 02.10.2009 в 17:22.
Ответить с цитированием
  #12  
Старый 26.10.2009, 13:29
Slavur Slavur вне форума
Прохожий
 
Регистрация: 26.10.2009
Сообщения: 1
Репутация: 10
По умолчанию Наблюдаю такаю же проблему

Причем пока у меня была камера Logitech проблема не возникала.
А после замены на Genius Messenger 310 возникает на строке (2-й)

Filter.BaseFilter.Moniker := videodevice.GetMoniker(scombobox1.ItemIndex);
filtergraph.Active := true;
ошибка "External exception с0000008"

И ещё! Ошибка возникает при запуске под Дельфи, а когда запускаю exe откомпилированный всё в порядке. Вот это самое необычное для меня
Ответить с цитированием
  #13  
Старый 27.10.2009, 14:30
sdsfy sdsfy вне форума
Прохожий
 
Регистрация: 24.10.2009
Сообщения: 3
Репутация: 10
По умолчанию

А кто -нить может сказать, как перегнать это видео в поток чтоб слить его в БД в BLOB-поле?
Ответить с цитированием
  #14  
Старый 14.06.2010, 21:10
fanato4ka fanato4ka вне форума
Прохожий
 
Регистрация: 14.06.2010
Сообщения: 1
Репутация: 10
По умолчанию Помогите!!

народ!!
кто подскажет..почему у меня камера верх ногами показывает??
во всех програмах
что нужно делать?
Ответить с цитированием
  #15  
Старый 15.06.2010, 13:51
Аватар для mak-karpov
mak-karpov mak-karpov вне форума
Активный
 
Регистрация: 18.09.2008
Сообщения: 235
Версия Delphi: 2010 и 7
Репутация: 1242
По умолчанию

Цитата:
Сообщение от fanato4ka
народ!!
кто подскажет..почему у меня камера верх ногами показывает??
во всех програмах
что нужно делать?
Может, потому, что веб-камера вверх ногами?
__________________
Кнопка "+" - весы в правом верхнем углу сообщения...
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 18:19.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter