Chip 2001 December/Chip_2001-12_cd1.bin/zkuste/delphi/kompon/d56/CMDXCAP.ZIP/DXCapture.pas

Pascal/Delphi Source File | 2001-09-17 | 78.9 KB | 2,358 lines

//******************************************************************************
//  TCapture -  Capturing from VFW, WDM or DV compatible devices
//
//              Compiled with Delphi6 Personal Edition
//              You need DirectX 8 or above installed!
//
//  based on:
//  - Microsoft's AMCap & StillCap
//  - DirectX Jedi Compilation
//  - DScapture by orthkon * www.mp3.com/orthkon * [e-mail]
//  - TVideoCapture by E. Averchekov  [e-mail]
//
//  new attempt by orthkon / [e-mail]
//
//  history log:
//  01-09-11 - v1.00
//    America under Attack!!! i'm so sorry 8(
//  01-09-16 - v1.01
//    - i'm happy about Averchekov's nice work
//    - i removed the bitmap routines, sorry :)
//    - optimized capture callback class
//    - added audio capturing
//  01-09-17 - v1.02
//    - added device owned option dialogs ( TDeviceOptions )
//    - added audio + video format settings
//  01-09-18 - v1.03
//    - the image routines are back :)
//    - to save an image call SaveAsBitmap or SaveAsJpeg
//    - removed some bugs
//
//  you can use this code under GNU license, found at www.gnu.org
//  if you make changed source or components public, please inform us
//******************************************************************************
unit DXCapture;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  extctrls, DirectShow, ActiveX, DirectSound, Menus, MMSystem, jpeg;

const
  WM_FGNOTIFY = WM_USER + 1;
  WM_CAPTURE_BITMAP = WM_USER + 2;
    SAMPLE_RATE : array[0..3] of Cardinal = ( 8000, 11025, 22050, 44100 );

type
  EVideoCaptureError = class(Exception);

type
    TFProcessBuffer = procedure( Frame : Cardinal; Buffer : Pointer; Size : Integer ) of object;

  TSampleGrabberCB = class(TObject, ISampleGrabberCB)
  protected
    FOwner : HWND;
    FEnabled : boolean;
    FProcessBuffer : TFProcessBuffer;
    FFrame : Cardinal;
  public
    { IUnknown }
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    { ISampleGrabberCB }
    function SampleCB(SampleTime: Double; pSample: IMediaSample): HResult; stdcall;
    function BufferCB(SampleTime: Double; pBuffer: PByte; BufferLen: longint): HResult; stdcall;
  public
    property Owner: HWND read FOwner write FOwner;
    property Enabled: Boolean read FEnabled write FEnabled;
    property ProcessBuffer : TFProcessBuffer read FProcessBuffer write FProcessBuffer;
    constructor Create;
    destructor Destroy; override;
  end;

type
  TBitmapCapturedEvent = procedure(CapturedImage: TBitmap) of object;

type
  TDVSize = (dvsDontWorry, dvsFull, dvsHalf, dvsQuater, dvsDC);

const
  DVSizeName: array [TDVSize] of string =
  ('═σ Φ∞σσ≥ τφα≈σφΦ ', '╧εδφ√Θ ≡ατ∞σ≡', '╧εδεΓΦφα', '╫σ≥Γσ≡≥ⁿ', '1/8 Φ±⌡εΣφεπε');


// device option dialog identifier constants
const
    DEVOPT_VFORMAT          = 1;
    DEVOPT_VSOURCE          = 2;
    DEVOPT_VDISPLAY         = 3;
    DEVOPT_VCAPTURE         = 4;
    DEVOPT_VCROSSBAR        = 5;
    DEVOPT_TVTUNER          = 6;
    DEVOPT_ACAPTURE         = 7;
    DEVOPT_ACROSSBAR        = 8;
    DEVOPT_TVAUDIO          = 9;
    DEVOPT_VCAPTURE_PIN     = 10;
    DEVOPT_VPREVIEW_PIN     = 11;
    DEVOPT_ACAPTURE_PIN     = 12;

type
  TCapture = class;

  TDeviceOption = record
    szCaption : String;
    iType : Integer;
    bVideo : Boolean; // true = video, false = audio
  end;

  TDeviceOptions = class
  private
    FOptions : array of TDeviceOption;
    FCount : Integer;
    FOwner : TCapture;
    function GetCaption( Index : Integer ) : String;
    procedure SetCaption( Index : Integer; const szCaption : String );
    function Call( Index : Integer ) : HRESULT;
    function GetVideo( Index : Integer ) : Boolean;
  public
    procedure Add( iType : Integer; const szCaption : String; bVideo : Boolean );
    procedure Clear;
    constructor Create( Owner : TCapture ); overload;
    function Dialog( const szCaption : String ) : HRESULT;
  public
    property Count : Integer read FCount;
    property Captions[Index: Integer] : String read GetCaption write SetCaption;
    property Dialogs[Index: Integer] : HRESULT read Call;
    property IsVideo[Index: Integer] : Boolean read GetVideo;
  end;

  TCapture = class(TCustomControl)
  private
    Graph: IGraphBuilder;
    Builder: ICaptureGraphBuilder2;
    VideoWindow: IVideoWindow;
    MediaEvent: IMediaEventEx;
    DroppedFrames: IAMDroppedFrames;
    VideoCompression: IAMVideoCompression;
    CaptureDialogs: IAMVfwCaptureDialogs;
    AStreamConf: IAMStreamConfig;      // for audio capture
    VStreamConf: IAMStreamConfig;      // for video capture
    Render: IBaseFilter;
    VCap: IBaseFilter;
    ACap: IBaseFilter;
    Sink: IFileSinkFilter;
    ConfigAviMux: IConfigAviMux;
    Grabber: ISampleGrabber;

    VGrabberCB: TSampleGrabberCB;
    AGrabberCB: TSampleGrabberCB;
    FDeviceOptions : TDeviceOptions;
        FAudioFormat : TWaveFormatEx;
        FVideoFormat : TVIDEOINFOHEADER;
    mVideo, mAudio: IMoniker;
        p_mtVideo, p_mtAudio : PAM_Media_Type;

    fCapAudioIsRelevant: boolean;
    fCapAudio: boolean;
    fCCAvail: boolean;
    fCapCC: boolean;
    fCaptureGraphBuilt: boolean;
    fPreviewGraphBuilt: boolean;
    fPreviewFaked: boolean;
    FVCapFriendlyName: string;

    FCapturing: boolean;
    FPreviewing: boolean;
    FUseFrameRate: boolean;
    FUseTimeLimit: boolean;
    FWantPreview: boolean;
    FCapStartTime: DWORD;
    FCapStopTime: DWORD;
    FMasterStream: integer;

    FVideoWidth: integer;
    FVideoHeight: integer;
    FVideoFrameRate: double;
    FVideoBitCount: integer;

    FAudioSampleRate : Cardinal;
    FAudioBitRate : Integer;
    FAudioChannels : Integer;

    FNotDropped: integer;
    FDroppedFrames: integer;
    FNotDroppedBase: integer;
    FDroppedBase: integer;

    FCapTime: DWORD;
    FCaptureTimer: TTimer;
    FTempCaptureFileName: string;
    FCaptureFileName: string;

    // to save the old function
    FProcessBuffer : TFProcessBuffer;
    FStillImage : Boolean;
    FImageFile : String;
    FImageType : Integer;
    FImageQuality : Integer;

    FTimeLimit: integer;
    FUseTempFile: boolean;
    FPreallocFileSize: Cardinal;
    FDVSize: TDVSize;
    FCaptureFile: WideString;

    FOnStopPreview: TNotifyEvent;
    FOnStartPreview: TNotifyEvent;
    FOnStopCapture: TNotifyEvent;
    FOnStartCapture: TNotifyEvent;
    FOnChangeDevice: TNotifyEvent;
    FOnCaptureProgress: TNotifyEvent;
    FOnVideoFormatChange: TNotifyEvent;
    FOnAudioFormatChange: TNotifyEvent;

    procedure SetMasterStream(const Value: integer);
    property MasterStream: integer read FMasterStream write SetMasterStream;
    procedure SetTempCaptureFileName(const Value: string);
    procedure SetCaptureFileName(const Value: string);
    function AllocCaptureFile(const SizeMb: integer): boolean;
    function SaveCaptureFile(const FileName: string): boolean;

  private
    procedure SetSize(var msg: TMessage); message WM_SIZE;  // Changing size of cap window
    procedure GraphEvent(var msg: TMessage); message WM_FGNOTIFY;
    procedure CaptureProgress(Sender: TObject);
    procedure ResizeWindow;
    procedure ChooseDevices(nmVideo, nmAudio: IMoniker); overload;
    procedure UpdateStatus;

    function InitCapFilters: boolean;
    procedure CleanUp;
    procedure FreeCapFilters;
    function MakeBuilder: boolean;
    function MakeGraph: boolean;
    procedure NukeDownstream(pf: IBaseFilter);
    procedure TearDownGraph;
    function RenderPreviewPin: boolean;
    function FindVideoWindow: boolean;
    function AdjustVideoGrabber: boolean;
    function AdjustAudioGrabber: boolean;
    function BuildPreviewGraph: boolean;
    function BuildCaptureGraph: boolean;

    procedure GetDeviceOptions;
    function OptionDialog( iType : Integer ) : HRESULT;

    function CreateBitmap( Buffer : Pointer; Size : Integer ) : TBitmap;
    procedure OnVideoFrame( Frame : Cardinal; Buffer : Pointer; Size : Integer );

  public
    // state properties
    property Capturing: boolean read FCapturing;
    property Previewing: boolean read FPreviewing;

    property VCapFriendlyName: string read FVCapFriendlyName;

    property VideoWidth: Integer read FVideoWidth;
    property VideoHeight: Integer read FVideoHeight;
    property VideoFrameRate: Double read FVideoFrameRate;
    property VideoBitCount: Integer read FVideoBitCount;

    property AudioSampleRate : Cardinal read FAudioSampleRate;
    property AudioBitRate : Integer read FAudioBitRate;
    property AudioChannels : Integer read FAudioChannels;

    property ImageFile : String read FImageFile write FImageFile;

    property FramesDropped: integer read FDroppedFrames;
    property NotDropped: integer read FNotDropped;
    property CapStartTime: DWORD read FCapStartTime;
    property CapStopTime: DWORD read FCapStopTime;
    property CapTime: DWORD read FCapTime;

    property DeviceOptions : TDeviceOptions read FDeviceOptions;

    procedure ChooseDevices(szVideo, szAudio: string); overload;
    function Init: boolean;
    function StartPreview: boolean;
    function StopPreview: boolean;
    function StartCapture(const Dialog: boolean = false): boolean;
    function StopCapture: boolean;

        procedure SetAudioFormat( SamplesPerSec : Cardinal; Channels, BitsPerSec : Word );
        procedure SetVideoFormat( Width, Height : Integer; BitCount : Word; FrameRate : Double );

    procedure SaveAsBitmap;
    procedure SaveAsJpeg( Quality : TJPEGQualityRange ); // 0 - 100 %

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property DVPreviewSize: TDVSize read FDVSize write FDVSize;

    // set to true if you want to capture single frames during preview
    property WantPreview: boolean read FWantPreview write FWantPreview;
    property UseFrameRate: boolean read FUseFrameRate write FUseFrameRate;
    property CaptureFileName: string read FCaptureFileName write SetCaptureFileName;
    property UseTimeLimit: boolean read FUseTimeLimit write FUseTimeLimit;
    property TimeLimit: integer read FTimeLimit write FTimeLimit;
    property UseTempFile: boolean read FUseTempFile write FUseTempFile;
    property PreallocFileSize: Cardinal read FPreallocFileSize write FPreallocFileSize default 10;
    property TempCaptureFileName: string read FTempCaptureFileName write SetTempCaptureFileName;

    property OnChangeDevice: TNotifyEvent read FOnChangeDevice write FOnChangeDevice;
    property OnCaptureProgress: TNotifyEvent read FOnCaptureProgress write FOnCaptureProgress;
    property OnStopCapture: TNotifyEvent read FOnStopCapture write FOnStopCapture;
    property OnStopPreview: TNotifyEvent read FOnStopPreview write FOnStopPreview;
    property OnStartCapture: TNotifyEvent read FOnStartCapture write FOnStartCapture;
    property OnStartPreview: TNotifyEvent read FOnStartPreview write FOnStartPreview;
    property OnVideoFormatChange: TNotifyEvent read FOnVideoFormatChange write FOnVideoFormatChange;
    property OnAudioFormatChange: TNotifyEvent read FOnAudioFormatChange write FOnAudioFormatChange;

    // grabber classes
    property VideoGrabber: TSampleGrabberCB read VGrabberCB;
    property AudioGrabber: TSampleGrabberCB read AGrabberCB;

  published
    property Align;
    property Color;
    property Visible;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseDown;
    property OnClick;
    property OnDblClick;
 end;


