Показать сообщение отдельно
  #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.
Ответить с цитированием