使用DirectShow开发视频采集程序

{******************************************************************
* original by Microsoft
*
* CDSCapture class
*
* uses DirectShow and Windows Media + Vfw to capture from Hardware
*
* written by orthkon * www.mp3.com/orthkon * orthkon@mail.com
******************************************************************}

unit DSCapture;

interface

uses Windows, DirectShow, ActiveX, DirectSound, Dialogs;

const
  IID_IPropertyBag : TGUID = '{55272A00-42CB-11CE-8135-00AA004BB851}';
  WM_FGNOTIFY = $0400 + 1;

type
   PVIDEOINFOHEADER = ^TVIDEOINFOHEADER;
   TVIDEOINFOHEADER = record
    rcSource : TRECT;
    rcTarget : TRECT;
    dwBitRate : Cardinal;         // 波特率
    dwBitErrorRate : Cardinal;    // 误码率
    AvgTimePerFrame : Int64;   // 帧平均速度(100ns units)
    bmiHeader : BITMAPINFOHEADER;
  end;
  TCapDeviceInfo = record
    szName : String;
    moniker : IMoniker;
  end;
      CDSCapture = class
  public
    constructor Create( handle : HWND );
    destructor Destroy; override;
    function Init : Boolean;
    function EnumVideoDevices : String;
    function EnumAudioDevices : String;
    procedure ChooseDevices( szVideo, szAudio : String ); overload;
  private
    procedure CleanUp;
    procedure BuildDeviceList;
    procedure ChooseDevices( nmVideo, nmAudio : IMoniker ); overload;
    function MakeBuilder : Boolean;
    function MakeGraph : Boolean;
    function InitCapFilters : Boolean;
    function ErrMsg( szMsg : String; hr : HRESULT = 0 ) : Boolean;
    procedure ResizeWindow( w, h : Integer );
    procedure FreeCapFilters;
    procedure NukeDownstream( pf : IBaseFilter );
    procedure TearDownGraph;
    function BuildPreviewGraph : Boolean;
    function StartPreview : Boolean;
    function StopPreview : Boolean;
  end;

implementation

var
  Graph : IGraphBuilder;
  Builder : ICaptureGraphBuilder2;
  VideoWindow : IVideoWindow;
  MediaEvent : IMediaEventEx;
  DroppedFrames : IAMDroppedFrames;
  VideoCompression : IAMVideoCompression;
  CaptureDialogs : IAMVfwCaptureDialogs;
  AStreamConf : IAMStreamConfig;      // for audio cap
  VStreamConf : IAMStreamConfig;      // for video cap
  Render : IBaseFilter;
  VCap : IBaseFilter;
  ACap : IBaseFilter;
  Sink : IFileSinkFilter;
  ConfigAviMux : IConfigAviMux;
  wachFriendlyName : String;
  fCapAudioIsRelevant : Boolean = False;
  fCapAudio : Boolean = False;
  fCCAvail : Boolean = False;
  fCapCC : Boolean = False;
  fCaptureGraphBuilt : Boolean = False;
  fPreviewGraphBuilt : Boolean = False;
  fPreviewFaked : Boolean = False;
  fCapturing : Boolean = False;
  fPreviewing : Boolean = False;
  fUseFrameRate : Boolean = False;
  fWantPreview : Boolean = True;
  FrameRate : double = 15;
  hwOwner : HWND;
  VideoDevices : array of TCapDeviceInfo;
  AudioDevices : array of TCapDeviceInfo;
  NumVD : Word = 0;    // 视频设备
  NumAD : Word = 0;    // 音频设备
  EnumVD : Word = 0;  // 当前视频设备
  EnumAD : Word = 0;  // 当前音频设备
  mVideo, mAudio : IMoniker;
  gnRecurse : Integer;

function CheckGUID( p1, p2 : TGUID ) : Boolean;
var
  i : Byte;
begin
  Result := False;
  for i := 0 to 7 do if p1.D4[i] <> p2.D4[i] then Exit;
  Result := ( p1.D1 = p2.D1 ) and ( p1.D2 = p2.D2 ) and ( p1.D3 = p2.D3 );
end;

