|
|
Регистрация | << Правила форума >> | 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
|
|||
|
|||
Цитата:
Насчет проблемы с появлением ошибки external exception c0000008 при работе с web камерой (если вдруг кому потребуется). Решается так: Tools -> Options -> Borland Debuggers -> Native OS Exceptions -> Ищите там свою ошибку Invalid Handle ($C0000008) и ставите в атрибутах On resume - Run handled. Компилируете и наслаждаетесь картинкой с камеры. |
#8
|
|||
|
|||
Блин а как DSPack добавить в 9 делфи???... он скотина выкоблучивается))) не хочет... или я вася)!
|
#9
|
||||
|
||||
Все нормально устанавливается.
— Как тебя понимать? — Понимать меня не обязательно. Обязательно меня любить и кормить вовремя. На Delphi, увы, больше не программирую. Рекомендуемая литература по программированию |
#10
|
||||
|
||||
Когда я пытался поставить DSPack в свою Delphi10, он мне выдал около десятка ошибок. Пришлось их править: сидеть и вникать, что же хотел написать автор. В итоге запустил...
Но мое личное ИМХО - игра не стоит свеч. Для работы с веб-камерой пользую AVICAP32.DLL (стандартная библа винды) и счастлив Правда не знаю, можно ли им сохранить видео. jmp $ ; Happy End! The Cake Is A Lie. |
#11
|
|||
|
|||
Пасибо большое... использую эту библиотеку, работает... но вверх ногами)))) как-бы пытаюсь найти косяк но чето нихрена вот код:
Код:
SaveDialog1: TSaveDialog; Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button6Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { Private declarations } hWndC: THandle; CapturingAVI: bool; public { Public declarations } end; var Form1: TForm1; implementation const WM_CAP_START = WM_USER; const WM_CAP_STOP = WM_CAP_START + 68; const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10; const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11; const WM_CAP_SAVEDIB = WM_CAP_START + 25; const WM_CAP_GRAB_FRAME = WM_CAP_START + 60; const WM_CAP_SEQUENCE = WM_CAP_START + 62; const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20; {$R *.dfm} function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall external'AVICAP32.DLL'; procedure TForm1.Button1Click(Sender: TObject); begin hWndC := capCreateCaptureWindowA('My Own Capture Window', WS_CHILD or WS_VISIBLE, Panel1.Left, Panel1.Top, Panel1.Width, Panel1.Height, Form1.Handle, 0); if hWndC <> 0 then SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0); timer1.Enabled:=true; end; procedure TForm1.Timer1Timer(Sender: TObject); begin if hWndC <> 0 then SendMessage(hWndC, WM_CAP_GRAB_FRAME, 0, 0); тут это типо картинку каждый раз обнавляет... end; Последний раз редактировалось Admin, 13.01.2011 в 09:53. |
#12
|
||||
|
||||
А дрова для камеры точно есть?
Обычно они проводят всю работу перед тем, как вывести изображение на экран. Вообще есть такая штука: Код:
const AVICAPDLL = 'AVICAP32.DLL'; WM_CAP_START = WM_USER; WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5; WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10; WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11; WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41; WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44; WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45; WM_CAP_GET_STATUS = WM_CAP_START + 54; WM_CAP_GRAB_FRAME = WM_CAP_START + 60; WM_CAP_STOP = WM_CAP_START + 68; WM_CAP_SET_PREVIEW = WM_CAP_START + 50; WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52; WM_CAP_SET_SCALE = WM_CAP_START + 53; WM_CAP_EDIT_COPY = WM_CAP_START + 30; WM_CAP_SET_CALLBACK_YIELD = WM_CAP_START + 4; WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6; WM_CAP_DLG_VIDEODISPLAY = WM_CAP_START + 43; ... // Устанавливаем параметры предпросмотра SendMessage(h_cam, WM_CAP_SET_SCALE, 1, 0); SendMessage(h_cam, WM_CAP_SET_PREVIEWRATE, 40, 0); SendMessage(h_cam, WM_CAP_SET_PREVIEW, 1, 0); SendMessage(h_cam, WM_CAP_SET_CALLBACK_FRAME, 0, Integer(@FrameCallback)); Последнее для простого рисования изображения на форме не нужно. После этого не понадобится даже таймер, а изображение будет автоматически рисоваться в окне камеры через каждые 40 миллисекунд (только далеко не все камеры поддерживают 25 кадров/сек, у моей например максимум 15) jmp $ ; Happy End! The Cake Is A Lie. Последний раз редактировалось Bargest, 12.01.2011 в 23:34. |
#13
|
|||
|
|||
Баг
Мне надо обрабатывать кадры с камеры несколько раз в секунду... если выставить в таймере (прога котурую выложыл moo2k) значение <100 то тут начинаютса баги:
1) Постепенное выделение оперативной памяти 2) Если потрясти окном программы то оно или зависнит, или выскочит ошибка Впринцыпе я думаю что ето баг самого DSPack, потому что если взять его родной пример PlayVideoCap и также бешено потрясти окном , то память также будет выделятса... Подскажыте что мне делать плиз, прога нужна срочно ЗЫ: Если что, извините за плохой руский |
#14
|
|||
|
|||
Кто-нибудь может дать уже скомпилированную программу?)
У меня ошибками всё засыпалось. Поделитесь, пожалуйста |