// device enum functions
// caller have to free aquired list!!!
function GetVideoDevicesList(const Refresh: boolean = false): TStringList;
function GetAudioDevicesList(const Refresh: boolean = false): TStringList;

procedure Register;

implementation

uses contnrs;

//-----------------------------------------------------------------
resourcestring
  rsDShowCapture = 'DirectShow - Capture';
  rsGraphCantPreview = 'This graph can''t preview!';
  rsCantRenderCC = 'Cannot render closed captioning!';
  rsGraphCantBePreviewedProperly = 'This graph cannot be previewwd properly!';
  rsCantSetPreviewFrameRate = '%x: can''t set preview frame rate!';
  rsSetMasterStreamFailed = 'SetMasterStream failed!';
  rsCantSetCaptureFile = 'Can''t set capture file!';
  rsCantRenderVCaptureStream = 'Can''t render video capture stream!';
  rsCantRenderPreviewStream = 'Can''t render preview stream!';
  rsCantRenderACaptureStream = 'Can''t render audio preview stream!';
  rsThisGraphCantPreview = 'This graph cannot preview!';
  rsCantSetCaptureFrameRate = 'Cannot set frame rate for capture!';
  rsCantMakeGraphBuilder = 'Can''t init graph builder. Probably DirectShow is not installed!';
  rsCantCreateVCaptureFilter = 'Error %x.'#13#10'Can''t create video capture filter - propably you havn''t video capture device!';
  rsCantMakeGraph = 'Can''t init graph. Probably DirectShow is not installed!';
  rsCantSetFilterGraph = 'Can''t set filter graph!';
  rsCantAddVFilterToGraph = 'Error %x: Can''t add video capture filter into graph!';
  rsCantFindVStreamConfig = 'Error %x: Can''t find VCapture:IAMStreamConfig!';
  rsCantMakeACapFilter = 'Can''t create audio capture filter!';
  rsCantAddAFilterToGraph = 'Error %x: Can''t add audio capture filter into graph!';
  rsCantFindAStreamConfig = 'Can''t find ACapture:IAMStreamConfig!';
  rsCantRunPreviewGraph = 'Error %x: Cannot run preview graph!';
  rsCantStopPreviewGraph = 'Error %x: Cannot stop preview graph!';
  rsCantGetMediaControl = 'Error %x: Can''t get IMediaControl!';
  rsCantRunGraph = 'Error %x: Cannot run graph!';
  rsStartCapture = 'Starting capture!';
  rsCantStopGraph = 'Error %x: Cannot stop graph!';
  rsEmptyFileName = 'Capture filename required!';
  rsFailedToAllocFileSize = 'Can''t allocate space for capture file! Disk full?';

//-----------------------------------------------------------------

const
  IID_IPropertyBag: TGUID = '{55272A00-42CB-11CE-8135-00AA004BB851}';
    IID_ISpecifyPropertyPages : TGUID = '{B196B28B-BAB4-101A-B69C-00AA00341D07}';

type
  PVIDEOINFOHEADER = ^TVIDEOINFOHEADER;
  TVIDEOINFOHEADER = record
    rcSource: TRECT;          // The bit we really want to use
    rcTarget: TRECT;          // Where the video should go
    dwBitRate: Cardinal;      // Approximate bit data rate
    dwBitErrorRate: Cardinal; // Bit error rate for this stream
    AvgTimePerFrame: Int64;   // Average time per frame (100ns units)
    bmiHeader: BITMAPINFOHEADER;
  end;

const
  DVSizes: array [TDVSize] of integer = ( 0,
                                          DVRESOLUTION_FULL,
                                          DVRESOLUTION_HALF,
                                          DVRESOLUTION_QUARTER,
                                          DVRESOLUTION_DC);


//-----------------------------------------------------------------
function MyMsg(szMsg: string; hr: HRESULT): string;
begin
  Result:= Format(szMsg, [hr]);
  MessageBox(GetForegroundWindow, PChar(Result), PChar(rsDShowCapture), MB_OK or MB_ICONSTOP);
end;

procedure ErrMsg(szMsg: string; hr: HRESULT = 0);
begin
  MyMsg(szMsg, hr);
end;

procedure ErrMsgException(szMsg: string; hr: HRESULT = 0);
begin
  raise EVideoCaptureError.Create(MyMsg(szMsg, hr));
end;

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

// Free an existing media type (ie free resources it holds)
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
  // allow NULL pointers for coding simplicity
  if pmt <> nil then begin
    FreeMediaType(pmt^);
    CoTaskMemFree(pmt);
  end;
end;

//-----------------------------------------------------------------
{ TCapDeviceInfo }

type
  TCapDeviceInfo = class
    DeviceName: string;
    Moniker: IMoniker;
    constructor Create(const aDeviceName: string; const aMoniker: IMoniker);
  end;

constructor TCapDeviceInfo.Create(const aDeviceName: string; const aMoniker: IMoniker);
begin
  DeviceName:= aDeviceName;
  Moniker:= aMoniker;
end;
//-----------------------------------------------------------------

var
  VideoDevicesList,
  AudioDevicesList: TObjectList;

procedure BuildDeviceList;
var
  SysDevEnum: ICreateDevEnum;
  EnumCat: IEnumMoniker;
  Moniker: IMoniker;
  cFetched: Longint;
  PropBag: IPropertyBag;
  varName: OleVariant;
  hr: HRESULT;
begin
  VideoDevicesList.Clear;
  AudioDevicesList.Clear;
  SysDevEnum:= nil;
  hr:= CoCreateInstance(CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, SysDevEnum);
  if (hr = S_OK) then begin
    // enum available video capture devices
    EnumCat:= nil;
    if (SysDevEnum.CreateClassEnumerator(CLSID_VideoInputDeviceCategory, EnumCat, 0)= S_OK) then
      while EnumCat.Next(1, Moniker, @cFetched) = S_OK do begin
        Moniker.BindToStorage(nil, nil, IID_IPropertyBag, PropBag);
        PropBag.Read('FriendlyName', varName, nil);
        VideoDevicesList.Add(TCapDeviceInfo.Create(varName, Moniker) );
        PropBag:= nil;
        Moniker:= nil;
      end;
    EnumCat:= nil;

    // enum available audio capture devices
    if (SysDevEnum.CreateClassEnumerator(CLSID_AudioInputDeviceCategory, EnumCat, 0)= S_OK) then
      while EnumCat.Next(1, Moniker, @cFetched) = S_OK do begin
        Moniker.BindToStorage(nil, nil, IID_IPropertyBag, PropBag);
        PropBag.Read('FriendlyName', varName, nil);
        AudioDevicesList.Add(TCapDeviceInfo.Create(varName, Moniker));
        PropBag:= nil;
        Moniker:= nil;
      end;
    EnumCat:= nil;
    SysDevEnum:= nil;
  end;
end;

function GetVideoDevicesList(const Refresh: boolean): TStringList;
var i: integer;
begin
  Result:= TStringList.Create;
  if Refresh or (VideoDevicesList.Count=0) then BuildDeviceList;
  for i:= 0 to VideoDevicesList.Count-1 do
    Result.Add(TCapDeviceInfo(VideoDevicesList[i]).DeviceName);
end;

function GetAudioDevicesList(const Refresh: boolean): TStringList;
var i: integer;
begin
  Result:= TStringList.Create;
  if Refresh or (AudioDevicesList.Count=0) then BuildDeviceList;
  for i:= 0 to AudioDevicesList.Count-1 do
    Result.Add(TCapDeviceInfo(AudioDevicesList[i]).DeviceName);
end;

//-----------------------------------------------------------------

{ IUnknown }
function TSampleGrabberCB._AddRef: Integer;
begin
  Result:= 2;
end;

function TSampleGrabberCB._Release: Integer;
begin
  Result:= 1;
