09.02.2008, 15:21
|
Прохожий
|
|
Регистрация: 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.
|