Using Dspack grab a single image - dspack

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