|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
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
|
||||
|
||||
Не забываем читать Правила форума и выделять код тегом [СODE]...[/СODE].
|
#3
|
|||
|
|||
Спасибо учту
|
#4
|
|||
|
|||
Я так понимаю никто не сталкивался с программированием для веб-камеры?
|
#5
|
||||
|
||||
Вот подправил ошибки, которые нашел. У меня работает. Компилил на D2007.
Программирование - это искусство и наш смысл жизни. |
#6
|
|||
|
|||
попробую разобраться спасибо!
Теперь другой вопрос: с помщью демок, которые шли вместе с DSpack пытаюсь записывать с камеры в файл AVI и при этом снять картинку и сохранить в отдельный файл (не останавливая запись), но че то не получается. Если кто-нибудь сталкивался подскажите методы. Пока пробую с помощью samplegrabber. |
#7
|
|||
|
|||
До сих пор не разобрался как писать видео скамеры и при этом спокойно снимать от туда картинку с сохранением в файл jpg
подскажите люди добрые |
#8
|
||||
|
||||
А что если использовать второй samplegrabber и получать картину с веб-камеры вторым потоком?
Программирование - это искусство и наш смысл жизни. |
#9
|
|||
|
|||
И у меня есть вопрос: Как выдавать данное вещь в поток?
Жизнь - игра: сюжет фигня... Зато какая графика!!! |
#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
|
||||
|
||||
заранее спасиб
Последний раз редактировалось TolAlik, 02.10.2009 в 17:22. |
#12
|
|||
|
|||
Наблюдаю такаю же проблему
Причем пока у меня была камера Logitech проблема не возникала.
А после замены на Genius Messenger 310 возникает на строке (2-й) Filter.BaseFilter.Moniker := videodevice.GetMoniker(scombobox1.ItemIndex); filtergraph.Active := true; ошибка "External exception с0000008" И ещё! Ошибка возникает при запуске под Дельфи, а когда запускаю exe откомпилированный всё в порядке. Вот это самое необычное для меня |
#13
|
|||
|
|||
А кто -нить может сказать, как перегнать это видео в поток чтоб слить его в БД в BLOB-поле?
|
#14
|
|||
|
|||
Помогите!!
народ!!
кто подскажет..почему у меня камера верх ногами показывает?? во всех програмах что нужно делать? |
#15
|
||||
|
||||
Цитата:
Кнопка "+" - весы в правом верхнем углу сообщения... |
|
Опции темы | Поиск в этой теме |
Опции просмотра | |
|
|