//  释放媒体类 (例如释放资源)
procedure FreeMediaType( mt : TAM_MEDIA_TYPE );
begin
  if mt.cbFormat <> 0 then begin
    CoTaskMemFree( mt.pbFormat );
    // Strictly unnecessary but tidier
    mt.cbFormat := 0;
    mt.pbFormat := nil;
  end;
  mt.pUnk := nil;
end;

procedure DeleteMediaType( pmt : PAM_MEDIA_TYPE );
begin
  // 允许NULL
  if pmt = nil then Exit;
  FreeMediaType( pmt^ );
  CoTaskMemFree( pmt );
end;

// 创建采集
function CDSCapture.MakeBuilder : Boolean;
begin
  Result := True;
  if Builder <> nil then Exit;
  if CoCreateInstance( CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC,
        IID_ICaptureGraphBuilder2, Builder ) <> NOERROR then Result := False;
end;

// 创建graph 
function CDSCapture.MakeGraph : Boolean;
begin
  Result := True;
  if Graph <> nil then Exit;
  if CoCreateInstance( CLSID_FilterGraph, nil, CLSCTX_INPROC,
			       IID_IGraphBuilder, Graph ) <> NOERROR then Result := False;
end;

function CDSCapture.InitCapFilters : Boolean;
label
  InitCapFiltersFail,
  SkipAudio;
var
  PropBag : IPropertyBag;
  hr : HRESULT;
  varOle : OleVariant;
  //tmt : TAM_MEDIA_TYPE;
  pmt : PAM_MEDIA_TYPE;
  pvih : PVIDEOINFOHEADER;
  Pin : IPin;
  pins : IEnumPins;
  n : Cardinal;
  pinInfo : TPIN_INFO;
  Found : Boolean;
	Ks : IKsPropertySet;
	guid : TGUID;
	dw : DWORD;
	fMatch : Boolean;
