Using Dspack grab a single image

Question

How to use DSpack to grab a single image from a webcam?? Is it possible to use SampleGrabber? I am coding in delphi, I tryed every thing but unsuccessfully thanks for help

Answer 1

Link to project

unit frmCaptureU;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms,
  Dialogs, StdCtrls, DSPack, DSUtil, DirectShow9, ExtCtrls,Jpeg,Registry;

type
  TfrmCapture = class(TForm)
    SampleGrabber: TSampleGrabber;
    CaptureGraph: TFilterGraph;
    VideoSourceFilter: TFilter;
    VideoWindow: TVideoWindow;
    pnlBottom: TPanel;
    lblVideoSource: TLabel;
    lblVideoFormat: TLabel;
    btnStart: TButton;
    btnStopCamera: TButton;
    btnGrabImage: TButton;
    pnlVideo: TPanel;
    cbKeepAspectRatio: TCheckBox;
    cbxVideoFormats: TComboBox;
    cbxVideoSources: TComboBox;
    btnSaveSettings: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure cbxVideoSourcesClick(Sender: TObject);
    procedure btnGrabImageClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure btnStopCameraClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure cbKeepAspectRatioClick(Sender: TObject);
    procedure CaptureGraphGraphVideoSizeChanged(sender: TObject; Width, height: Word);
    procedure cbxVideoFormatsClick(Sender: TObject);
    procedure btnSaveSettingsClick(Sender: TObject);
  private
    CapEnum: TSysDevEnum;
    VideoMediaTypes : TEnumMediaType;
    theratio : Real;

    procedure LoadIni;
    procedure SaveIni;
    procedure StopCaptureGraph;
    procedure SetAspectRatio;
    procedure EnumerateVideoFormats;
    procedure StartCaptureGraph;
    { Private declarations }
  public
    procedure GrabAs(aFileName : String);
    { Public declarations }
  end;

const
  IniFileName = 'capture.ini';

var
  frmCapture: TfrmCapture;

implementation

{$R *.dfm}

{ TMainForm }

procedure TfrmCapture.CaptureGraphGraphVideoSizeChanged(sender: TObject; Width, height: Word);
//Just made this if you need to get the actual video size from the running graph.
begin
  Caption:=format('Image Grabber (H:%u W:%u)',[Height,Width]);
  theratio := width/height;
end;

procedure TfrmCapture.FormCreate(Sender: TObject);
var
  i: integer;
begin
  CapEnum:=TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  for i:=0 to CapEnum.CountFilters-1 do
    cbxVideoSources.Items.Add(CapEnum.Filters[i].FriendlyName);
  VideoMediaTypes:=TEnumMediaType.Create;
  LoadIni;
end;

procedure TfrmCapture.FormDestroy(Sender: TObject);
begin
  CapEnum.Free;
  VideoMediaTypes.Free;
end;

procedure TfrmCapture.FormResize(Sender: TObject);
begin
  if cbKeepAspectRatio.Checked then
    SetAspectRatio;
end;

procedure TfrmCapture.LoadIni;
Var
  Inifile : TRegIniFile;
begin
  Inifile:=TRegIniFile.Create(IniFileName);
  Try
    cbxVideoSources.ItemIndex:=IniFile.ReadInteger('Grabbing','VideoSource',-1);
    If cbxVideoSources.ItemIndex<>-1 Then
    Begin
      EnumerateVideoFormats;
      cbxVideoFormats.ItemIndex:=IniFile.ReadInteger('Grabbing','VideoFormat',-1);
      if cbxVideoFormats.ItemIndex<>-1 then
        StartCaptureGraph;
    End;
  Finally
    IniFile.Free;
  End;
end;

procedure TfrmCapture.cbxVideoSourcesClick(Sender: TObject);
begin
  if cbxVideoSources.ItemIndex<>-1 then
    EnumerateVideoFormats;
end;

procedure TfrmCapture.cbxVideoFormatsClick(Sender: TObject);
begin
  if (cbxVideoSources.ItemIndex<>-1) And (cbxVideoFormats.ItemIndex<>-1) then
  Begin
    btnStart.Enabled:=True;
    btnGrabImage.Enabled:=True;
  End;
end;

procedure TfrmCapture.btnGrabImageClick(Sender: TObject);
begin
  //GrabAs('C:\Test.jpg');
  Grabas('c:\database\test.jpg');
end;

procedure TfrmCapture.btnSaveSettingsClick(Sender: TObject);
begin
  SaveIni;
end;

procedure TfrmCapture.btnStartClick(Sender: TObject);
begin
  StartCaptureGraph;
end;

procedure TfrmCapture.btnStopCameraClick(Sender: TObject);
begin
  StopCaptureGraph;
end;

procedure TfrmCapture.cbKeepAspectRatioClick(Sender: TObject);
begin
  if cbKeepAspectRatio.Checked then
  Begin
    VideoWindow.Align:=alNone;
    SetAspectRatio;
  End
  Else
    VideoWindow.Align:=alClient;
end;

