dspack

Using Dspack grab a single image


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


Solution

  • 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