begin
  hr := 0;
  Result := MakeBuilder;
  if Result = False then begin
    ErrMsg( 'Cannot instantiate graph builder' );
    Exit;
  end;
  VCap := nil;
  if mVideo <> nil then begin
    hr := mVideo.BindToStorage( nil, nil, IID_IPropertyBag, PropBag );
    if Succeeded( hr ) then begin
      PropBag.Read( 'FriendlyName', varOle, nil );
      if hr = NOERROR then wachFriendlyName := varOle;
      PropBag := nil;
    end;
    hr := mVideo.BindToObject( nil, nil, IID_IBaseFilter, VCap );
  end;
  if VCap = nil then begin
   ErrMsg( 'Error %x: Cannot create video capture filter', hr );
   goto InitCapFiltersFail;
  end;
  //
  // 创建filtergraph, 付给构造对象连接视频
  // 采集Filter
  //
  Result := MakeGraph;
  if Result = False then begin
    ErrMsg( 'Cannot instantiate filtergraph' );
    goto InitCapFiltersFail;
  end;
  hr := Builder.SetFiltergraph( Graph );
  if hr <> NOERROR then begin
   ErrMsg( 'Cannot give graph to builder' );
	  goto InitCapFiltersFail;
  end;
  hr := Graph.AddFilter( VCap, nil );
  if hr <> NOERROR then begin
   ErrMsg( 'Error %x: Cannot add vidcap to filtergraph', hr );
	  goto InitCapFiltersFail;
  end;
  // 调用FindInterface，确定流的源(如WDM TVTuners或Crossbars)
  // 用于得到驱动程序名称，端口连接前此界面可能无效
  //或根本无法调用
  hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Interleaved,
		    VCap, @IID_IAMVideoCompression, VideoCompression );
  if hr <> S_OK then begin
    Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video,
		    VCap, @IID_IAMVideoCompression, VideoCompression );
  end;
   // 设置帧速率和采集尺寸
  hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Interleaved,
			VCap, @IID_IAMStreamConfig, VStreamConf );
  if hr <> NOERROR then begin
    hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video,
        VCap,	@IID_IAMStreamConfig, VStreamConf );
    if hr <> NOERROR then begin
	    // this means we can't set frame rate (non-DV only)
	    ErrMsg( 'Error %x: Cannot find VCapture:IAMStreamConfig', hr );
   end;
  end;
  fCapAudioIsRelevant := True;
  // 缺省采集格式
  if ( VStreamConf <> nil ) and ( VStreamConf.GetFormat( pmt ) = S_OK ) then begin
    // DV capture 不使用VIDEOINFOHEADER
   if CheckGUID( pmt^.formattype, FORMAT_VideoInfo ) then begin
      // 窗口大小调整
      gnRecurse := 0;
      pvih := pmt.pbFormat;
      ResizeWindow( pvih^.bmiHeader.biWidth, abs( pvih^.bmiHeader.biHeight ) );
	  end;
	  if not CheckGUID( pmt^.majortype, MEDIATYPE_Video ) then begin
	    // 此采集filter 采集其他视频.
      fCapAudioIsRelevant := False;
      fCapAudio := False;
	  end;
    DeleteMediaType( pmt );
  end;
  // 显示对话框
  // NOTE:  仅VFW支持
  Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video,
    VCap, @IID_IAMVfwCaptureDialogs, CaptureDialogs );
  Found := False;
  fMatch := False;
  Pin := nil;
  if Succeeded( VCap.EnumPins( pins ) ) then begin
    while not Found and ( S_OK = pins.Next( 1, pin, n ) ) do begin
      if S_OK = pin.QueryPinInfo( pinInfo ) then begin
        if pinInfo.dir = PINDIR_INPUT then begin
			    // ANALOGVIDEOIN input pin?
       if pin.QueryInterface( IID_IKsPropertySet, Ks ) = S_OK then begin
         if Ks.Get( AMPROPSETID_Pin, 0, nil, 0,
         @guid, sizeof( TGUID ), dw ) = S_OK then begin
          if CheckGuid( guid, PIN_CATEGORY_ANALOGVIDEOIN ) then fMatch := True;
            end;
			      Ks := nil;
       end;
       if fMatch then begin
            Found := TRUE;
       end;
        end;
        pinInfo.pFilter := nil;
      end;
      pin := nil;
    end;
    pins := nil;
  end;
  // there's no point making an audio capture filter
  if fCapAudioIsRelevant = False then	goto SkipAudio;
  // 创建音频采集filter, 尽管可能用不到
  if mAudio = nil then begin
   // 不采集音频
	  fCapAudio := FALSE;
	  goto SkipAudio;
  end;
  ACap := nil;
  mAudio.BindToObject( nil, nil, IID_IBaseFilter, ACap );
  if ACap = nil then begin
   // 不采集音频

	  fCapAudio := FALSE;
	  ErrMsg( 'Cannot create audio capture filter' );
	  goto SkipAudio;
  end;
  //
  // 放置音频插件
  //
  hr := Graph.AddFilter( ACap, nil );
  if hr <> NOERROR then begin
    ErrMsg( 'Error %x: Cannot add audcap to filtergraph', hr );
    goto InitCapFiltersFail;
  end;
  // Calling FindInterface below will result in building the upstream
  // section of the capture graph (any WDM TVAudio's or Crossbars we might
  // need).
  // !!! What if this interface isn't supported?
  // we use this interface to set the captured wave format
  hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Audio,
			ACap, @IID_IAMStreamConfig, AStreamConf );
  if hr <> NOERROR then begin
    ErrMsg( 'Cannot find ACapture:IAMStreamConfig' );
  end;

SkipAudio:
  // Can this filter do closed captioning?
  FillChar( guid, SizeOf( TGUID ), 0 );
  hr := Builder.FindPin( VCap, PINDIR_OUTPUT, @PIN_CATEGORY_VBI, nil, FALSE, 0, Pin);
  if hr <> S_OK then hr := Builder.FindPin( VCap, PINDIR_OUTPUT, @PIN_CATEGORY_CC,	nil, FALSE, 0, Pin );
  if hr = S_OK then begin
   Pin := nil;
   fCCAvail := TRUE;
  end else fCapCC := FALSE;	// can't capture it, then
  // potential debug output - what the graph looks like
  // DumpGraph(gcap.pFg, 1);
  Result := TRUE;
  Exit;

InitCapFiltersFail:
  FreeCapFilters;
  Result := False;
  Exit;
end;