end;

function TSampleGrabberCB.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
  // We need to return the two event interfaces when they're asked for
  Result:= E_NOINTERFACE;
  if CheckGUID(IID, ISampleGrabberCB) or CheckGUID(IID, IUnknown) then begin
    if GetInterface(IID,Obj) then Result := S_OK;
  end;
end;

{ TSampleGrabberCB }
constructor TSampleGrabberCB.Create;
begin
  FEnabled := True;
  FFrame := 0;
end;

destructor TSampleGrabberCB.Destroy;
begin
  inherited;
end;

{ TSampleGrabberCB - ISampleGrabberCB }
function TSampleGrabberCB.BufferCB(SampleTime: Double; pBuffer: PByte; BufferLen: Integer): HResult;
begin
  if FEnabled then begin
    Inc( FFrame );
    if Assigned( FProcessBuffer ) then FProcessBuffer( FFrame, pBuffer, BufferLen );
  end;
  Result:= S_OK;
end;

function TSampleGrabberCB.SampleCB(SampleTime: Double; pSample: IMediaSample): HResult;
begin // not implemented
  Result:= S_OK;
end;

//-----------------------------------------------------------------

{ TDeviceOptions }

function TDeviceOptions.Call( Index : Integer ) : HRESULT;
begin
  Result := E_FAIL;
  if ( Index < 0 ) or ( Index >= FCount ) then Exit;
  if FOwner = nil then Exit;
  Result := FOwner.OptionDialog( FOptions[Index].iType );
end;

function TDeviceOptions.Dialog( const szCaption : String ) : HRESULT;
var
  i : Integer;
begin
  Result := E_FAIL;
  if FOwner = nil then Exit;
  i := 0;
  while i < FCount do begin
    if FOptions[i].szCaption = szCaption then begin
      Result := FOwner.OptionDialog( FOptions[i].iType );
      Break;
    end;
    Inc( i );
  end;
end;

function TDeviceOptions.GetVideo( Index : Integer ) : Boolean;
begin
  if ( Index >= 0 ) and ( Index < FCount ) then Result := FOptions[Index].bVideo else Result := False;
end;

function TDeviceOptions.GetCaption( Index : Integer ) : String;
begin
  Result := '';
  if ( Index < 0 ) or ( Index >= FCount ) then Exit;
  Result := FOptions[Index].szCaption;
end;

procedure TDeviceOptions.SetCaption( Index : Integer; const szCaption : String );
begin
  if ( Index < 0 ) or ( Index >= FCount ) then Exit;
  FOptions[Index].szCaption := szCaption;
end;

procedure TDeviceOptions.Add( iType : Integer; const szCaption : String; bVideo : Boolean );
begin
  SetLength( FOptions, FCount + 1 );
  FOptions[FCount].szCaption := szCaption;
  FOptions[FCount].iType := iType;
  FOptions[FCount].bVideo := bVideo;
  Inc( FCount );
end;

procedure TDeviceOptions.Clear;
begin
  FCount := 0;
end;

constructor TDeviceOptions.Create( Owner : TCapture );
begin
  FOwner := Owner;
  FCount := 0;
end;

//-----------------------------------------------------------------

{ TCapture }

constructor TCapture.Create(AOwner: TComponent);
begin
  inherited;
  fUseFrameRate:= false;
  fWantPreview:= true;
  Color:= clBlue;
  Width:= 320;
  Height:= 240;
  FPreallocFileSize:= 100;

  VGrabberCB:= TSampleGrabberCB.Create;
  AGrabberCB:= TSampleGrabberCB.Create;
  FDeviceOptions := TDeviceOptions.Create( Self );

  SetVideoFormat( 320, 240, 24, 15 );
  SetAudioFormat( 22000, 1, 16 );

  CleanUp;

  FCaptureTimer:= TTimer.Create(Self);
  FCaptureTimer.Interval:= 100;
  FCaptureTimer.OnTimer:= CaptureProgress;

end;

destructor TCapture.Destroy;
begin
  VGrabberCB.Enabled := False;
  AGrabberCB.Enabled := False;

  StopPreview;
  StopCapture;
  TearDownGraph;
  CleanUp;

  FCaptureTimer.Enabled:= false;
  FCaptureTimer.Free;

  VGrabberCB.Free;
  AGrabberCB.Free;

  FDeviceOptions.Free;

  inherited;
end;

procedure TCapture.ChooseDevices(nmVideo, nmAudio: IMoniker);
begin
  VGrabberCB.Enabled := False;
  AGrabberCB.Enabled := False;

  mVideo:= nmVideo;
  mAudio:= nmAudio;

  StopCapture;
  StopPreview;
  if fCaptureGraphBuilt or fPreviewGraphBuilt then TearDownGraph;
  FreeCapFilters;
  InitCapFilters;

  if FWantPreview then begin
    BuildPreviewGraph;
    StartPreview;
  end;

  GetDeviceOptions;
  if Assigned(FOnChangeDevice) then FOnChangeDevice(Self);

  VGrabberCB.Enabled := True;
  AGrabberCB.Enabled := True;
end;

procedure TCapture.ChooseDevices(szVideo, szAudio: string);
var
  nmVideo, nmAudio: IMoniker;
  i: integer;
begin
  nmVideo:= nil;
  nmAudio:= nil;

  for i:= 0 to VideoDevicesList.Count-1 do
    with VideoDevicesList[i] as TCapDeviceInfo do
      if DeviceName = szVideo then begin
        nmVideo:= Moniker;
        break;
      end;

  for i:= 0 to AudioDevicesList.Count-1 do
    with AudioDevicesList[i] as TCapDeviceInfo do
      if DeviceName = szAudio then begin
        nmAudio:= Moniker;
        break;
      end;

  ChooseDevices(nmVideo, nmAudio);
  nmVideo:= nil;
  nmAudio:= nil;
end;

procedure TCapture.CleanUp;
begin
  FreeCapFilters;

  VideoWindow:= nil;
  MediaEvent:= nil;
  DroppedFrames:= nil;

  Render:= nil;
  Sink:= nil;
  ConfigAviMux:= nil;

  p_mtVideo := nil;
  p_mtAudio := nil;

  fCapAudioIsRelevant:= true;
  fCapAudio:= true;
  fCCAvail:= false;
  fCapCC:= false;
  fCaptureGraphBuilt:= false;
  fPreviewGraphBuilt:= false;
  fPreviewFaked:= false;
  fCapturing:= false;
  fPreviewing:= false;
  FMasterStream:= -1;
end;

procedure TCapture.FreeCapFilters;
begin
  Graph:= nil;
  Builder:= nil;
  VCap:= nil;
  ACap:= nil;
  AStreamConf:= nil;
  VStreamConf:= nil;
  VideoCompression:= nil;
  CaptureDialogs:= nil;
  Grabber:= nil;
end;

function TCapture.MakeBuilder: boolean;
begin
  Result:= (Builder <> nil) or
           (CoCreateInstance( CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC,
                              IID_ICaptureGraphBuilder2, Builder) = NOERROR);
end;

function TCapture.MakeGraph: boolean;
begin
  Result:= (Graph <> nil) or
           (CoCreateInstance( CLSID_FilterGraph, nil, CLSCTX_INPROC,
                  IID_IGraphBuilder, Graph) = NOERROR);
end;

function TCapture.Init: boolean;
begin
  // Create the filter graph and create the capture graph builder.
  Result:= MakeGraph and MakeBuilder;

  if not Result then Exit;

  Builder.SetFiltergraph(Graph);
  BuildDeviceList;
  Result:= (VideoDevicesList.Count>0) or (AudioDevicesList.Count>0);
end;

function TCapture.InitCapFilters: boolean;
var
  PropBag: IPropertyBag;
  hr: HRESULT;
  varOle: OleVariant;
  pmt: PAM_MEDIA_TYPE;
  Pin: IPin;
  pins: IEnumPins;
  n: Cardinal;
  pinInfo: TPIN_INFO;
  Found: boolean;
  Ks: IKsPropertySet;
  guid: TGUID;
  dw: DWORD;
