我这有个访问ｄｖ设备媒体流的小程序，能捕捉多媒体流，并在设定的窗体内实时播放和截图，
如要存成多媒体文件只要再加入部份代码就成！
例程：
unit vcdplay;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,ole2,DirectShow, ComCtrls, mmsystem, dspack, DSFilters;
type
TForm1 = class(TForm)
frame: TTrackBar;
volumeban: TTrackBar;
volume: TTrackBar;
Timer1: TTimer;
Panel1: TPanel;
PlayFile: TButton;
FilePause: TButton;
FileStop: TButton;
Button1: TButton;
OpenFileDialog: TOpenDialog;
Button2: TButton;
Image1: TImage;
FilterSampleGrabber: TFilterSampleGrabber;
ListBoxFilter: TListBox;
PinList: TListBox;
procedure PlayFileClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure volumebanChange(Sender: TObject);
procedure frameChange(Sender: TObject);
procedure volumeChange(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FilePauseClick(Sender: TObject);
procedure FileStopClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ListBoxFilterClick(Sender: TObject);
procedure PinListClick(Sender: TObject);
private
{ Private declarations }
procedure CloseDxcom;
public
{ Public declarations }
end;
function InitDxcom: boolean;
var
Form1: TForm1;
g_pGraphBuilder: IGraphBuilder = nil;
g_pMediaControl: IMediaControl = nil;
// 播放状态设置.
g_pMediaSeeking: IMediaSeeking = nil;
// 播放位置.
g_pAudioControl: IBasicAudio = nil;
// 音量/平衡设置.
g_pVideoWindow: IVideoWindow = nil;
//设置播放窗体.
PLAYING: boolean = false;
//判断是否正在播放
_position:integer;
wdm : TFilterWDMVideoCapture;
EnumMT: TDSEnumMediaType;
sysenum: TDSSysDevEnum;
implementation
{$R *.DFM}
function Initdxcom: boolean;
begin
Result:=false;
// 初始化COM接口
if failed(CoInitialize(nil)) then
exit;
// 创建DirectShow Graph
if failed(CoCreateInstance(OLE2.TGUID(CLSID_FilterGraph),
nil,CLSCTX_INPROC,OLE2.TGUID(IID_IGraphBuilder),g_pGraphBuilder))
then
exit;
// 获取IMediaControl 接口
if failed(g_pGraphBuilder.QueryInterface(IID_IMediaControl,g_pMediaControl))
then
exit;
// 获取IMediaSeeking 接口
if failed(g_pGraphBuilder.QueryInterface(IID_IMediaSeeking,g_pMediaSeeking))
then
exit;
// 获取IBasicAudio 接口
if failed(g_pGraphBuilder.QueryInterface(IID_IBasicAudio,g_pAudioControl))
then
exit;
// 获取IVideowindow 接口
if failed(g_pGraphBuilder.QueryInterface(IID_IVideoWindow,g_pVideoWindow))
then
exit;
// 所有接口获取成功
Result:=true;
end;
procedure tform1.CloseDxcom;
begin
// 停止播放
if Assigned(g_pMediaControl) then
g_pMediaControl.Stop;
// 释放所有用到的接口。
if Assigned(g_pAudioControl) then
g_pAudioControl:=nil;
if Assigned(g_pMediaSeeking) then
g_pMediaSeeking:=nil;
if Assigned(g_pMediaControl) then
g_pMediaControl:=nil;
if Assigned(g_pVideoWindow) then
g_pVideoWindow:=nil;
if Assigned(g_pGraphBuilder) then
g_pGraphBuilder:=nil;
CoUninitialize;
end;
procedure TForm1.PlayFileClick(Sender: TObject);
begin
g_pVideoWindow.put_Owner(panel1.handle);
//设置播放窗体
g_pVideoWindow.put_AutoShow(true);
g_pVideoWindow.put_windowstyle(WS_CHILD or WS_Clipsiblings);
//参数类型见WINDOWS API
g_pVideoWindow.SetWindowposition(0, 0, panel1.width, panel1.height);
//播放的图像为整个panel1的ClientRect
g_pMediaControl.run;
timer1.enabled:=true;
PLAYING:=true;
end;
procedure TForm1.FormCreate(Sender: TObject);
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
sysenum := TDSSysDevEnum.Create;
sysenum.SelectGUIDCategory(CLSID_VideoInputDeviceCategory);
// select video Capture category
if (sysenum.CountFilters = 0) then
begin
Messagebox(0,'没安装视频采集卡或没开启视频输入设备！','视频初始化错误',id_ok);
sysenum.Destroy;
Application.Terminate;
exit;
end;
wdm := TFilterWDMVideoCapture.Create(nil);
for i := 0 to wdm.Count-1do
ListBoxFilter.Items.Add(wdm.DeviceName);
EnumMT := TDSEnumMediaType.Create;
if Initdxcom()=false then
showmessage('初始化DIRECTX SHOW接口出错');
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
CloseDxcom;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
s:string;
_hr:Hresult;
begin
g_pGraphBuilder.AddFilter(FilterSampleGrabber.BaseFilter, 'Grabber');
FilterSampleGrabber.SetBMPCompatible(nil,24);
_hr:=g_pGraphBuilder.Render(wdm.Pins.Items[PinList.ItemIndex]);
// 建立了一个能够播放文件的Filter Graph。第一个参数是文件名，第二个参数必须为nil
if failed(_hr) then
begin
showmessage('开启视频采集错误！');
exit;
end;
end;
procedure TForm1.volumebanChange(Sender: TObject);
begin
if not PLAYING then
exit;
g_pAudioControl.put_Balance(volumeban.Position * 100);
//左右声道音量平衡设置
end;
procedure TForm1.frameChange(Sender: TObject);
var
_stop:LONGLONG;
_newpos:longlong;
begin
if not PLAYING then
exit;
if abs((frame.position-_position))<=1 then
exit;
// 获得当前播放最大帧数
g_pMediaSeeking.GetStopPosition(_stop);
_newpos:=(_stop*frame.position) div 100;
// 范围检查
if _newpos<0 then
_newpos:=0;
if _newpos>_stop then
_newpos:=_stop;
// 设置新播放帧数位置
g_pMediaSeeking.SetPositions(_newpos,AM_SEEKING_AbsolutePositioning,_newpos,AM_SEEKING_NoPositioning);
end;
procedure TForm1.volumeChange(Sender: TObject);
begin
if not PLAYING then
exit;
g_pAudioControl.put_Volume((volume.Position + -100)*100);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
_current,_stop:LONGLONG;
begin
if not PLAYING then
exit;
g_pMediaSeeking.GetCurrentPosition(_current);
//获得当前位置
g_pMediaSeeking.GetStopPosition(_stop);
_position:=frame.position;
if _stop<>0 then
frame.Position:=Trunc((_current*100)/_stop);
if _current=_stop then
frame.Position:=0;
end;
procedure TForm1.FilePauseClick(Sender: TObject);
begin
g_pMediaControl.pause;
end;
procedure TForm1.FileStopClick(Sender: TObject);
begin
g_pMediaControl.stop;
timer1.enabled:=false;
g_pVideoWindow.put_visible(false);
g_pVideoWindow.put_Owner(0);
g_pVideoWindow.put_AutoShow(false);
g_pVideoWindow.SetWindowposition(0, 0, panel1.width, panel1.height);
//播放的图像为整个panel1的ClientRect
frame.Position:=0;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FilterSampleGrabber.GetBitmap(image1.Picture.Bitmap);
end;
procedure TForm1.ListBoxFilterClick(Sender: TObject);
var i: integer;
begin
if ListBoxFilter.ItemIndex <> -1 then
begin
wdm.SelectDevice(ListBoxFilter.ItemIndex);
g_pGraphBuilder.AddFilter(wdm.BaseFilter,stringtoolestr(wdm.DeviceName[ListBoxFilter.ItemIndex]));
PinList.Clear;
if wdm.Pins.Count > 0 then
for i := 0 to wdm.pins.Count-1 do
PinList.Items.Add(wdm.Pins.PinInfo.achName);
end;
end;
procedure TForm1.PinListClick(Sender: TObject);
var i: integer;
begin
if PinList.ItemIndex >= 0 then
begin
EnumMT.Assign(wdm.Pins.Items[PinList.ItemIndex]);
end;
end;
end.
