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;

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.