begin
  hr:= 0;

  Result:= MakeBuilder;
  if not Result then begin
    ErrMsg(rsCantMakeGraphBuilder);
    Exit;
  end;

  try
    VCap:= nil;
    if mVideo <> nil then begin
      hr:= mVideo.BindToStorage(nil, nil, IID_IPropertyBag, PropBag);
      if Succeeded(hr) then begin
        hr:= PropBag.Read('FriendlyName', varOle, nil);
        if hr = NOERROR then FVCapFriendlyName:= varOle;
        PropBag:= nil;
      end;
      hr:= mVideo.BindToObject(nil, nil, IID_IBaseFilter, VCap);
    end;
    if VCap = nil then
      ErrMsgException(rsCantCreateVCaptureFilter, hr);

    // make a filtergraph, give it to the graph builder and put the video
    // capture filter in the graph
    if not MakeGraph then ErrMsgException(rsCantMakeGraph);

    if Builder.SetFiltergraph(Graph) <> NOERROR then
      ErrMsgException(rsCantSetFilterGraph);

    if Graph.AddFilter(VCap, nil) <> NOERROR then
      ErrMsgException(rsCantAddVFilterToGraph, hr);

    // Calling FindInterface below will result in building the upstream
    // section of the capture graph (any WDM TVTuners or Crossbars we might need).
    // we use this interface to get the name of the driver
    // Don't worry if it doesn't work:  This interface may not be available
    // until the pin is connected, or it may not be available at all.
    // (eg: interface may not be available for some DV capture)
    hr:= Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Interleaved,
                                VCap, IID_IAMVideoCompression, VideoCompression);
    if hr <> S_OK then
      Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video,
                             VCap, IID_IAMVideoCompression, VideoCompression);

    // !!! What if this interface isn't supported?
    // we use this interface to set the frame rate and get the capture size
    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 // this means we can't set frame rate (non-DV only)
        ErrMsg(rsCantFindVStreamConfig, hr);
    end;

    fCapAudioIsRelevant:= true;

    // default capture format
    if (VStreamConf <> nil) and (VStreamConf.GetFormat(pmt)=S_OK) then
      try
        // DV capture does not use a VIDEOINFOHEADER
        if CheckGUID(pmt^.formattype, FORMAT_VideoInfo) then begin
          p_mtVideo := pmt;
          if Assigned( FOnVideoFormatChange ) then begin
            FOnVideoFormatChange( Self );
            pmt^.pbFormat := @FVideoFormat;
            VStreamConf.SetFormat( pmt^ );
          end;
          p_mtVideo := nil;
          // resize our window to the default capture size
          FVideoWidth := PVIDEOINFOHEADER(pmt^.pbFormat)^.bmiHeader.biWidth;
          FVideoHeight := ABS(PVIDEOINFOHEADER(pmt^.pbFormat)^.bmiHeader.biHeight);
          ResizeWindow;
        end;
        if not CheckGUID(pmt^.majortype, MEDIATYPE_Video) then begin
          // This capture filter captures something other that pure video.
          // Maybe it's DV or something?  Anyway, chances are we shouldn't
          // allow capturing audio separately, since our video capture
          // filter may have audio combined in it already!
          fCapAudioIsRelevant:= false;
          fCapAudio:= false;
        end;
      finally
        DeleteMediaType( pmt );
      end;

    // we use this interface to bring up the 3 dialogs
    // NOTE:  Only the VfW capture filter supports this.  This app only brings
    // up dialogs for legacy VfW capture drivers, since only those have dialogs
    Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video,
                           VCap, IID_IAMVfwCaptureDialogs, CaptureDialogs);

    Found:= false;
    Pin:= nil;

    if Succeeded(VCap.EnumPins(pins)) then begin
      while (not Found) and (pins.Next(1, pin, n) = S_OK) do begin
        if S_OK = pin.QueryPinInfo(pinInfo) then begin
          if pinInfo.dir = PINDIR_INPUT then begin
            // is this pin an ANALOGVIDEOIN input pin?
            if pin.QueryInterface(IID_IKsPropertySet, Ks) = S_OK then begin
              Found:= (Ks.Get(AMPROPSETID_Pin, 0, nil, 0, @guid, sizeof(guid), dw) = S_OK) and
                       CheckGuid(guid, PIN_CATEGORY_ANALOGVIDEOIN);
              Ks:= nil;
            end;
          end;
          pinInfo.pFilter:= nil;
        end;
        pin:= nil;
      end;
      pins:= nil;
    end;

    // there's no point making an audio capture filter
    if (fCapAudioIsRelevant) then begin
      // create the audio capture filter, even if we are not capturing audio right
      // now, so we have all the filters around all the time.
      //
      // We want an audio capture filter and some interfaces
      if mAudio = nil then begin
        // there are no audio capture devices. We'll only allow video capture
        fCapAudio:= false;
      end
      else begin
        ACap:= nil;

        mAudio.BindToObject(nil, nil, IID_IBaseFilter, ACap);
        if ACap = nil then begin
          // there are no audio capture devices. We'll only allow video capture
          fCapAudio:= false;
          ErrMsg(rsCantMakeACapFilter);
        end
        else begin
          // put the audio capture filter in the graph

          // We'll need this in the graph to get audio property pages
          if Graph.AddFilter(ACap, nil) <> NOERROR then
            ErrMsgException(rsCantAddAFilterToGraph, hr);

          // 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 ErrMsg(rsCantFindAStreamConfig);
        end;
      end;

      // default capture format
      if (AStreamConf <> nil) and (AStreamConf.GetFormat(pmt)=S_OK) then
        try
          // DV capture does not use a VIDEOINFOHEADER
          if CheckGUID(pmt^.formattype, FORMAT_WaveFormatEx) then begin
            p_mtAudio := pmt;
            p_mtAudio.pbFormat := @FAudioFormat;
            if Assigned( FOnAudioFormatChange ) then begin
              FOnAudioFormatChange( Self );
              AStreamConf.SetFormat( pmt^ );
            end;
            p_mtAudio := nil;
          end;
        finally
          DeleteMediaType(pmt);
      end;

    end;

    // Can this filter do closed captioning?
    hr:= Builder.FindPin( VCap, PINDIR_OUTPUT, PIN_CATEGORY_VBI, TGUID(nil^),
                          false, 0, Pin);
    if hr <> S_OK then
      hr:= Builder.FindPin( VCap, PINDIR_OUTPUT, PIN_CATEGORY_CC, TGUID(nil^),
                            false, 0, Pin);

    fCCAvail:= (hr = S_OK); // can't capture it, then
    if fCapCC then Pin:= nil;

    Result:= true;
  except
    FreeCapFilters;
    Result:= false;
  end;
end;

// Tear down everything downstream of a given filter
procedure TCapture.NukeDownstream(pf: IBaseFilter);
var
  pP, pTo: IPin;
  u: Cardinal;
  pins: IEnumPins;
  pininfo: TPIN_INFO;
  hr: HRESULT;
begin
  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;

// 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 TCapture.ResizeWindow;
begin
  if Assigned(VideoWindow) then
    VideoWindow.SetWindowPosition(0, 0, ClientWidth, ClientHeight);
end;

procedure TCapture.SetSize(var msg: TMessage);
begin
  inherited;
  ResizeWindow;
end;

// graph event occured
// get events
procedure TCapture.GraphEvent(var msg: TMessage);
var
  Event, l1, l2: integer;
  wasCapturing, wasPreviewing: boolean;
begin
  wasCapturing:= Capturing;
  wasPreviewing:= Previewing;
  if (MediaEvent <> nil) then begin
    while MediaEvent.GetEvent(Event, l1, l2, 0) = S_OK do
      try
        case Event of
          EC_ERRORABORT: StopCapture;
          EC_DEVICE_LOST: begin
                            StopCapture;
                            StopPreview;
                          end;
          EC_REPAINT : begin
          end;
        end;
      finally
        MediaEvent.FreeEventParams(Event, l1, l2);
      end;
    // we have stopped capture need to restore preview
    if ((Capturing<>wasCapturing) or (wasPreviewing<>Previewing)) and (FWantPreview) then begin
      BuildPreviewGraph;
      StartPreview;
    end;
  end;
end;

function TCapture.RenderPreviewPin: boolean;
var
  hr: HRESULT;
  DVDec: IBaseFilter;
  DVDecProp: IIPDVDec;
begin
  Result:= true;
  fPreviewFaked:= false;
  // 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
      Result:= hr = S_OK;
  end;
  if Result then begin
    if (FDVSize<>dvsDontWorry) and
       (Graph.FindFilterByName('DV Video Decoder', DVDec) =S_OK) and
       (DVDec.QueryInterface(IIPDVDec, DVDecProp)=S_OK) then
    begin
      DVDecProp.put_IPDisplay(DVSizes[FDVSize]);
    end;
  end;
end;

function FindPin(pins: IEnumPins; PinDir: TPin_Direction): IPin;
var
  pin: IPin;
  pininfo: TPin_Direction;
  hr: HRESULT;
  u: Cardinal;
begin
  Result:= nil;
  if pins=nil then Exit;
  pins.Reset;
  repeat
    hr:= pins.Next(1, pin, u);
    if (hr = S_OK) then begin
      hr:= pin.QueryDirection(pininfo);
      if (hr = S_OK) and (pininfo = PinDir) then begin
        Result:= pin;
        break;
      end;
    end;
  until hr<>NOERROR;
end;

function TCapture.AdjustVideoGrabber: boolean;
var
  FGrabber, FRenderer: IBaseFilter;
  GrabIn, GrabOut, RenderIn, DecoderOut: IPin;
  pins: IEnumPins;
  mt: TAM_Media_Type;
begin
  // find video renderer to put grabber just before it
  // I dont know how to find it another way except by Name(((((((
  Result:= Graph.FindFilterByName('Video Renderer', FRenderer) = S_OK;
  if Result then begin
    Result:= (CoCreateInstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC, IID_IBaseFilter, FGrabber) = NOERROR) and
             (FGrabber.QueryInterface(IID_ISampleGrabber, Grabber) = S_OK) and
             (Graph.AddFilter(FGrabber, 'Video Grabber') = S_OK) and
             (FGrabber.EnumPins(pins)=S_OK);
    if (Result) then begin
      GrabIn:= FindPin(pins, PINDIR_INPUT);
      GrabOut:= FindPin(pins, PINDIR_OUTPUT);
      pins:= nil;
      if (FRenderer.EnumPins(pins)=S_OK) then begin
        RenderIn:= FindPin(pins, PINDIR_INPUT);
        RenderIn.ConnectedTo(DecoderOut);
        pins:= nil;
        Result:= (Graph.RemoveFilter(FRenderer) = S_OK);
        FillChar(mt, sizeof(mt), 0);
        mt.majortype:= MEDIATYPE_Video;
        mt.formattype:= FORMAT_VideoInfo;
        case FVideoFormat.bmiHeader.biBitCount of
          1 : mt.subtype := MEDIASUBTYPE_RGB1;
          4 : mt.subtype := MEDIASUBTYPE_RGB4;
          8 : mt.subtype := MEDIASUBTYPE_RGB8;
         16 : mt.subtype := MEDIASUBTYPE_RGB555;
         32 : mt.subtype := MEDIASUBTYPE_RGB32;
         else mt.subtype:= MEDIASUBTYPE_RGB24;
        end;
        mt.bFixedSizeSamples := True;
        mt.pbFormat := @FVideoFormat;
        mt.cbFormat := sizeof( TVIDEOINFOHEADER );
        Grabber.SetMediaType( mt );
        Result:= Result and (DecoderOut<>nil) and (GrabIn<>nil) and
                 (DecoderOut.Connect(GrabIn, nil)=S_OK);

        if Result then begin
          Grabber.SetBufferSamples(false);
          Grabber.SetOneShot(false);
          VGrabberCB.Owner:= Handle;
          Grabber.SetCallback( VGrabberCB, 1 );
          Result:= ( Graph.Render( GrabOut ) = S_OK );
        end;

      end;
    end;
  end;
end;

function TCapture.AdjustAudioGrabber: boolean;
var
  FGrabber, FRenderer: IBaseFilter;
  GrabIn, GrabOut, RenderIn, DecoderOut: IPin;
  pins: IEnumPins;
  mt: TAM_Media_Type;
