如何使用DSPack和Delphi 5从网络摄像头捕获并保存到文件

时间:2013-08-27 07:28:05

标签: delphi webcam directshow delphi-5 dspack

现在我正在尝试使用Delphi 5从网络摄像头拍摄照片。 我正在使用delphi 5和DSPack 2.3.1,因为很多人都建议使用它,是的,这是我第一次使用delphi编程多媒体。

我已经能够列出并添加动态连接到我的电脑的相机。我还能够显示网络摄像头“看到”,打开视频并捕获它。 但现在我无法从网络摄像头拍摄照片。

我有一个名为“Image”的TImage,用于检查是否捕获了图片。当我使用我的代码打开视频并捕获它时,它会显示在TImage中。但是当我尝试捕捉网络摄像头时,它只是空白而没有捕获任何东西。我保存的文件也是空白的。

有人可以检查我的代码哪个部分出错了吗? 谢谢你......

这是我的代码的一部分

var SysDev: TSysDevEnum;
    FotoBitmap: TBitmap;

implementation

{$R *.DFM}

procedure Form1.FormCreate(Sender: TObject);
var
  i: integer;
  Device: TMenuItem;
begin
  SysDev:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  if SysDev.CountFilters > 0 then
    for i := 0 to SysDev.CountFilters - 1 do
    begin
      Device := TMenuItem.Create(Devices);
      Device.Caption := SysDev.Filters[i].FriendlyName;
      Device.Tag := i;
      Device.OnClick := OnSelectDevice;
      Devices.Add(Device);
    end;
end;

procedure Form1.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  SysDev.Free;
  FilterGraph.ClearGraph;
  FilterGraph.Active := false;
end;

procedureForm1.OnSelectDevice(sender: TObject);
var
  CaptureGraph: ICaptureGraphBuilder2;
  SourceFilter, DestFilter: IBaseFilter;
begin
  FilterGraph.ClearGraph;
  FilterGraph.Active := false;

  Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
  Filter.FilterGraph := FilterGraph;

  FilterGraph.Active := true;

  FilterGraph.QueryInterface(ICaptureGraphBuilder2, CaptureGraph);

  Filter.QueryInterface(IBaseFilter, SourceFilter);

  VideoWindow.QueryInterface(IBaseFilter, DestFilter);

  if Filter.BaseFilter.DataLength > 0 then
    CaptureGraph.RenderStream(nil, nil, SourceFilter, nil, DestFilter);

  FilterGraph.Play;
  CaptureGraph := nil;
  SourceFilter := nil;
  DestFilter   := nil;
end;

procedure Form1.SnapshotClick(Sender: TObject);
var dir : String;
begin
  if edt_nama_foto.Text <> '' then begin
    dir := ExtractFilePath(Application.ExeName);
    FotoBitmap := TBitmap.Create;

    try
      SampleGrabber.GetBitmap(FotoBitmap);
      SampleGrabber.GetBitmap(Image.Picture.Bitmap);
      showmessage(dir + 'Image\Foto\' + edt_nama_foto.Text + '.bmp');
      FotoBitmap.SaveToFile(dir + 'Image\Foto\' + edt_nama_foto.Text + '.bmp');
    finally
      FotoBitmap.Free;
    end;
  end;
end;

procedure Form1.btn_batalClick(Sender: TObject);
begin
  modalresult:=mrCancel;
end;

procedure Form1.btn_simpanClick(Sender: TObject);
begin
  If CheckbeforeOK then
  begin
    ModalResult :=mrOK;
  end else begin
    ModalResult := mrNone;
  end;
end;

function Form1.CheckbeforeOK:Boolean;
var flag:boolean;
    MasterDataSet:TQuery;
begin
  Flag:=True;

  if flag and not(checkedit(nil, nil, edt_nama_foto, edt_nama_foto.Text, 'Nama Foto'))
  then begin
    flag := False;
  end else begin
    Snapshot.Click;
  end;
  Result := flag;
end;

procedure Form1.SampleGrabberBuffer(sender: TObject;
  SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
begin
  Image.Picture.Bitmap.Canvas.Lock;
  try
    SampleGrabber.GetBitmap(Image.Picture.Bitmap, pBuffer, BufferLen);
  finally
    Image.Picture.Bitmap.Canvas.UnLock;
  end;
end;

end.

1 个答案:

答案 0 :(得分:0)

将视频帧“传输”到图像对象的对象是SampleGrabber

  

SampleGrabber.GetBitmap(Image.Picture.Bitmap,pBuffer,BufferLen);

然而,在构建它时需要将其插入到过滤器图形中,而您显然没有在OnSelectDevice中执行此操作:根本没有提到SampleGrabber。您需要将其包含在RenderStream调用中,或者将其插入其中,以便视频通过它进行流式处理,并将您的回调称为将数据复制到TImage