// build the preview graph!
//
// !!! PLEASE NOTE !!!  Some new WDM devices have totally separate capture
// and preview settings.  An application that wishes to preview and then 
// capture may have to set the preview pin format using IAMStreamConfig on the
// preview pin, and then again on the capture pin to capture with that format.
// In this sample app, there is a separate page to set the settings on the 
// capture pin and one for the preview pin.  To avoid the user
// having to enter the same settings in 2 dialog boxes, an app can have its own
// UI for choosing a format (the possible formats can be enumerated using
// IAMStreamConfig) and then the app can programmatically call IAMStreamConfig
// to set the format on both pins.
//
function CDSCapture.BuildPreviewGraph : Boolean;
var
  cy, cyBorder : Integer;
  hr : HRESULT;
  pmt : PAM_MEDIA_TYPE;
  rc : TRect;
  pvih : PVIDEOINFOHEADER;
begin
  // we have one already
  if fPreviewGraphBuilt then begin
    Result := True;
    Exit;
  end;
	Result := False;
  // No rebuilding while we're running
  if fCapturing or fPreviewing then Exit;
  // We don't have the necessary capture filters
  if VCap = nil then Exit;
  if ( ACap = nil ) and fCapAudio then Exit;
  // we already have another graph built... tear down the old one
  if fCaptureGraphBuilt then TearDownGraph;
  //
  // Render the preview pin - even if there is not preview pin, the capture
  // graph builder will use a smart tee filter and provide a preview.
  //
  // !!! what about latency/buffer issues?
  // NOTE that we try to render the interleaved pin before the video pin, because
  // if BOTH exist, it's a DV filter and the only way to get the audio is to use
  // the interleaved pin.  Using the Video pin on a DV filter is only useful if
  // you don't want the audio.
  hr := Builder.RenderStream( @PIN_CATEGORY_PREVIEW, @MEDIATYPE_Interleaved, VCap, nil, nil );
  if hr = VFW_S_NOPREVIEWPIN then begin
   // preview was faked up for us using the (only) capture pin
	  fPreviewFaked := TRUE;
  end else if hr <> S_OK then begin
   // maybe it's DV?
    hr := Builder.RenderStream( @PIN_CATEGORY_PREVIEW, @MEDIATYPE_Video, VCap, nil, nil );
    if hr = VFW_S_NOPREVIEWPIN then begin
	    // preview was faked up for us using the (only) capture pin
	    fPreviewFaked := TRUE;
    end else if hr <> S_OK then begin
	    ErrMsg( 'This graph cannot preview!' );
    end;
  end;
  //
  // Render the closed captioning pin? It could be a CC or a VBI category pin,
  // depending on the capture driver
  //
  if fCapCC then begin
   hr := Builder.RenderStream( @PIN_CATEGORY_CC, nil, VCap, nil, nil );
	  if hr <> NOERROR then begin
      hr := Builder.RenderStream( @PIN_CATEGORY_VBI, nil, VCap, nil, nil );
	    if hr <> NOERROR then begin
        ErrMsg( 'Cannot render closed captioning' );
        // so what? goto SetupCaptureFail;
      end;
    end;
  end;
  //
  // Get the preview window to be a child of our app's window
  //
  // This will find the IVideoWindow interface on the renderer.  It is
  // important to ask the filtergraph for this interface... do NOT use
  // ICaptureGraphBuilder2::FindInterface, because the filtergraph needs to
  // know we own the window so it can give us display changed messages, etc.
  hr := Graph.QueryInterface( IID_IVideoWindow, VideoWindow );
  if hr <> NOERROR then begin
   ErrMsg( 'This graph cannot preview properly' );
  end else begin
	  VideoWindow.put_Owner( hwOwner );    // We own the window now
   VideoWindow.put_WindowStyle( WS_CHILD );    // you are now a child
	  // give the preview window all our space but where the status bar is
   GetClientRect( hwOwner, rc );
	  cyBorder := GetSystemMetrics( SM_CYBORDER );
   cy := cyBorder;// + statusGetHeight();
	  rc.bottom := rc.bottom - cy;
   VideoWindow.SetWindowPosition( 0, 0, rc.right, rc.bottom ); // be this big
	  VideoWindow.put_Visible( TRUE );
  end;
  // now tell it what frame rate to capture at.  Just find the format it
  // is capturing with, and leave everything alone but change the frame rate
  // No big deal if it fails.  It's just for preview
  // !!! Should we then talk to the preview pin?
  if ( VStreamConf <> nil ) and fUseFrameRate then begin
   hr := VStreamConf.GetFormat( pmt );
	  // DV capture does not use a VIDEOINFOHEADER
    if hr = NOERROR then begin
      if CheckGuid( pmt^.formattype, FORMAT_VideoInfo ) then begin
        pvih := pmt^.pbFormat;
       pvih^.AvgTimePerFrame := round( 10000000 / FrameRate );
	      hr := VStreamConf.SetFormat( pmt^ );
		    if hr <> NOERROR then ErrMsg( '%x: Cannot set frame rate for preview', hr );
      end;
      DeleteMediaType( pmt );
   end;
  end;
  // make sure we process events while we're previewing!
  hr := Graph.QueryInterface( IID_IMediaEventEx, MediaEvent );
  if hr = NOERROR then begin
    MediaEvent.SetNotifyWindow( hwOwner, WM_FGNOTIFY, 0 );
  end;
  // All done.
  // potential debug output - what the graph looks like
  // DumpGraph(gcap.pFg, 1);
  fPreviewGraphBuilt := TRUE;
  Result := True;
