Dspack 2.3.1 - WebCam - SampleGrabber

[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.