Dspack 2.3.1 - WebCam - SampleGrabber

[erich.wanker]

Hallo Leute,

ich hab ein kleines Problem:

Via dspack 2.3.1 greif ich auf einen Videostream einer Webcam zu.
Jetzt will ich(während das Video im TVideoWindow weiterläuft)
einen Snapshot vom Stream machen. Dafür wäre der SampleGrabber eigentlich gedacht.
Leider hab ich bis dato noch keine Möglichkeit gefunden - das zum laufen zu bringen.
(Screenshot oder Canvas abgreifen sind keine Optionen)

Delphi-Quellcode:

procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
    SampleGrabber1.GetBitmap(Image.Picture.Bitmap);
end;

procedure TMainForm.SampleGrabber1Buffer(sender: TObject;
  SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
begin

    Image.Canvas.Lock; // to avoid flickering
    try
    SampleGrabber1.GetBitmap(Image.Picture.Bitmap, pBuffer, BufferLen);
    Image.Picture.Bitmap.SaveToFile('c:\testbitmap.bmp');
    finally
    Image.Canvas.Unlock;
    end;

end;

beim SampleGrabber hab ich schon div. Einstellungen (Major Type,SubType,FormatType) ausgetestet - leider ohne Erfolg.

hat jemand eine Lösung (Webcam hat 2048x1536x24bit) ?

Vielen Dank

Erich

[lbccaleb]

Was genau "läuft" denn nicht??

Weil auf den ersten Blick konnte ich keinen Fehler finden!

Edit:
Hast du den Filtergraph auch mit dem SampleGrabber verbunden??

[erich.wanker]

>> Hast du den Filtergraph auch mit dem SampleGrabber verbunden??

ja, hab ich...

Das TVideoWindow zeigt den Stream (der TFilterGraph ist auf Mode "gmCapture" gesetzt)
Der TSampleGrabber ist mit dem TFilterGraph verbunden.

Wenn ich nun auf meinen Speedbutton klick und SampleGrabber1.GetBitmap(Image.Picture.Bitmap) ausführe passiert nix. Das Image bleibt leer und die Datei c:\testbitmap.bmp wird mit 0kb erstellt.

Hab 2 Webcams zum Testen:
Eine HP Basic Starter Camera: Major Type: Video - Sub Type RGB24 Format: VideoInfo RGB 320x240, 24bits
Eine NewImage SuperCam: Major Type: Video - Sub Type RGB24 Format: VideoInfo RGB 2048*1536, 24bits

habs schon auf einem anderen Gerät mit anderen Webcams und einem Notebook mit eingebauter Webcam versucht.. NIX!




Hier mal mein Code:

Delphi-Quellcode:

unit main;

interface

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

type
  TMainForm = class(TForm)
    CaptureGraph: TFilterGraph;
    VideoWindow: TVideoWindow;
    VideoCapFilters: TListBox;
    VideoSourceFilter: TFilter;
    StartButton: TButton;
    StatusBar: TStatusBar;
    Timer: TTimer;
    StopButton: TButton;
    AudioCapFilters: TListBox;
    AudioSourceFilter: TFilter;
    Label1: TLabel;
    VideoFormats: TListBox;
    AudioFormats: TListBox;
    Label3: TLabel;
    InputLines: TComboBox;
    Image: TImage;
    SpeedButton1: TSpeedButton;
    SampleGrabber1: TSampleGrabber;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure VideoCapFiltersClick(Sender: TObject);
    procedure StartButtonClick(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure AudioCapFiltersClick(Sender: TObject);
    procedure VideoWindowMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SampleGrabber1Buffer(sender: TObject; SampleTime: Double;
      pBuffer: Pointer; BufferLen: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  CapEnum: TSysDevEnum;
  VideoMediaTypes, AudioMediaTypes: TEnumMediaType;

implementation

{$R *.dfm}



procedure TMainForm.FormCreate(Sender: TObject);
var i: integer;
begin
  CapEnum := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  for i := 0 to CapEnum.CountFilters - 1 do
    VideoCapFilters.Items.Add(CapEnum.Filters[i].FriendlyName);

  CapEnum.SelectGUIDCategory(CLSID_AudioInputDeviceCategory);
  for i := 0 to CapEnum.CountFilters - 1 do
    AudioCapFilters.Items.Add(CapEnum.Filters[i].FriendlyName);

  VideoMediaTypes := TEnumMediaType.Create;
  AudioMediaTypes := TEnumMediaType.Create;
end;

// Fenster schließen
procedure TMainForm.FormDestroy(Sender: TObject);
begin
  CapEnum.Free;
  VideoMediaTypes.Free;
  AudioMediaTypes.Free;
end;

// Select the video Source
procedure TMainForm.VideoCapFiltersClick(Sender: TObject);
var
  PinList: TPinList;
  i: integer;
begin
  CapEnum.SelectGUIDCategory(CLSID_VideoInputDeviceCategory);
  if VideoCapFilters.ItemIndex <> -1 then
  begin
    VideoSourceFilter.BaseFilter.Moniker := CapEnum.GetMoniker(VideoCapFilters.ItemIndex);
    VideoSourceFilter.FilterGraph := CaptureGraph;
    CaptureGraph.Active := true;
    PinList := TPinList.Create(VideoSourceFilter as IBaseFilter);
    VideoFormats.Clear;
    VideoMediaTypes.Assign(PinList.First);
    for i := 0 to VideoMediaTypes.Count - 1 do
      VideoFormats.Items.Add(VideoMediaTypes.MediaDescription[i]);
    CaptureGraph.Active := false;
    PinList.Free;
    StartButton.Enabled := true;
  end;
end;

// Select the audio Source
procedure TMainForm.AudioCapFiltersClick(Sender: TObject);
var
  PinList: TPinList;
  i, LineIndex: integer;
  ABool: LongBool;
begin
  CapEnum.SelectGUIDCategory(CLSID_AudioInputDeviceCategory);
  if AudioCapFilters.ItemIndex <> -1 then
  begin
    AudioSourceFilter.BaseFilter.Moniker := CapEnum.GetMoniker(AudioCapFilters.ItemIndex);
    AudioSourceFilter.FilterGraph := CaptureGraph;
    CaptureGraph.Active := true;
    PinList := TPinList.Create(AudioSourceFilter as IBaseFilter);
    AudioFormats.Clear;
    i := 0;
    while i < PinList.Count do
      if PinList.PinInfo[i].dir = PINDIR_OUTPUT then
        begin
          AudioMediaTypes.Assign(PinList.Items[i]);
          PinList.Delete(i);
        end else inc(i);

    for i := 0 to AudioMediaTypes.Count - 1 do
    begin
      AudioFormats.Items.Add(AudioMediaTypes.MediaDescription[i]);
    end;

    CaptureGraph.Active := false;
    InputLines.Clear;
    LineIndex := -1;
    for i := 0 to PinList.Count - 1 do
    begin
      InputLines.Items.Add(PinList.PinInfo[i].achName);
      with (PinList.Items[i] as IAMAudioInputMixer) do get_Enable(ABool);
      if ABool then LineIndex := i;
    end;
    InputLines.ItemIndex := LineIndex;
    PinList.Free;
    StartButton.Enabled := true;
  end;
end;

// Start Capture
procedure TMainForm.StartButtonClick(Sender: TObject);
var
  multiplexer: IBaseFilter;
  Writer: IFileSinkFilter;
  PinList: TPinList;
  i: integer;
begin

  CaptureGraph.Active := true;

  if AudioSourceFilter.FilterGraph <> nil then
  begin
    PinList := TPinList.Create(AudioSourceFilter as IBaseFilter);
    i := 0;
    while i < PinList.Count do
      if PinList.PinInfo[i].dir = PINDIR_OUTPUT then
        begin
          if AudioFormats.ItemIndex <> -1 then
            with (PinList.Items[i] as IAMStreamConfig) do
              SetFormat(AudioMediaTypes.Items[AudioFormats.ItemIndex].AMMediaType^);
          PinList.Delete(i);
        end else inc(i);
    if InputLines.ItemIndex <> -1 then
      with (PinList.Items[InputLines.ItemIndex] as IAMAudioInputMixer) do
        put_Enable(true);
    PinList.Free;
  end;

  // configure output Video media type
  if VideoSourceFilter.FilterGraph <> nil then
  begin
    PinList := TPinList.Create(VideoSourceFilter as IBaseFilter);
    if VideoFormats.ItemIndex <> -1 then
      with (PinList.First as IAMStreamConfig) do
        SetFormat(VideoMediaTypes.Items[VideoFormats.ItemIndex].AMMediaType^);
    PinList.Free;
  end;


  with CaptureGraph as IcaptureGraphBuilder2 do
  begin

    if VideoSourceFilter.BaseFilter.DataLength > 0 then
      RenderStream(@PIN_CATEGORY_PREVIEW, nil, VideoSourceFilter as IBaseFilter,
        nil , VideoWindow as IBaseFilter);

  end;
 
  CaptureGraph.Play;
  StopButton.Enabled := true;
  StartButton.Enabled := false;
  AudioFormats.Enabled := false;
  AudioCapFilters.Enabled := false;
  VideoFormats.Enabled := false;
  VideoCapFilters.Enabled := false;
  Timer.Enabled := true;
end;




// Stop Capture
procedure TMainForm.StopButtonClick(Sender: TObject);
begin
  Timer.Enabled := false;
  StopButton.Enabled := false;
  StartButton.Enabled := true;
  CaptureGraph.Stop;
  CaptureGraph.Active := False;
  AudioFormats.Enabled := true;
  AudioCapFilters.Enabled := true;
  VideoFormats.Enabled := true;
  VideoCapFilters.Enabled := true;

end;

// Drag and Drop aktivieren
procedure TMainForm.VideoWindowMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
videowindow.BeginDrag(true);
end;


// test: aufs canvas von TVideoWindow zugreifen
procedure SaveCanvas(SaveCanvas: TCanvas; FileName: string);
var
  Bmp: TBitmap;
  MyRect: TRect;
begin
  Bmp:= TBitmap.Create;
  try
    MyRect := SaveCanvas.ClipRect;
    Bmp.Width := MyRect.Right - MyRect.Left;
    Bmp.Height := MyRect.Bottom - MyRect.Top;
    Bmp.Canvas.CopyRect(MyRect, SaveCanvas, MyRect);
    Bmp.SaveToFile(FileName);
  finally
    FreeAndNil(Bmp);
  end;
end;


// Bild holen
procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
    SampleGrabber1.GetBitmap(Image.Picture.Bitmap);
end;



// Wenn holen, dann speichern
procedure TMainForm.SampleGrabber1Buffer(sender: TObject;
  SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
begin

    Image.Canvas.Lock; // to avoid flickering
    try
    SampleGrabber1.GetBitmap(Image.Picture.Bitmap, pBuffer, BufferLen);
    Image.Picture.Bitmap.SaveToFile('c:\testbitmap.bmp');
    finally
    Image.Canvas.Unlock;
    end;

end;


// Ende Gelände
end.

[WSpreter]

Hallo Erich, auch wenn deine Frage schon etwas her ist, vielleicht hilft dir das:

Ergänze Zeile 190 um:

CheckDSError(RenderStream(@PIN_CATEGORY_Capture , nil, VideoSourceFilter as IBaseFilter, nil, SampleGrabber as IbaseFilter));

und ändere:

procedure TVideoForm.SampleGrabberBuffer(sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
Var BitMap:TBitMap;
begin
BitMap:=TBitMap.Create;
SampleGrabber.GetBitmap(Bitmap); // Geht nicht mit Buffer warum auch immer
Image1.Canvas.StretchDraw(Image1.Canvas.ClipRect,B itMap);
// oder natürlich auch BitMap.SaveToFile(....
BitMap.Free;
end;

probier dann nochmal.