end;

// Start previewing
//
function CDSCapture.StartPreview : Boolean;
var
  MC : IMediaControl;
  hr : HRESULT;
begin
  // way ahead of you
  if fPreviewing then begin
    Result := True;
    Exit;
  end;
  Result := False;
  if not fPreviewGraphBuilt then Exit;
  // run the graph
  hr := Graph.QueryInterface( IID_IMediaControl, MC );
  if Succeeded( hr ) then begin
   hr := MC.Run;
	  if FAILED( hr ) then begin
	    // stop parts that ran
	    MC.Stop;
   end;
	  MC := nil;
  end;
  if FAILED( hr ) then begin
	  ErrMsg( 'Error %x: Cannot run preview graph', hr );
	  Exit;
  end;
  fPreviewing := TRUE;
  Result := True;
end;


// stop the preview graph
//
function CDSCapture.StopPreview : Boolean;
var
  MC : IMediaControl;
  hr : HRESULT;
begin
  Result := False;
  // way ahead of you
  if not fPreviewing then Exit;
  // stop the graph
  MC := nil;
  if Graph <> nil then begin
    hr := Graph.QueryInterface( IID_IMediaControl, MC );
    if SUCCEEDED( hr ) then begin
     hr := MC.Stop;
	    MC := nil;
    end;
    if FAILED( hr ) then begin
     ErrMsg( 'Error %x: Cannot stop preview graph', hr );
	    Exit;
    end;
  end;
  fPreviewing := FALSE;
  // !!! get rid of menu garbage
  InvalidateRect( hwOwner, nil, TRUE );
  Result := TRUE;
end;

// Tear down everything downstream of a given filter
procedure CDSCapture.NukeDownstream( pf : IBaseFilter );
var
  pP, pTo : IPin;
  u : Cardinal;
  pins : IEnumPins;
  pininfo : TPIN_INFO;
  hr : HRESULT;
begin
  //DbgLog((LOG_TRACE,1,TEXT("Nuking...")));
  pins := nil;
  hr := pf.EnumPins( pins );
  pins.Reset;
  while hr = NOERROR do begin
    hr := pins.Next( 1, pP, u );
   if ( hr = S_OK ) and ( pP <> nil ) then begin
	    pP.ConnectedTo( pTo );
	    if pTo <> nil then begin
        hr := pTo.QueryPinInfo( pininfo );
        if hr = NOERROR then begin
        if pininfo.dir = PINDIR_INPUT then begin
		        NukeDownstream( pininfo.pFilter );
		        Graph.Disconnect( pTo );
		        Graph.Disconnect( pP );
            Graph.RemoveFilter( pininfo.pFilter );
		      end;
          pininfo.pFilter := nil;
        end;
        pTo := nil;
      end;
      pP := nil;
    end;
  end;
  pins := nil;
end;