procedure TfrmCapture.SetAspectRatio;
// Hold Aspect ratio 4:3 og centrér video display
// Den fil der bliver gemt vil altid have det korrekte aspect ratio (størrelsen på det faktiske video-format)
begin
  if (pnlVideo.Width>pnlVideo.Height * theratio) then
  begin
    VideoWindow.Height:=pnlvideo.Height;
    VideoWindow.Width:=Round(pnlvideo.Height * theratio);
    VideoWindow.Left:=pnlVideo.Width div 2 - VideoWindow.Width div 2;
  end
  else
  begin
    VideoWindow.Height:=Round(pnlVideo.Width / theratio);
    VideoWindow.Width:=pnlVideo.Width;
    VideoWindow.Top:=pnlVideo.Height div 2 - VideoWindow.Height div 2;
  end;
end;

procedure TfrmCapture.GrabAs(aFileName : String);
// Antager et validt filnavn, og at Capturegraph kører.
var
  aJpg: TJPEGImage;
  aImage: TImage;
begin
  aImage:=TImage.Create(self);
  try
    SampleGrabber.GetBitmap(aImage.Picture.Bitmap);
    aJpg:=TJpegImage.Create;
    try
      aJpg.Assign(aImage.Picture.Bitmap);
      aJpg.SaveToFile(ChangeFileExt(aFileName,'.jpg'));
    finally
      aJpg.Free;
    end;
  finally
    aImage.Free;
  end;
end;

procedure TfrmCapture.StartCaptureGraph;
var
  VideoFormatIndex: Integer;
  PinList: TPinList;
begin
  try
    // Aktivér Capturegraph før vi kan ændre noget
    CaptureGraph.Active:=true;
    // Konfigurér video formatet
    if VideoSourceFilter.FilterGraph<>nil then
    begin
      PinList := TPinList.Create(VideoSourceFilter as IBaseFilter);
      try
        if cbxVideoFormats.ItemIndex<>-1 then
        begin
          VideoFormatIndex:=Integer(cbxVideoFormats.Items.Objects[cbxVideoFormats.ItemIndex]);
          (PinList.First as IAMStreamConfig).SetFormat(VideoMediaTypes.Items[VideoFormatIndex].AMMediaType^);
        end;
      finally
        PinList.Free;
      end;
    end;
    // Set Renderingssvejene
    // - Der er een for videosource.preview til videovinduet
    // - og een for videosource.capture til samplegrabberen som vi får bitmappen fra.
    with CaptureGraph as IcaptureGraphBuilder2 do
    begin
      // Forbind Video preview (VideoSource Preview -> VideoWindow)
      if VideoSourceFilter.BaseFilter.DataLength>0 then
        RenderStream(@PIN_CATEGORY_PREVIEW, nil, VideoSourceFilter as IBaseFilter, nil, VideoWindow as IBaseFilter);
      // Forbind Video capture streams  (VideoSource Capture -> SampleGrabber)
      if VideoSourceFilter.FilterGraph<>nil then
        RenderStream(@PIN_CATEGORY_CAPTURE, nil, VideoSourceFilter as IBaseFilter, nil, SampleGrabber as IBaseFilter);
    end;
    //Start Capturegraph (renderer live video stream)
    CaptureGraph.Play;
    btnStart.Enabled:=False;
    btnStopCamera.Enabled:=True;
    btnGrabImage.Enabled:=True;
    cbxVideoFormats.Enabled:=False;
    cbxVideoSources.Enabled:=False;
  except
    MessageDlg('Could not initialize camera.' +#13#10+ 'Please make sure that it is connected and the proper drivers are installed.', mtError, [mbOK], 0);
  end;
end;

procedure TfrmCapture.EnumerateVideoFormats;
var
  PinList: TPinList;
  i: Integer;
begin
  cbxVideoFormats.Clear;
  CapEnum.SelectGUIDCategory(CLSID_VideoInputDeviceCategory);
  VideoSourceFilter.BaseFilter.Moniker:=CapEnum.GetMoniker(cbxVideoSources.ItemIndex);
  VideoSourceFilter.FilterGraph:=CaptureGraph;
  CaptureGraph.Active:=true;
  PinList:=TPinList.Create(VideoSourceFilter as IBaseFilter);
  try
    VideoMediaTypes.Assign(PinList.First);
    for i:=0 to VideoMediaTypes.Count-1 do
    begin
      // Brug kun VideoInfo headers, da vi ikke bruger Overlay Mixeren.
      if Pos('VideoInfo2', VideoMediaTypes.MediaDescription[i])=0 then
        cbxVideoFormats.Items.AddObject(VideoMediaTypes.MediaDescription[i], TObject(I));
    end;
    CaptureGraph.Active:=false;
  finally
    PinList.Free;
  end;
end;

procedure TfrmCapture.SaveIni;
Var
  Inifile : TRegIniFile;
begin
  Inifile:=TRegIniFile.Create(IniFileName);
  Try
    IniFile.WriteInteger('Grabbing','VideoSource',cbxVideoSources.ItemIndex);
    IniFile.WriteInteger('Grabbing','VideoFormat',cbxVideoFormats.ItemIndex);
  Finally
    IniFile.Free;
  End;
end;

procedure TfrmCapture.StopCaptureGraph;
begin
  btnStart.Enabled:=True;
  btnStopCamera.Enabled:=False;
  btnGrabImage.Enabled:=False;
  cbxVideoFormats.Enabled:=True;
  cbxVideoSources.Enabled:=True;
  CaptureGraph.Stop;
  CaptureGraph.Active:=False;
end;

end. here