begin
  // find audio renderer to put grabber just before it
  // I dont know how to find it another way except by Name(((((((
  Result:= Graph.FindFilterByName('Audio Renderer', FRenderer) = S_OK;
  if Result then begin
    Result:= (CoCreateInstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC, IID_IBaseFilter, FGrabber) = NOERROR) and
             (FGrabber.QueryInterface(IID_ISampleGrabber, Grabber) = S_OK) and
             (Graph.AddFilter(FGrabber, 'Audio Grabber') = S_OK) and
             (FGrabber.EnumPins(pins)=S_OK);
    if (Result) then begin
      GrabIn:= FindPin(pins, PINDIR_INPUT);
      GrabOut:= FindPin(pins, PINDIR_OUTPUT);
      pins:= nil;
      if (FRenderer.EnumPins(pins)=S_OK) then begin
        RenderIn:= FindPin(pins, PINDIR_INPUT);
        RenderIn.ConnectedTo(DecoderOut);
        pins:= nil;
        Result:= (Graph.RemoveFilter(FRenderer) = S_OK);

        FillChar(mt, sizeof(mt), 0);
        mt.majortype:= MEDIATYPE_Audio;
        mt.formattype:= FORMAT_WaveFormatEx;
        mt.subtype:= MEDIASUBTYPE_PCM;
        mt.bFixedSizeSamples := True;
        mt.pbFormat := @FAudioFormat;
        mt.cbFormat := sizeof( TVIDEOINFOHEADER );
        Grabber.SetMediaType(mt);

        Result:= Result and (DecoderOut<>nil) and (GrabIn<>nil) and
                 (DecoderOut.Connect(GrabIn, nil)=S_OK);

        if Result then begin
          Grabber.SetBufferSamples(false);
          Grabber.SetOneShot(false);
          AGrabberCB.Owner:= Handle;
          Grabber.SetCallback( AGrabberCB, 1 );
          Result:= ( Graph.Render( GrabOut ) = S_OK );
        end;

      end;
    end;
  end;
end;

function TCapture.FindVideoWindow: boolean;
begin
  // 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.
  Result:= (Graph.QueryInterface(IID_IVideoWindow, VideoWindow)=S_OK);
  if Result then begin
    VideoWindow.put_Owner(Handle);    // We own the window now
    VideoWindow.put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS);    // you are now a child
    // give the preview window all our space
    ResizeWindow;
    VideoWindow.put_Visible(true);
  end;
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 TCapture.BuildPreviewGraph: boolean;
var
  hr: HRESULT;
  pmt: PAM_MEDIA_TYPE;
begin
  // we have one already
  Result:= fPreviewGraphBuilt;
  if Result then Exit;

  // 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;

  if RenderPreviewPin then
    AdjustVideoGrabber
  else
    ErrMsg(rsGraphCantPreview);

  if fCapAudio then fCapAudio := Builder.RenderStream( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Audio, ACap, nil, nil ) = S_OK;
  if fCapAudio then AdjustAudioGrabber;

  // 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 ErrMsg(rsCantRenderCC);
    end;
  end;

  if not FindVideoWindow then ErrMsg(rsGraphCantBePreviewedProperly);

  // 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 then begin
    hr:= VStreamConf.GetFormat(pmt);
    // DV capture does not use a VIDEOINFOHEADER
    if hr = NOERROR then begin
      DeleteMediaType(pmt);
    end;
  end;

  // make sure we process events while we're previewing!
  if (Graph.QueryInterface(IID_IMediaEventEx, MediaEvent) = NOERROR) then
    MediaEvent.SetNotifyWindow(Handle, WM_FGNOTIFY, 0);

  // All done.
  fPreviewGraphBuilt:= true;
  Result:= true;
end;

// build the capture graph!
function TCapture.BuildCaptureGraph: boolean;
var
   hr: HRESULT;
   pmt: PAM_MEDIA_TYPE;
begin
  // we have one already
  Result:= fCaptureGraphBuilt;
  if Result then Exit;

  // No rebuilding while we're running
  Result:= false;
  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;

  // no capture file name yet... we need one first
  if UseTempFile then
    FCaptureFile:= TempCaptureFileName
  else
    FCaptureFile:= CaptureFileName;

  if (FCaptureFile = '') then begin
    ErrMsg(rsEmptyFileName);
    Result:= false;
    Exit;
  end;

  if not AllocCaptureFile(PreallocFileSize) then begin
    ErrMsg(rsFailedToAllocFileSize);
    Result:= false;
    Exit;
  end;

  // we already have another graph built... tear down the old one
  try
    if (fPreviewGraphBuilt) then TearDownGraph();

// We need a rendering section that will write the capture file out in AVI file format
    hr:= Builder.SetOutputFileName(MEDIASUBTYPE_Avi, PWCHAR(FCaptureFile), Render, Sink);
    if (hr <> NOERROR) then ErrMsgException(rsCantSetCaptureFile);

// Now tell the AVIMUX to write out AVI files that old apps can read properly.
// If we don't, most apps won't be able to tell where the keyframes are, slowing down editing considerably
// Doing this will cause one seek (over the area the index will go) when
// you capture past 1 Gig, but that's no big deal.
// NOTE: This is on by default, so it's not necessary to turn it on
    hr:= Render.QueryInterface(IID_IConfigAviMux, ConfigAviMux);
    if (hr = NOERROR) and (ConfigAviMux<>nil) then begin
      ConfigAviMux.SetOutputCompatibilityIndex(true);
      if (fCapAudio) then // Also, set the proper MASTER STREAM
        MasterStream:= FMasterStream;
    end;

// Render the video capture and preview pins - even if the capture filter only
// has a capture pin (and no preview pin) this should work... because the
// capture graph builder will use a smart tee filter to provide both capture
// and preview.  We don't have to worry.  It will just work.

// 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_CAPTURE, @MEDIATYPE_Interleaved,
                   VCap, nil, Render);
    if (hr <> NOERROR) then begin
        hr:= Builder.RenderStream( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video,
                   VCap, nil, Render);
        if (hr <> NOERROR) then ErrMsgException(rsCantRenderVCaptureStream);
    end;

    // Rendering preview pin
    if (fWantPreview) and not RenderPreviewPin then
      ErrMsgException(rsCantRenderPreviewStream);

    if (fCapAudio) then begin // Render the audio capture pin?
    hr:= Builder.RenderStream( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Audio,
                                   ACap, nil, Render);
    if (hr <> NOERROR) then
          ErrMsgException(rsCantRenderACaptureStream);
    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, Render);
      if (hr <> NOERROR) then begin
        hr:= Builder.RenderStream(@PIN_CATEGORY_VBI, nil, VCap, nil, Render);
        if (hr <> NOERROR) then ErrMsg(rsCantRenderCC);
      end;
      // To preview and capture VBI at the same time, we can call this twice
      if (fWantPreview) then
        Builder.RenderStream(@PIN_CATEGORY_VBI, nil, VCap, nil, nil);
    end;

    // NOTE: We do this even if we didn't ask for a preview, because rendering
    // the capture pin may have rendered the preview pin too (WDM overlay
    // devices) because they must have a preview going.  So we better always
    // put the preview window in our app, or we may get a top level window
    // appearing out of nowhere!
    if not FindVideoWindow and (fWantPreview) then ErrMsg(rsThisGraphCantPreview);

    // 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
    if fUseFrameRate then
      hr:= E_FAIL
    else
      hr:= NOERROR;

    if VStreamConf <> nil 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
          p_mtVideo := pmt;
          if Assigned( FOnVideoFormatChange ) then begin
            FOnVideoFormatChange( Self );
            pmt^.pbFormat := @FVideoFormat;
            hr:= VStreamConf.SetFormat( pmt^ );
            if hr <> NOERROR then ErrMsg(rsCantSetPreviewFrameRate, hr);
          end;
          p_mtVideo := nil;
          // resize our window to the default capture size
          FVideoWidth := PVIDEOINFOHEADER(pmt^.pbFormat)^.bmiHeader.biWidth;
          FVideoHeight := ABS(PVIDEOINFOHEADER(pmt^.pbFormat)^.bmiHeader.biHeight);
          ResizeWindow;
        end;
        DeleteMediaType(pmt);
      end;
    end;
    if (hr <> NOERROR) then ErrMsg(rsCantSetCaptureFrameRate);

    // now ask the filtergraph to tell us when something is completed or aborted
    // (EC_COMPLETE, EC_USERABORT, EC_ERRORABORT).  This is how we will find out
    // if the disk gets full while capturing
    if (Graph.QueryInterface(IID_IMediaEventEx, MediaEvent) = NOERROR) then
      MediaEvent.SetNotifyWindow(Handle, WM_FGNOTIFY, 0);

// All done.
    fCaptureGraphBuilt:= true;
    Result:= true;
  except
    TearDownGraph;
    Result:= false;
  end;

end;

procedure TCapture.GetDeviceOptions;
var
    Spec : ISpecifyPropertyPages;
    StreamConf : IAMStreamConfig;
    auuid : CAUUID;
    hr : HRESULT;
    TVTuner : IAMTVTuner;
    TVAudio : IAMTVAudio;
  bVFormat : Boolean;