// Tear down everything downstream of the capture filters, so we can build
// a different capture graph.  Notice that we never destroy the capture filters
// and WDM filters upstream of them, because then all the capture settings
// we've set would be lost.
//
procedure CDSCapture.TearDownGraph;
begin
  Sink := nil;
  ConfigAviMux := nil;
  Render := nil;
  if VideoWindow <> nil then begin
   // stop drawing in our window, or we may get wierd repaint effects
	  VideoWindow.put_Owner( 0 );
   VideoWindow.put_Visible( FALSE );
  end;
  VideoWindow := nil;
  MediaEvent := nil;
  DroppedFrames := nil;
  // destroy the graph downstream of our capture filters
  if VCap <> nil then NukeDownstream( VCap );
  if ACap <> nil then	NukeDownstream( ACap );
  // potential debug output - what the graph looks like
  // if (gcap.pFg) DumpGraph(gcap.pFg, 1);
  fCaptureGraphBuilt := FALSE;
  fPreviewGraphBuilt := FALSE;
  fPreviewFaked := FALSE;
end;

// all done with the capture filters and the graph builder
//
procedure CDSCapture.FreeCapFilters;
begin
  Graph := nil;
  Builder := nil;
  VCap := nil;
  ACap := nil;
  AStreamConf := nil;
  VStreamConf := nil;
  VideoCompression := nil;
  CaptureDialogs := nil;
end;

// make sure the preview window inside our window is as big as the
// dimensions of captured video, or some capture cards won't show a preview.
// (Also, it helps people tell what size video they're capturing)
// We will resize our app's window big enough so that once the status bar
// is positioned at the bottom there will be enough room for the preview
// window to be w x h
//
procedure CDSCapture.ResizeWindow( w, h : Integer );
var
  rcW, rcC : TRECT;
  cyBorder, xExtra, yExtra : Integer;
begin
    cyBorder := GetSystemMetrics( SM_CYBORDER );
    gnRecurse := gnRecurse + 1;
    GetWindowRect( hwOwner, rcW );
    GetClientRect( hwOwner, rcC );
    xExtra := rcW.right - rcW.left - rcC.right;
    yExtra := rcW.bottom - rcW.top - rcC.bottom + cyBorder;// + statusGetHeight();
    rcC.right := w;
    rcC.bottom := h;
    SetWindowPos( hwOwner, 0, 0, 0, rcC.right + xExtra, rcC.bottom + yExtra, SWP_NOZORDER or SWP_NOMOVE );
    // we may need to recurse once.  But more than that means the window cannot
    // be made the size we want, trying will just stack fault.
    //
    if gnRecurse = 1 then
    if ( ( rcC.right + xExtra <> rcW.right - rcW.left ) and ( w > GetSystemMetrics( SM_CXMIN ) ) )
    or ( rcC.bottom + yExtra <> rcW.bottom - rcW.top ) then ResizeWindow( w, h );
    gnRecurse := gnRecurse - 1;
end;

function CDSCapture.EnumVideoDevices : String;
begin
  if EnumVD < NumVD then begin
    Result := VideoDevices[EnumVD].szName;
    EnumVD := EnumVD + 1;
  end else begin
    Result := ';
    EnumVD := 0;
  end;
end;

function CDSCapture.EnumAudioDevices : String;
begin
  if EnumAD < NumAD then begin
    Result := AudioDevices[EnumAD].szName;
    EnumAD := EnumAD + 1;
  end else begin
    Result := ';
    EnumAD := 0;
  end;
end;

procedure CDSCapture.ChooseDevices( nmVideo, nmAudio : IMoniker );
begin
  if ( mVideo <> nmVideo ) or ( mAudio <> nmAudio ) then begin
    if nmVideo <> nil then nmVideo._AddRef;
    if nmAudio <> nil then nmAudio._AddRef;
    mVideo := nil;
    mAudio := nil;
    mVideo := nmVideo;
    mAudio := nmAudio;
    if fCaptureGraphBuilt or fPreviewGraphBuilt then TearDownGraph;
    FreeCapFilters;
    InitCapFilters;
    if fWantPreview then begin
      BuildPreviewGraph;
      StartPreview;
    end;
  end;
end;

procedure CDSCapture.ChooseDevices( szVideo, szAudio : String );
var
  nmVideo, nmAudio : IMoniker;
  i : Word;
