KasperTech

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DSUtil, StdCtrls, DSPack, DirectShow9, Menus, ExtCtrls;

type
  TForm1 = class(TForm)
    FilterGraph1: TFilterGraph;
    VideoWindow1: TVideoWindow;
    Filter1: TFilter;
    SampleGrabber1: TSampleGrabber;
    Button1: TButton;
    ListBox1: TListBox;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SampleGrabber1Buffer(sender: TObject; SampleTime: Double;
      pBuffer: Pointer; BufferLen: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  SysDev: TSysDevEnum;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  FilterGraph1.ClearGraph;
  FilterGraph1.Active := false;
  Filter1.BaseFilter.Moniker := SysDev.GetMoniker(ListBox1.Tag);
  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;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  SysDev:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  if SysDev.CountFilters > 0 then
    for i := 0 to SysDev.CountFilters - 1 do
    begin
      ListBox1.Items.Add(SysDev.Filters[i].FriendlyName);
      ListBox1.Tag := i;
    end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SysDev.Free;
  FilterGraph1.ClearGraph;
  FilterGraph1.Active := false;
end;

procedure TForm1.SampleGrabber1Buffer(sender: TObject; SampleTime: Double;
  pBuffer: Pointer; BufferLen: Integer);
begin
 Image1.Canvas.Lock;
  try
    SampleGrabber1.GetBitmap(Image1.Picture.Bitmap, pBuffer, BufferLen);
  finally
    Image1.Canvas.Unlock;
end;
end;

end.