begin

  FDeviceOptions.Clear;
  bVFormat := False;

    if CaptureDialogs <> nil then begin
    // If this device supports the old legacy UI dialogs, offer them
        if CaptureDialogs.HasDialog( VfwCaptureDialog_Format ) = S_OK then begin
      FDeviceOptions.Add( DEVOPT_VFORMAT, 'Video Format', True );
      bVFormat := True;
        end;

        if CaptureDialogs.HasDialog( VfwCaptureDialog_Source ) = S_OK then begin
      FDeviceOptions.Add( DEVOPT_VSOURCE, 'Video Source', True );
        end;

        if CaptureDialogs.HasDialog( VfwCaptureDialog_Display ) = S_OK then begin
      FDeviceOptions.Add( DEVOPT_VDISPLAY, 'Video Display', True );
        end;
    end;

    // Also check the audio capture filter at this point, since even non wdm devices
    // may support an IAMAudioInputMixer property page (we'll also get any wdm filter
    // properties here as well). We'll get any audio capture pin property pages just
    // a bit later.
    if ACap <> nil then begin
        hr := ACap.QueryInterface( IID_ISpecifyPropertyPages, Spec );
        if hr = S_OK then begin
            hr := Spec.GetPages( auuid );
            if ( hr = S_OK ) and ( auuid.cElems > 0 ) then begin
        FDeviceOptions.Add( DEVOPT_ACAPTURE, 'Audio Capture Filter', False );
                CoTaskMemFree( auuid.pElems );
            end;
            Spec := nil;
        end;
    end;

    // don't bother looking for new property pages if the old ones are supported
    // or if we don't have a capture filter
    if ( VCap = nil ) or ( bVFormat ) then Exit;

    // New WDM devices support new UI and new interfaces.
    // Your app can use some default property
    // pages for UI if you'd like (like we do here) or if you don't like our
    // dialog boxes, feel free to make your own and programmatically set
    // the capture options through interfaces like IAMCrossbar, IAMCameraControl
    // etc.

    // There are 9 objects that might support property pages.  Let's go through
    // them.

    // 1. the video capture filter itself

    hr := VCap.QueryInterface( IID_ISpecifyPropertyPages, Spec );
    if hr = S_OK then begin
        hr := Spec.GetPages( auuid );
        if ( hr = S_OK ) and ( auuid.cElems > 0 ) then begin
      FDeviceOptions.Add( DEVOPT_VCAPTURE, 'Video Capture Filter', True );
            CoTaskMemFree( auuid.pElems );
        end;
        Spec := nil;
    end;

    // 2.  The video capture capture pin

    hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Interleaved,    VCap, IID_IAMStreamConfig, StreamConf );
    if hr <> S_OK then hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, VCap, IID_IAMStreamConfig, StreamConf );
    if hr = S_OK then begin
        hr := StreamConf.QueryInterface( IID_ISpecifyPropertyPages, Spec );
        if hr = S_OK then begin
            hr := Spec.GetPages( auuid );
            if ( hr = S_OK ) and ( auuid.cElems > 0 ) then begin
        FDeviceOptions.Add( DEVOPT_VCAPTURE_PIN, 'Video Capture Pin', True );
                CoTaskMemFree( auuid.pElems );
            end;
            Spec := nil;
        end;
        StreamConf := nil;
    end;

    // 3.  The video capture preview pin.

    // This basically sets the format being previewed.  Typically, you
    // want to capture and preview using the SAME format, instead of having to
    // enter the same value in 2 dialog boxes.  For a discussion on this, see
    // the comment above the MakePreviewGraph function.

    hr := Builder.FindInterface( @PIN_CATEGORY_PREVIEW, @MEDIATYPE_Interleaved, VCap, IID_IAMStreamConfig, StreamConf );
    if hr <> NOERROR then hr := Builder.FindInterface( @PIN_CATEGORY_PREVIEW, @MEDIATYPE_Video, VCap,    IID_IAMStreamConfig, StreamConf );
    if hr = S_OK then begin
        hr := StreamConf.QueryInterface( IID_ISpecifyPropertyPages, Spec );
        if hr = S_OK then begin
            hr := Spec.GetPages( auuid );
            if ( hr = S_OK ) and ( auuid.cElems > 0 ) then begin
        FDeviceOptions.Add( DEVOPT_VPREVIEW_PIN, 'Video Preview Pin', True );
                CoTaskMemFree( auuid.pElems );
            end;
            Spec := nil;
        end;
        StreamConf := nil;
    end;

    // 6.  The TVTuner

    hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Interleaved, VCap, IID_IAMTVTuner, TVTuner );
    if hr <> S_OK then hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, VCap, IID_IAMTVTuner, TVTuner );
    if hr = S_OK then begin
        hr := TVTuner.QueryInterface( IID_ISpecifyPropertyPages, Spec );
        if hr = S_OK then begin
            hr := Spec.GetPages( auuid );
            if ( hr = S_OK ) and ( auuid.cElems > 0 ) then begin
        FDeviceOptions.Add( DEVOPT_TVTUNER, 'TV Tuner', True );
                CoTaskMemFree( auuid.pElems );
            end;
            Spec := nil;
        end;
         TVTuner := nil;
    end;

    // no audio capture, we're done
    if ACap = nil then Exit;

    // 7.  The Audio capture filter itself... Thanks anyway, but we got these already

    // 8.  The Audio capture pin

    hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Audio, ACap, IID_IAMStreamConfig, StreamConf );
    if hr = S_OK then begin
        hr := StreamConf.QueryInterface( IID_ISpecifyPropertyPages, Spec );
        if hr = S_OK then begin
            hr := Spec.GetPages( auuid );
            if ( hr = S_OK ) and ( auuid.cElems > 0 ) then begin
        FDeviceOptions.Add( DEVOPT_ACAPTURE_PIN, 'Audio Capture Pin', False );
                CoTaskMemFree( auuid.pElems );
            end;
            Spec := nil;
        end;
        StreamConf := nil;
    end;

    // 9.  The TV Audio filter

    hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Audio, ACap, IID_IAMTVAudio, TVAudio );
    if hr = S_OK then begin
        hr := TVAudio.QueryInterface( IID_ISpecifyPropertyPages, Spec );
        if hr = S_OK then begin
            hr := Spec.GetPages( auuid );
            if ( hr = S_OK ) and ( auuid.cElems > 0 ) then begin
        FDeviceOptions.Add( DEVOPT_TVAUDIO, 'TV Audio', False );
                CoTaskMemFree( auuid.pElems );
            end;
            Spec := nil;
        end;
        TVAudio := nil;
    end;
end;

function TCapture.OptionDialog( iType : Integer ) : HRESULT;
var
    Spec : ISpecifyPropertyPages;
    auuid : CAUUID;
    hr : HRESULT;
    hrD : Cardinal;
    pmt : PAM_MEDIA_TYPE;
    StreamConf : IAMStreamConfig;
    TVTuner : IAMTVTuner;
begin

  // they want the VfW format dialog

    if iType = DEVOPT_VFORMAT then begin
        // this dialog will not work while previewing
    if fWantPreview then StopPreview;
        hrD := CaptureDialogs.ShowDialog( VfwCaptureDialog_Format, Handle );
        // Oh uh!  Sometimes bringing up the FORMAT dialog can result
        // in changing to a capture format that the current graph
        // can't handle.  It looks like that has happened and we'll
        // have to rebuild the graph.
        if hrD = VFW_E_CANNOT_CONNECT then begin
            //DbgLog((LOG_TRACE,1,TEXT("DIALOG CORRUPTED GRAPH!")));
            TearDownGraph;    // now we need to rebuild
            // !!! This won't work if we've left a stranded h/w codec
        end;

        // Resize our window to be the same size that we're capturing
        if VStreamConf <> nil then begin
            // get format being used NOW
            hr := VStreamConf.GetFormat( pmt );
            // DV capture does not use a VIDEOINFOHEADER
            if hr = NOERROR then begin
                if CheckGuid( pmt^.formattype, FORMAT_VideoInfo ) then begin
                    // resize our window to the new capture size
          //p_mtVideo := pmt;
                    //pVideoFormat := pmt^.pbFormat;
                    //FProcessMessage( CAPM_VIDEOINFOHEADER, Integer( pVideoFormat ) );
                    //ResizeWindow( pVideoFormat^.bmiHeader.biWidth, Abs( pVideoFormat^.bmiHeader.biHeight ) );
                end;
                DeleteMediaType( pmt );
            end;
        end;

        if fWantPreview then begin
            BuildPreviewGraph;
            StartPreview;
        end;
    end
  else if iType = DEVOPT_VSOURCE then begin
        // this dialog will not work while previewing
        if fWantPreview then StopPreview;
        CaptureDialogs.ShowDialog( VfwCaptureDialog_Source, Handle );
        if fWantPreview then StartPreview;
    end
  else if iType = DEVOPT_VDISPLAY then begin
        // this dialog will not work while previewing
        if fWantPreview then StopPreview;
        CaptureDialogs.ShowDialog( VfwCaptureDialog_Display, Handle );
        if fWantPreview then StartPreview;

  // now the code for the new dialogs

    end
  else if iType = DEVOPT_VCAPTURE then begin
        hr := VCap.QueryInterface( IID_ISpecifyPropertyPages,    Spec );
        if hr = S_OK then begin
            Spec.GetPages( auuid );
            OleCreatePropertyFrame( Handle, 30, 30, nil, 1, @VCap, auuid.cElems, auuid.pElems, 0, 0, nil );
            CoTaskMemFree( auuid.pElems );
            Spec := nil;
        end;
    end
  else if iType = DEVOPT_VCAPTURE_PIN then begin
        // You can change this pin's output format in these dialogs.
        // If the capture pin is already connected to somebody who's
        // fussy about the connection type, that may prevent using
        // this dialog(!) because the filter it's connected to might not
        // allow reconnecting to a new format. (EG: you switch from RGB
        // to some compressed type, and need to pull in a decoder)
        // I need to tear down the graph downstream of the
        // capture filter before bringing up these dialogs.
        // In any case, the graph must be STOPPED when calling them.
        if fWantPreview then StopPreview;  // make sure graph is stopped
        // The capture pin that we are trying to set the format on is connected if
        // one of these variable is set to TRUE. The pin should be disconnected for
        // the dialog to work properly.
        if fPreviewGraphBuilt then begin
            //DbgLog((LOG_TRACE,1,TEXT("Tear down graph for dialog")));
            TearDownGraph;    // graph could prevent dialog working
        end;
        hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Interleaved, VCap, IID_IAMStreamConfig, StreamConf );
        if hr <> NOERROR then Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, VCap, IID_IAMStreamConfig, StreamConf );
        hr := StreamConf.QueryInterface( IID_ISpecifyPropertyPages, Spec );
        if hr = S_OK then begin
            Spec.GetPages( auuid );
            OleCreatePropertyFrame( Handle, 30, 30, nil, 1, @StreamConf, auuid.cElems, auuid.pElems, 0, 0, nil );

            // !!! What if changing output formats couldn't reconnect
            // and the graph is broken?  Shouldn't be possible...

            if VStreamConf <> nil then begin
                // get format being used NOW
                hr := VStreamConf.GetFormat( pmt );
                // DV capture does not use a VIDEOINFOHEADER
                if hr = NOERROR then begin
                    if CheckGuid( pmt^.formattype, FORMAT_VideoInfo ) then begin
                        // resize our window to the new capture size
                        //pVideoFormat := pmt^.pbFormat;
                        //FProcessMessage( CAPM_VIDEOINFOHEADER, Integer( pVideoFormat ) );
                        //ResizeWindow( pVideoFormat^.bmiHeader.biWidth, Abs( pVideoFormat^.bmiHeader.biHeight ) );
                    end;
                    DeleteMediaType( pmt );
                end;
            end;

            CoTaskMemFree( auuid.pElems );
            Spec := nil;
        end;
        StreamConf := nil;
        if fWantPreview then begin
            BuildPreviewGraph;
            StartPreview;
        end;
    end
  else if iType = DEVOPT_VPREVIEW_PIN then begin
        // this dialog may not work if the preview pin is connected
        // already, because the downstream filter may reject a format
        // change, so we better kill the graph. (EG: We switch from
        // capturing RGB to some compressed fmt, and need to pull in
        // a decompressor)
        if fWantPreview then begin
            StopPreview;
            TearDownGraph;
        end;
        // This dialog changes the preview format, so it might affect
        // the format being drawn.  Our app's window size is taken
        // from the size of the capture pin's video, not the preview
        // pin, so changing that here won't have any effect. All in all,
        // this probably won't be a terribly useful dialog in this app.
        hr := Builder.FindInterface( @PIN_CATEGORY_PREVIEW, @MEDIATYPE_Interleaved, VCap, IID_IAMStreamConfig, StreamConf );
        if hr <> NOERROR then  Builder.FindInterface( @PIN_CATEGORY_PREVIEW, @MEDIATYPE_Video, VCap, IID_IAMStreamConfig, StreamConf );
        hr := StreamConf.QueryInterface( IID_ISpecifyPropertyPages, Spec );
        if hr = S_OK then begin
            Spec.GetPages( auuid );
            OleCreatePropertyFrame( Handle, 30, 30, nil, 1, @StreamConf, auuid.cElems, auuid.pElems, 0, 0, nil );
            CoTaskMemFree( auuid.pElems );
            Spec := nil;
        end;
        StreamConf := nil;
        if fWantPreview then begin
            BuildPreviewGraph;
            StartPreview;
        end;
    end
  else if iType = DEVOPT_TVTUNER then begin
        hr := Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Interleaved, VCap, IID_IAMTVTuner, TVTuner );
        if hr <> NOERROR then Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, VCap, IID_IAMTVTuner, TVTuner );
        hr := TVTuner.QueryInterface( IID_ISpecifyPropertyPages, Spec );
        if hr = S_OK then begin
            Spec.GetPages( auuid );
            OleCreatePropertyFrame( Handle, 30, 30, nil, 1, @TVTuner, auuid.cElems, auuid.pElems, 0, 0, nil );
            CoTaskMemFree( auuid.pElems );
            Spec := nil;
        end;
        TVTuner := nil;
    end
  else if iType = DEVOPT_ACAPTURE then begin
        hr := ACap.QueryInterface( IID_ISpecifyPropertyPages, Spec );
        if hr = S_OK then begin
            Spec.GetPages( auuid );
            OleCreatePropertyFrame( Handle, 30, 30, nil, 1, @ACap, auuid.cElems, auuid.pElems, 0, 0, nil );
            CoTaskMemFree( auuid.pElems );
            Spec := nil;
        end;
    end
  else if iType = DEVOPT_ACAPTURE_PIN then begin
        // this dialog will not work while previewing - it might change
        // the output format!
        if fWantPreview then StopPreview;
        Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Audio, ACap, IID_IAMStreamConfig, StreamConf );
        hr := StreamConf.QueryInterface( IID_ISpecifyPropertyPages, Spec );
        if hr = S_OK then begin
            Spec.GetPages( auuid );
            OleCreatePropertyFrame( Handle, 30, 30, nil, 1, @StreamConf, auuid.cElems, auuid.pElems, 0, 0, nil );
            CoTaskMemFree( auuid.pElems );
            Spec := nil;
        end;
        StreamConf := nil;
        if fWantPreview then StartPreview;
    end;
  Result := S_OK;