begin
  nmVideo := nil;
  nmAudio := nil;
  if szVideo <> ' then if szVideo[1] = '&' then szVideo := Copy( szVideo, 2, Length( szVideo ) - 1 );
  if szAudio <> ' then if szAudio[1] = '&' then szAudio := Copy( szAudio, 2, Length( szAudio ) - 1 );
  i := 0;
  while i < NumVD do begin
    if VideoDevices[i].szName = szVideo then nmVideo := VideoDevices[i].moniker;
    i := i + 1;
  end;
  i := 0;
  while i < NumAD do begin
    if AudioDevices[i].szName = szAudio then nmAudio := AudioDevices[i].moniker;
    i := i + 1;
  end;
  ChooseDevices( nmVideo, nmAudio );
  nmVideo := nil;
  nmAudio := nil;
end;

procedure CDSCapture.BuildDeviceList;
var
  SysDevEnum : ICreateDevEnum;
  EnumCat : IEnumMoniker;
  Moniker : IMoniker;
  cFetched : Longint;
  PropBag : IPropertyBag;
  varName : OleVariant;
begin
  SysDevEnum := nil;
  CoCreateInstance( CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, SysDevEnum );
  //SysDevEnum.CreateClassEnumerator( CLSID_VideoCompressorCategory, EnumCat, 0 );
  // enum available video capture devices
  EnumCat := nil;
  SysDevEnum.CreateClassEnumerator( CLSID_VideoInputDeviceCategory, EnumCat, 0 );
  while EnumCat.Next( 1, Moniker, @cFetched ) = S_OK do begin
    Moniker.BindToStorage( nil, nil, IID_IPropertyBag, PropBag );
    PropBag.Read( 'FriendlyName', varName, nil );
    NumVD := NumVD + 1;
    SetLength( VideoDevices, NumVD );
    VideoDevices[NumVD-1].szName := varName;
    VideoDevices[NumVD-1].moniker := Moniker;
    PropBag := nil;
    Moniker := nil;
  end;
  // enum available audio capture devices
  EnumCat := nil;
  SysDevEnum.CreateClassEnumerator( CLSID_AudioInputDeviceCategory, EnumCat, 0 );
  while EnumCat.Next( 1, Moniker, @cFetched ) = S_OK do begin
    Moniker.BindToStorage( nil, nil, IID_IPropertyBag, PropBag );
    PropBag.Read( 'FriendlyName', varName, nil );
    NumAD := NumAD + 1;
    SetLength( AudioDevices, NumAD );
    AudioDevices[NumAD-1].szName := varName;
    AudioDevices[NumAD-1].Moniker := Moniker;
    PropBag := nil;
    Moniker := nil;
  end;
  EnumCat := nil;
  SysDevEnum := nil;
end;

function CDSCapture.Init : Boolean;
begin
  Result := False;
  // Create the filter graph.
  if CoCreateInstance( CLSID_FilterGraph, nil, CLSCTX_INPROC,
    IID_IGraphBuilder, Graph ) <> S_OK then Exit;
  // Create the capture graph builder.
  if CoCreateInstance( CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC,
    IID_ICaptureGraphBuilder2, Builder ) <> S_OK then Exit;
  Builder.SetFiltergraph( Graph );
  BuildDeviceList;
  Result := ( NumVD > 0 ) or ( NumAd > 0 );
end;

function CDSCapture.ErrMsg( szMsg : String; hr : HRESULT = 0 ) : Boolean;
begin
  MessageBox( GetForegroundWindow, PChar( szMsg ), 'DirectShow - Capture', MB_OK or MB_ICONSTOP );
  Result := False;
end;

procedure CDSCapture.CleanUp;
begin
  Graph := nil;
  Builder := nil;
  VideoWindow := nil;
  MediaEvent := nil;
  DroppedFrames := nil;
  VideoCompression := nil;
  CaptureDialogs := nil;
  AStreamConf := nil;
  VStreamConf := nil;
  Render := nil;
  VCap := nil;
  ACap := nil;
  Sink := nil;
  ConfigAviMux := nil;
end;

constructor CDSCapture.Create( handle : HWND );
begin
  CleanUp;
  hwOwner := handle;
end;

destructor CDSCapture.Destroy;
begin
  StopPreview;
  CleanUp;
end;

end.