Implementation

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 FilterGraphasICaptureGraphBuilder2 do

RenderStream(@PIN_CATEGORY_PREVIEW,nil,Filter1asIBaseFilter,SampleGrabber1asIBaseFilter,VideoWindow1asIbaseFilter);

//Производим вывод изображения

FilterGraph.Play;

end;

procedure TForm1.Button1Click(Sender:TObject);

begin

SampleGrabber1.GetBitmap(Image1.Picture.Bitmap);

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.Button3Click(Sender:TObject);

var

//i-координата пикселя по горизонтали

i:integer;

//j-координата пикселя по вертикали

j:integer;

//Количество различий

k:integer;

begin

SampleGrabber1.GetBitmap(Image2.Picture.Bitmap);

k:=0;

//Если картинки разные по размеру, то смысла сравнивать нет,

//поэтому осуществляем выход

if (Image1.Picture.Bitmap.Width<>Image2.Picture.Bitmap.Width)

or (Image1.Picture.Bitmap.Height<>Image2.Picture.Bitmap.Height)

then

begin

ShowMessage(‘Картинки разные по размерам! Сравнение невозможно!');

exit;

end;

//Начинаем попиксельное сравнение

For i:=1 to Image1.Picture.Bitmap.Height do

begin

for j:=1 to Image1.Pictur e.Bitmap.Width do

begin

//Сравниваем пиксели обеих картинок между собой

Ifnot(Image1.Picture.Bitmap.Canvas.Pixels[i,j]=Image2.Picture.Bitmap.Canvas.Pixels[i,j])

Then k:=k+1;

//Даем поработать и другим программам

Application.ProcessMessages;

end;

end;

//Если различий нет то сообщаем об этом

If k=0 then ShowMessage(‘Картинки абсолютно идентичны’);

end;

procedure TForm1.Button4Click(Sender:TObject);

var

K,S:integer;

r,g,b:Byte;

Color:TColor;

begin

r:=GetRValue(K);

g:=GetGValue(K);

b:=GetBValue(K);

r:=GetRValue(S);

g:=GetGValue(S);

b:=GetBValue(S);

end;

procedure TForm1.Button5Click(Sender:TObject);

var

//i-координата пикселя по горизонтали

i:integer;

//j-координата пикселя по вертикали

j:integer;

//Количество различий

k:integer;

o:integer;

r,g,b:Byte;

Color:TColor;

S:integer;

begin

Image1.Picture.Bitmap.Monochrome:=true;

SampleGrabber1.GetBitmap(Image1.Picture.Bitmap);

exit;

//Количество различий

For i:=1 to Image1.Picture.Bitmap.Height do

For j:=1 to Image1.Picture.Bitmap.Width do

begin

K:=Image1.Picture.Bitmap.Canvas.Pixels[i,j];

r:=GetRValue(K);

g:=GetGValue(K);

b:=GetBValue(K);

b:=r;g:=r;

K:=RGB(r,g,b);

end;

end;

procedure TForm1.CheckBox1Click(Sender:TObject);

begin

if CheckBox1.CheckedthenTimer1.Enabled:=true

else Timer1.Enabled:=false;

end;

procedure TForm1.Timer1Timer(Sender:TObject);

var

//i-координата пикселя по горизонтали

i:integer;

//j-координата пикселя по вертикали

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;

//Если картинки разные по размеру, то смысла сравнивать нет,

//поэтому осуществляем выход

if(Image1.Picture.Bitmap.Width<>Image2.Picture.Bitmap.Width)

or

(Image1.Picture.Bitmap.Height<>Image2.Picture.Bitmap.Height)

then

begin

//Картинки разные по размерам! Сравнение невозможно!'

exit;

end;

//Начинаем попиксельное сравнение

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];

//Получаем составляющие RGB

r1:=GetRValue(FirstColor);

g1:=GetGValue(FirstColor);

b1:=GetBValue(FirstColor);

//Получаем цвет текущего пикселя второй картинки SecondColor:=Image2.Picture.Bitmap.Canvas.Pixels[i,j];

//Получаем составляющие RGB

r2:=GetRValue(SecondColor);

g2:=GetGValue(SecondColor);

b2:=GetBValue(SecondColor);

//Получаем составляющие RGB

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)+(‘зафиксированы изменения попериметру');

//Если изменений больше 2000 (значение получено экспериментальным путем) Image2.Picture.Bitmap.SaveToFile('log\'+FormatDateTime('hhnnss',Now)+'.jpeg');

If CheckBox2.Checked=true then

begin

MediaPlayer1.FileName:='C:\shvv\SIGNAL.wav';

MediaPlayer1.Open;

MediaPlayer1.Play;

end

else MediaPlayer1.Stop;

end;

end;

end.