end;

procedure TCapture.SetMasterStream(const Value: integer);
begin
  if (ConfigAviMux<>nil) and (ConfigAviMux.SetMasterStream(Value) = NOERROR) then
    FMasterStream:= Value
  else
    ErrMsg(rsSetMasterStreamFailed);
end;

function TCapture.StartPreview: boolean;
var
  MC: IMediaControl;
  hr: HRESULT;
begin
  // way ahead of you
  Result:= fPreviewing or not fPreviewGraphBuilt;
  if Result then Exit;
  // enable grabber classes
  VGrabberCB.Enabled := True;
  AGrabberCB.Enabled := True;
  // run the graph
  hr:= Graph.QueryInterface(IID_IMediaControl, MC);
  if Succeeded(hr) then begin
    hr:= MC.Run;
    if Failed(hr) then MC.Stop;  // stop parts that ran
    MC:= nil;
  end;
  if Failed(hr) then begin
    ErrMsg(rsCantRunPreviewGraph, hr);
    Exit;
  end;
  if Assigned(FOnStartPreview) then FOnStartPreview(Self);
  fPreviewing:= true;
  Result:= true;
end;

function TCapture.StopPreview: boolean;
var
  MC: IMediaControl;
  hr: HRESULT;
begin
  Result:= false;
  // way ahead of you
  if not fPreviewing then Exit;
  // disable grabber classes
  VGrabberCB.Enabled := False;
  AGrabberCB.Enabled := False;
  // 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(rsCantStopPreviewGraph, hr);
      Exit;
    end;
  end;
  Invalidate; // !!! get rid of garbage
  if Assigned(FOnStopPreview) then FOnStopPreview(Self);
  fPreviewing:= false;
  Result:= true;
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 TCapture.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_Visible(false);
    VideoWindow.put_Owner(0);
  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);

  fCaptureGraphBuilt:= false;
  fPreviewGraphBuilt:= false;
  fPreviewFaked:= false;
end;

// capture AVI
function TCapture.StartCapture(const Dialog: boolean): boolean;
const
  MAX_TIME = $7FFFFFFFFFFFFFFF;
var
  fHasStreamControl: boolean;
  hr: HRESULT;
  start, stop: TREFERENCE_TIME;
  MC: IMediaControl;
begin
  // way ahead of you
  Result:= fCapturing;
  if Result then Exit;
  FCaptureTimer.Enabled:= false;

  if (fPreviewing) then StopPreview();     // or we'll get confused
  if (fPreviewGraphBuilt) then TearDownGraph();

  // or we'll crash
  Result:= false;
  if not BuildCaptureGraph and fCaptureGraphBuilt then Exit;

  // This amount will be subtracted from the number of dropped and not
  // dropped frames reported by the filter.  Since we might be having the
  // filter running while the pin is turned off, we don't want any of the
  // frame statistics from the time the pin is off interfering with the
  // statistics we gather while the pin is on
  FDroppedFrames:= 0; FNotDropped:= 0;

  start:= MAX_TIME; stop:= MAX_TIME;

  // don't capture quite yet...
  hr:= Builder.ControlStream(@PIN_CATEGORY_CAPTURE, nil, nil, @start, nil, 0, 0);
  // Do we have the ability to control capture and preview separately?
  fHasStreamControl:= SUCCEEDED(hr);

  // prepare to run the graph
  MC:= nil;
  hr:= Graph.QueryInterface(IID_IMediaControl, MC);
  if (FAILED(hr)) then begin
    ErrMsg(rsCantGetMediaControl, hr);
    Result:= false;
    Exit;
  end;

  try
    try
      // If we were able to keep capture off, then we can
      // run the graph now for frame accurate start later yet still showing a
      // preview.   Otherwise, we can't run the graph yet without capture
      // starting too, so we'll pause it so the latency between when they
      // press a key and when capture begins is still small (but they won't have
      // a preview while they wait to press a key)
      if (fHasStreamControl) then hr:= MC.Run()
                             else hr:= MC.Pause();

      if (FAILED(hr)) then // stop parts that started
        ErrMsgException(rsCantRunGraph, hr);

      // press a key to start capture
      if ( Dialog and ( MessageDlg(rsStartCapture, mtConfirmation, [mbYes, mbCancel], 0) <> mrYes)) then begin
        // kill all fucking stuff :)
        ChooseDevices( mVideo, mAudio );
        Result := False;
        Exit;
      end;

      // Start capture NOW!
      if (fHasStreamControl) then begin
          // we may not have this yet
          if (DroppedFrames=nil) then begin
            hr:= Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Interleaved,
                                        VCap, IID_IAMDroppedFrames, DroppedFrames);
            if (hr <> NOERROR) then
              Builder.FindInterface( @PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video,
                                     VCap, IID_IAMDroppedFrames, DroppedFrames);
          end;
          // turn the capture pin on now!
          Builder.ControlStream(@PIN_CATEGORY_CAPTURE, nil, nil, nil, @stop, 0, 0);
          // make note of the current dropped frame counts
          if (DroppedFrames<>nil) then begin
            DroppedFrames.GetNumDropped(FDroppedBase);
            DroppedFrames.GetNumNotDropped(FNotDroppedBase);
          end;
      end
      else begin
        hr:= MC.Run();
        if (FAILED(hr)) then // stop parts that started
          ErrMsgException(rsCantRunGraph, hr);
      end;

  // when did we start capture?
      FCapStartTime:= timeGetTime();
      FCaptureTimer.Enabled:= true;
      fCapturing:= true;
      Result:= true;
      if Assigned(FOnStartCapture) then FOnStartCapture(Self);
    except
      MC.Stop();
      Result:= false;
    end
  finally
    MC:= nil;
  end;

end;

function TCapture.StopCapture: boolean;
var
  MC: IMediaControl;
  hr: HRESULT;
begin
  // way ahead of you
  Result:= false;
  if not fCaptureGraphBuilt then Exit;

  FCaptureTimer.Enabled:= false;

  // stop the graph
  MC:= nil;
  hr:= Graph.QueryInterface(IID_IMediaControl, MC);
  if (SUCCEEDED(hr)) then begin
    hr:= MC.Stop();
    MC:= nil;
  end;
  if (FAILED(hr)) then begin
    ErrMsg(rsCantStopGraph, hr);
    Exit;
  end;

  if not fCapturing then Exit;

  // when the graph was stopped
  FCapStopTime:= timeGetTime();
  FCapturing:= false;

  if UseTempFile and SaveCaptureFile(CaptureFileName) then begin
    DeleteFile(TempCaptureFileName);
  end;

  // one last time for the final count and all the stats
  try
    if Assigned(FOnCaptureProgress) then FOnCaptureProgress(Self);
  except
  end;
  // !!! get rid of garbage
  Invalidate;
  if Assigned(FOnStopCapture) then FOnStopCapture(Self);
  Result:= true;
end;

