{******************************************************************
* 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