procedure TCapture.CaptureProgress(Sender: TObject);
begin
  FCapTime:= timeGetTime() - FCapStartTime;
  UpdateStatus;
  if not Capturing then Exit;
  if (UseTimeLimit) and (FCapTime div 1000 >= DWORD(TimeLimit)) then begin
    StopCapture();
    if (FWantPreview) then begin
      BuildPreviewGraph();
      StartPreview();
    end;
  end
  else if Assigned(FOnCaptureProgress) then FOnCaptureProgress(Self);
end;

procedure TCapture.UpdateStatus;
begin
  // this filter can't tell us dropped frame info.
  if (DroppedFrames<>nil) and FCapturing then begin
    if (DroppedFrames.GetNumDropped(FDroppedFrames)=S_OK) and
       (DroppedFrames.GetNumNotDropped(FNotDropped)=S_OK) then
    begin
      FDroppedFrames:= FDroppedFrames - FDroppedBase;
      FNotDropped:= FNotDropped - FNotDroppedBase;
    end;

{
    // we want all possible stats, including capture time and actual acheived
    // frame rate and data rate (as opposed to what we tried to get).  These
    // numbers are an indication that though we dropped frames just now, if we
    // chose a data rate and frame rate equal to the numbers I'm about to
    // print, we probably wouldn't drop any frames.
    // average size of frame captured
    if (DroppedFrames.GetAverageFrameSize(&lAvgFrameSize) = S_OK) then begin
    end;
}
  end;
end;

procedure TCapture.SetTempCaptureFileName(const Value: string);
begin
  FTempCaptureFileName:= Value;
  if (Sink<>nil) then begin
    Sink.SetFileName(PWCHAR(WideString(FTempCaptureFileName)), TAM_Media_Type(nil^));
  end;
end;

function TCapture.AllocCaptureFile(const SizeMb: integer): boolean;
begin
  DeleteFile(FCaptureFile);
  Result:= MakeBuilder and (Builder.AllocCapFile(PWCHAR(FCaptureFile),
                            SizeMb*1024*1024) = NOERROR);
end;

function TCapture.SaveCaptureFile(const FileName: string): boolean;
var
  tempBuilder: ICaptureGraphBuilder2;
begin
  Result:= FCaptureFile <> '';
  if Result then
    try
      // we need our own graph builder because the main one might not exist
      Result:= (CoCreateInstance( CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC,
                                  IID_ICaptureGraphBuilder2,  tempBuilder ) = NOERROR);
      if (Result) then begin
        // allow the user to press ESC to abort... don't ask for progress
        Result:= tempBuilder.CopyCaptureFile( PWCHAR(FCaptureFile),
                                              PWCHAR(WideString(FileName)),
                                              -1, nil) = S_OK;
        tempBuilder:= nil;
      end;
    except
      Result:= false;
    end;
end;

procedure TCapture.SetCaptureFileName(const Value: string);
begin
  FCaptureFileName:= Value;
end;

procedure TCapture.SetAudioFormat( SamplesPerSec : Cardinal; Channels, BitsPerSec : Word );
var
    c1 : Integer;
begin
    ZeroMemory( @FAudioFormat, sizeof( TWaveFormatEx ) );
    FAudioFormat.wFormatTag := WAVE_FORMAT_PCM;
    if Channels in [1..2] then FAudioFormat.nChannels := Channels else FAudioFormat.nChannels := 1;
    FAudioFormat.nSamplesPerSec := SAMPLE_RATE[0];
    for c1 := 0 to 3 do if SamplesPerSec = SAMPLE_RATE[c1] then FAudioFormat.nSamplesPerSec := SAMPLE_RATE[c1];
    if ( BitsPerSec = 8 ) or ( BitsPerSec = 16 ) then    FAudioFormat.wBitsPerSample := BitsPerSec else FAudioFormat.wBitsPerSample := 8;
    FAudioFormat.nBlockAlign := FAudioFormat.nChannels * FAudioFormat.wBitsPerSample div 8;
    FAudioFormat.nAvgBytesPerSec := FAudioFormat.nSamplesPerSec * FAudioFormat.nBlockAlign;
  FAudioBitRate := FAudioFormat.wBitsPerSample;
  FAudioSampleRate := FAudioFormat.nSamplesPerSec;
  FAudioChannels := FAudioFormat.nChannels;
  if p_mtAudio = nil then Exit;
    p_mtAudio^.majortype := MEDIATYPE_Audio;
    p_mtAudio^.subtype := MEDIASUBTYPE_PCM;
    p_mtAudio^.formattype := FORMAT_WaveFormatEx;
    p_mtAudio^.pbFormat := @FAudioFormat;
end;

procedure TCapture.SetVideoFormat( Width, Height : Integer; BitCount : Word; FrameRate : Double );
begin
    if Width > 0 then FVideoFormat.bmiHeader.biWidth := Width;
    if Height > 0 then FVideoFormat.bmiHeader.biHeight := Height;
  FVideoWidth := FVideoFormat.bmiHeader.biWidth;
  FVideoHeight := FVideoFormat.bmiHeader.biHeight;
  case BitCount of
    1  : FVideoFormat.bmiHeader.biBitCount := 1;
    4  : FVideoFormat.bmiHeader.biBitCount := 4;
    8  : FVideoFormat.bmiHeader.biBitCount := 8;
    16 : FVideoFormat.bmiHeader.biBitCount := 16;
    32 : FVideoFormat.bmiHeader.biBitCount := 32;
    else FVideoFormat.bmiHeader.biBitCount := 24;
  end;
    FVideoFormat.bmiHeader.biSize := Width * Height * ( FVideoFormat.bmiHeader.biBitCount div 8 );
  FVideoFormat.bmiHeader.biPlanes := 1;
  FVideoFormat.bmiHeader.biCompression := BI_RGB;
  if FrameRate > 0 then FVideoFrameRate := FrameRate else FVideoFrameRate := 15;
  FVideoFormat.AvgTimePerFrame := Round( 1 / FrameRate * 10000000 );
  if p_mtVideo = nil then Exit;
  p_mtVideo^.pbFormat := @FVideoFormat;
  p_mtVideo^.cbFormat := sizeof( TVIDEOINFOHEADER );
  p_mtVideo^.majortype:= MEDIATYPE_Video;
  p_mtVideo^.formattype:= FORMAT_VideoInfo;
  //p_mtVideo^.lSampleSize := FVideoFormat.bmiHeader.biSize * 2;
  p_mtVideo^.bFixedSizeSamples := True;
end;

// this function is not optimized. but readable :)
function TCapture.CreateBitmap( Buffer : Pointer; Size : Integer ) : TBitmap;
var
  iByteCount : Integer;
  SrcScanLine, DstScanLine : PByteArray;
  SrcX, SrcY, DstY : Integer;
begin
  Result := nil;

  // oh no, go out
  if ( Buffer = nil ) or ( Size <= 0 ) then Exit;

  // read the bytecount
  iByteCount := Size div ( FVideoWidth * FVideoHeight );

  // wrong frame size??
  if not iByteCount in [1..4] then Exit;

  Result := TBitmap.Create;

  // set bitmap dimensions
  Result.Width := FVideoWidth;
  Result.Height := FVideoHeight;

  // set right pixelformat
  case iByteCount of
    1 : Result.PixelFormat := pf8Bit;
    2 : Result.PixelFormat := pf16Bit;
    3 : Result.PixelFormat := pf24Bit;
    4 : Result.PixelFormat := pf32Bit;
  end;

  // copy the bytes
  SrcY := 0;
  DstY := FVideoHeight - 1; // flip destination vertical
  while SrcY < FVideoHeight do begin
    DstScanLine := Result.ScanLine[DstY];
    SrcScanLine := Pointer( Integer( Buffer ) + ( SrcY * FVideoWidth * iByteCount ) );
    SrcX := 0;
    while SrcX < FVideoWidth * iByteCount do begin
      DstScanLine[SrcX] := SrcScanLine[SrcX];
      Inc( SrcX );
    end;
    Inc( SrcY );
    Dec( DstY );
  end;
end;

procedure TCapture.OnVideoFrame( Frame : Cardinal; Buffer : Pointer; Size : Integer );
var
  Bitmap : TBitmap;
  imgJPEG : TJpegImage;
begin
  if FStillImage then begin
    Bitmap := CreateBitmap( Buffer, Size );
    if not Bitmap.Empty then begin
      if FImageType = 0 then begin
        if FImageFile = '' then FImageFile := 'capture.bmp';
        Bitmap.SaveToFile( FImageFile );
      end
      else if FImageType = 1 then begin
        if FImageFile = '' then FImageFile := 'capture.jpg';
        if ( FImageQuality < 0 ) or ( FImageQuality > 100 ) then FImageQuality := 100;
        imgJPEG := TJpegImage.Create;
        imgJPEG.Assign( Bitmap );
        imgJPEG.CompressionQuality := FImageQuality;
        imgJPEG.SaveToFile( FImageFile );
        imgJPEG.Free;
      end;
    end;
    Bitmap.Free;
    // kill us!
    VGrabberCB.FProcessBuffer := FProcessBuffer;
    FStillImage := False;
  end;
  // call another handler
  if Assigned( FProcessBuffer ) then FProcessBuffer( Frame, Buffer, Size );
end;

procedure TCapture.SaveAsBitmap;
begin
  if not VGrabberCB.Enabled then Exit;
  FStillImage := True;
  FImageType := 0;
  // save the current handler
  FProcessBuffer := VGrabberCB.FProcessBuffer;
  // set our handler
  VGrabberCB.FProcessBuffer := OnVideoFrame;
end;

procedure TCapture.SaveAsJpeg( Quality : TJPEGQualityRange );
begin
  if not VGrabberCB.Enabled then Exit;
  FStillImage := True;
  FImageType := 1;
  if ( Quality >= 0 ) and ( Quality <= 100 ) then FImageQuality := Quality;
  // save the current handler
  FProcessBuffer := VGrabberCB.FProcessBuffer;
  // set our handler
  VGrabberCB.FProcessBuffer := OnVideoFrame;
end;

//-----------------------------------------------------------------------

procedure Register;
begin
  RegisterComponents( 'Samples', [TCapture] );
end;

initialization

  VideoDevicesList := TObjectList.Create;
  AudioDevicesList := TObjectList.Create;

finalization

  VideoDevicesList.Free;
  AudioDevicesList.Free;

end.