关于delphi中如何在视频采集中选择Video_Composite,S-Video?[已经解决](100)

重要步骤是要Stop一次FilterGraph

恭喜，接分。

好贴。

unit main;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, JPeg, Dialogs, DSUtil, StdCtrls, DSPack, DirectShow9, Menus, ExtCtrls, ComOBJ, ComCtrls;type TVideoForm = class(TForm) FilterGraph: TFilterGraph; OpenDialog: TOpenDialog; Filter: TFilter; MainMenu1: TMainMenu; Devices: TMenuItem; ext1: TMenuItem; Bitmap1: TMenuItem; Timer1: TTimer; Button1: TButton; Button2: TButton; Button4: TButton; Button3: TButton; LBPins: TListBox; Panel2: TPanel; VideoWindow: TVideoWindow; Panel1: TPanel; Image1: TImage; List1: TListBox; Comb1: TComboBox; procedure GetDeviceName(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure SelectDevice(Sender: TObject); procedure Button2Click(Sender: TObject); procedure ext1Click(Sender: TObject); procedure Bitmap1Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure SampleGrabber1Buffer(sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: Integer); procedure ChangeInterface(Sender: TObject); private { D閏larations priv閑s } BName, jnAME: string; PinList: TPinList; VideoMediaTypes: TEnumMediaType; MediaType: TAMMediaType; pvi: PVideoInfoHeader; procedure PinsShow(Sender: TObject); function SetVideoInput(Value: integer): THandle; public { D閏larations publiques } VMRBitmap: TVMRBitmap; end;var VideoForm: TVideoForm; SysDev: TSysDevEnum;implementationuses Math;{$R *.dfm}function DevName(I: integer): string;begin Result := SysDev.Filters.FriendlyName;end;{procedure TVideoForm.PinsShow(Sender: TObject);var i: integer; PinInfo: TPinInfo; BaseF: IBaseFilter;begin lbPins.Clear; if Succeeded(Filter.QueryInterface(IID_IAMCrossBar{IAMCrossbar, BaseF)) then begin PinList.Assign(BaseF); Showmessage(inttostr(PinList.Count)); if PinList.Count > 0 then for i := 0 to PinList.Count - 1 do begin PinInfo := PinList.PinInfo; case PinInfo.dir of PINDIR_INPUT: lbPins.Items.Add(format('(输入端子) %s', [PinInfo.achName])); PINDIR_OUTPUT: lbPins.Items.Add(format('(输出端子) %s', [PinInfo.achName])); end; PinInfo.pFilter := nil; end; BaseF := nil; end else begin Showmessage('没有'); end;end;}procedure TVideoForm.GetDeviceName(Sender: TObject);var i: integer; Device: TMenuItem;var VideoStreamConfig: IAMStreamConfig; AMMEdiaType: PAMMediaType; MMMEdiaType: TAMMediaType; R: THandle;begin VideoWindow.Align := alClient; SysDev := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory); for i := 0 to SysDev.CountFilters - 1 do //VideoCapFilters.Items.Add(CapEnum.Filters.FriendlyName);end;procedure TVideoForm.PinsShow(Sender: TObject);var i: integer; PinInfo: TPinInfo; BaseF: IBaseFilter;begin lbPins.Clear; //PinList := TPinList.Create(); if Succeeded(FilterGraph.QueryInterface(IAMCrossbar, BaseF)) then begin showmessage('发现接口'); //PinList.Assign(BaseF); if PinList.Count > 0 then for i := 0 to PinList.Count - 1 do begin PinInfo := PinList.PinInfo; lbPins.Items.Add(format('(输入端子) %s', [PinInfo.achName])); {case PinInfo.dir of PINDIR_INPUT : lbPins.Items.Add(format('(输入端子) %s',[PinInfo.achName])); PINDIR_OUTPUT : lbPins.Items.Add(format('(输出端子) %s',[PinInfo.achName])); end;} PinInfo.pFilter := nil; end else showmessage('没有接口'); BaseF := nil; end;end;{procedure TVideoForm.SelectDevice(sender: TObject);var PinList: TPinList; FSize: TPoint; pcrossbar: IAMCrossbar; Hr: HRESULT; I_index: Integer; i: integer;begin FilterGraph.ClearGraph; FilterGraph.Active := false; Filter.BaseFilter.Moniker := SysDev.GetMoniker(1+0*TMenuItem(Sender).tag); FilterGraph.Active := true; with FilterGraph as ICaptureGraphBuilder2 do CheckDSError(RenderStream(@PIN_CATEGORY_PREVIEW , nil, Filter as IBaseFilter, nil, VideoWindow as IbaseFilter)); FilterGraph.Play; Exit; FilterGraph.ClearGraph; FilterGraph.Active := true;// FilterGraph.Active := false; Filter.BaseFilter.Moniker := SysDev.GetMoniker(1); //ShowFilterPropertyPage(Self.Handle, Filter as IBaseFilter); PinList := TPinList.Create(Filter as IBaseFilter); for i := 0 to PinList.Count - 1 do if PinList.Connected then ShowPinPropertyPage(self.Handle, PinList.Items); PinList.Free; with FilterGraph as ICaptureGraphBuilder2 do begin RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, nil, VideoWindow as IbaseFilter); end; FilterGraph.Play; //标准的end;}procedure TVideoForm.SelectDevice(sender: TObject);var PinList: TPinList; FSize: TPoint; pcrossbar: IAMCrossbar; Hr: HRESULT; I_index: Integer;begin{ FilterGraph.ClearGraph; FilterGraph.Active := false; Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag); FilterGraph.Active := true; with FilterGraph as ICaptureGraphBuilder2 do begin RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, SampleGrabber1 as IBaseFilter, VideoWindow as IbaseFilter); end; FilterGraph.Play; I_index := 10;} { FilterGraph.ClearGraph; FilterGraph.Active := false; Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag); FilterGraph.Active := true; Hr := (FilterGraph as ICaptureGraphBuilder2).FindInterface(@LOOK_UPSTREAM_ONLY, nil, Filter as IBaseFilter, IID_IAMCrossbar, pcrossbar); if Succeeded(Hr) then begin if pcrossbar.CanRoute(0, I_index)=0 then ; pcrossbar.Route(0, I_index); //注意这个 I_Index就是输入视频源的序号,好像是从1开始的 pcrossbar := nil; end; } FilterGraph.ClearGraph; FilterGraph.Active := false; Filter.BaseFilter.Moniker := SysDev.GetMoniker(1); FilterGraph.Active := true; with FilterGraph as ICaptureGraphBuilder2 do CheckDSError(RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, nil, VideoWindow as IbaseFilter)); FilterGraph.Play;end;{procedure TVideoForm.SelectDevice(Sender: TObject);var hr: HResult; pXBar1, pXBar2: IAMCrossbar; pFilter: IBaseFilter;begin FilterGraph.ClearGraph; FilterGraph.Active := false; Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag); FilterGraph.Active := true; with FilterGraph as ICaptureGraphBuilder2 do CheckDSError(RenderStream(@PIN_CATEGORY_PREVIEW , nil, Filter as IBaseFilter, nil, VideoWindow as IbaseFilter)); FilterGraph.Play; with FilterGraph as ICaptureGraphBuilder2 do begin hr := FindInterface(@LOOK_UPSTREAM_ONLY, nil, Filter as IBaseFilter, IID_IAMCrossbar, pXBar1); if Succeeded(hr) then begin hr := DisplayCrossbarInfo(Handle, pXBar1); if Succeeded(hr) then Exit; // 第二个 Crossbar hr := pXBar1.QueryInterface(IID_IBaseFilter, pFilter); if Failed(hr) then Exit; hr := FindInterface(@LOOK_UPSTREAM_ONLY, nil, pFilter, IID_IAMCrossbar, pXBar2); if Succeeded(hr) then begin DisplayCrossbarInfo(Handle, pXBar2); end; end; end;end;}{procedure TVideoForm.SelectDevice(Sender: TObject);var pcrossbar: IAMCrossbar; Hr: HRESULT; I_index: integer;begin FilterGraph.ClearGraph; FilterGraph.Active := False; //showmessage(Filter.BaseFilter);//Moniker:别名 Filter.BaseFilter.Moniker := SysDev.GetMoniker(Button1.tag); FilterGraph.Active := True; //PinsShow(Sender);{ begin Hr := (FilterGraph as ICaptureGraphBuilder2).FindInterface(@LOOK_UPSTREAM_ONLY, nil, Filter as IBaseFilter, IID_IAMCrossbar, pcrossbar); I_index := 20; if Succeeded(Hr) then begin pcrossbar.Route(0, I_index); //注意这个 I_Index就是输入视频源的序号,好像是从1开始的 //pcrossbar := nil; end; end; with FilterGraph as ICaptureGraphBuilder2 do if RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, SampleGrabber1 as IBaseFilter, VideoWindow as IbaseFilter) = 0 then exit; FilterGraph.Play;end;}{procedure TVideoForm.SelectDevice(Sender: TObject);var CaptureVideo: boolean; AMStreamConfig: IAMStreamConfig; AMStreamConfigC: IAMStreamConfig; Multiplexer: IBaseFilter; Writer: IFileSinkFilter; strOutFileName: WideString;begin //ShowMessage('VideoWidth:' + IntToStr(FVideoWidth) + ', VideoHeight:' + IntToStr(FVideoHeight)); try FilterGraph.ClearGraph; FilterGraph.Active := False; Filter.BaseFilter.Moniker := SysDev.GetMoniker(1); FilterGraph.Active := True; with FilterGraph as ICaptureGraphBuilder2 do begin //设置制式... SetCaptureAnalog(Filter as IBaseFilter, FAnalogVideo); //设置PREVIEW色深、分辩率... FindInterface(@PIN_CATEGORY_PREVIEW, @MEDIATYPE_Video, Filter as IBaseFilter, IID_IAMStreamConfig, AMStreamConfig); SetCustomMediaBitCount(AMStreamConfig, FColorBit); SetCaptureScale1(AMStreamConfig, FVideoWidth, FVideoHeight); //设置CAPTURE色深、分辩率 if CaptureVideo then begin FindInterface(@PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, Filter as IBaseFilter, IID_IAMStreamConfig, AMStreamConfigC); SetCustomMediaBitCount(AMStreamConfigC, FColorBit); SetCaptureScale1(AMStreamConfigC, FVideoWidth, FVideoHeight); //视频输出文件... strOutFileName := CaptureFileName; SetOutPutFileName(MEDIASUBTYPE_Avi, PWideChar(strOutFileName), Multiplexer, Writer); //链接视频Capture... RenderStream(@PIN_CATEGORY_CAPTURE, nil, Filter as IBaseFilter, Encoder as IBaseFilter, Multiplexer); end; //if CaptureVideo... //链接视频PREVIEW... RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, nil, VideoWindow as IBaseFilter); end; //with... FilterGraph.Play; if CaptureVideo then InCapturing := True; DriverOpened := True; except InCapturing := False; DriverOpened := False; end; //try...except...end; }procedure TVideoForm.FormClose(Sender: TObject; var Action: TCloseAction);begin SysDev.Free; FilterGraph.ClearGraph; FilterGraph.Active := false;end;procedure TVideoForm.FormDestroy(Sender: TObject);begin VMRBitmap.Free;end;procedure TurnBMP(S: string);var MyJPEG: TJPEGImage; MyBMP: TBitmap; Image1: TImage; I: integer; F1: string; F2: string;begin Image1 := TImage.Create(nil); MyJPEG := TJPEGImage.Create; MyBMP := TBitmap.Create; F1 := S; F2 := ChangeFileExt(F1, '.JPG'); Image1.Picture.LoadFromFile(F1); MyBMP.Assign(Image1.Picture.Graphic); MyJPEG.Assign(MyBMP); MyJPEG.CompressionQuality := 100; //压缩比例 MyJPEG.Compress; MyJPEG.SaveToFile(F2); //保存路径…… MyBMP.Free; MyJPEG.Free; Image1.Free;end;procedure PartJPEG(P: string);var R0, R1: TRect; Bmp: TBitmap; Image1: TImage; JP: TJpegImage; ID, TD: integer; Saved: Boolean; WW, HH: integer; W1, W2: integer;begin Image1 := TImage.Create(nil); Image1.Picture.LoadFromFile(P); WW := Image1.Picture.Width; HH := Image1.Picture.Height; Image1.Width := WW; Image1.Height := HH; Bmp := TBitmap.Create; BMP.Assign(Image1.Picture.Graphic); Image1.Picture := nil; W1 := WW * 1 div 4; W2 := WW * 3 div 4; R0 := Rect(00, 00, WW div 2, HH); R1 := Rect(W1, 00, W2, HH); Image1.Width := WW div 2; Image1.Canvas.CopyRect(R0, BMP.Canvas, R1); Bmp.Free; JP := TJpegImage.Create; JP.Assign(Image1.Picture.Bitmap); JP.CompressionQuality := 100; JP.Compress; JP.SaveToFile(P); JP.Free; Image1.Free;end;procedure PartBMPP(P: string);var R0, R1: TRect; Bmp: TBitmap; Image1: TImage; JP: TJPegImage; ID, TD: integer; Saved: Boolean; WW, HH: integer; W1, W2: integer;begin Bmp := TBitmap.Create; BMP.LoadFromFile(P); WW := BMP.Width; HH := BMP.Height; Image1 := TImage.Create(nil); Image1.Width := WW; Image1.Height := HH; W1 := WW * 1 div 4; W2 := WW * 3 div 4; R0 := Rect(00, 00, WW div 2, HH); R1 := Rect(W1, 00, W2, HH); Image1.Width := WW div 2; Image1.Canvas.CopyRect(R0, BMP.Canvas, R1); Bmp.Free; JP := TJPegImage.Create; JP.Assign(Image1.Picture.Bitmap); JP.CompressionQuality := 100; JP.Compress; P := 'C:/ABCD.JPG'; JP.SaveToFile(P); JP.Free; Image1.Free;end;procedure TVideoForm.Button2Click(Sender: TObject);var S: TFileStream;begin exit; if FilterGraph.State = gsStopped then Exit; S := TFileStream.Create(BName, fmCreate); //FilterGraph.Pause; VideoWindow.VMRGetBitmap(S); S.Free; //FilterGraph.Play; //TurnBMP(BName); //读取JPG图象 PartBMPP(BName); //截取BMP图象 Image1.Picture.LoadFromFile(JName); DeleteFile(BName); DeleteFile(JName); //VMRRect(MyVideoWindow, Rect(x, y, x + 150, y + 200));end;procedure TVideoForm.ext1Click(Sender: TObject);begin with VMRBitmap, Canvas do begin LoadEmptyBitmap(300, 200, pf24bit, clSilver); Source := VMRBitmap.Canvas.ClipRect; Options := VMRBitmap.Options + [vmrbSrcColorKey]; ColorKey := clSilver; Brush.Color := clSilver; Font.Color := clWhite; Font.Style := [fsBold]; Font.Size := 30; Font.Name := 'Arial'; TextOut(0, 0, 'Hello Word '); DrawTo(0, 0, 1, 1, 0.5); end;end;procedure TVideoForm.Bitmap1Click(Sender: TObject);var Bitmap: TBitmap;begin if OpenDialog.Execute then begin Bitmap := TBitmap.Create; try Bitmap.LoadFromFile(OpenDialog.FileName); VMRBitmap.LoadBitmap(Bitmap); VMRBitmap.Source := VMRBitmap.Canvas.ClipRect; VMRBitmap.DrawTo(0.2, 0.2, 0.8, 0.8, 0.4); //参数1,2,3,4：混合位置，参照主图坐标 //参数5：混合强度 finally Bitmap.Free; end; end;end;procedure TVideoForm.Button3Click(Sender: TObject);begin //SampleGrabber1.GetBitmap(Image1.Picture.Bitmap); FilterGraph.Pause; Image1.Picture.SaveToFile('C:/ABCD1.JPG'); FilterGraph.Play;end;procedure TVideoForm.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin if button = mbLeft then begin ReleaseCapture; Panel1.Perform(wm_SYSCommand, SC_MOVE + 2, 0); end;end;procedure TVideoForm.SampleGrabber1Buffer(sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);begin// SampleGrabber1.GetBitmap(Image1.Picture.Bitmap); Image1.Canvas.Lock; try //SampleGrabber1.GetBitmap(Image1.Picture.Bitmap, pBuffer, BufferLen); finally Image1.Canvas.Unlock; end;end;function TVideoForm.SetVideoInput(Value: integer): THandle;var AMCrossbar: IAMCrossbar; n: integer;var FilterList: TFilterList; PinList: TPinList; PinInfo: TPinInfo; BaseFilter: IBaseFilter; i: integer; FI: IBaseFilter; H, S, IO: string;begin //List1.Clear; FilterGraph.ClearGraph; Filter.BaseFilter.Moniker := SysDev.GetMoniker(1); FilterGraph.Active := True; with FilterGraph as ICaptureGraphBuilder2 do begin if FindInterface(@LOOK_UPSTREAM_ONLY, nil, Filter as IBaseFilter, IID_IAMCrossBar, AMCrossBar) <> 0 then Showmessage('没有发现《AMCrossbar》接口！'); end; if AMCrossBar = nil then Exit; PinList := TPinList.Create(AMCrossBar as IBaseFilter); for i := 0 to PinList.Count - 1 do begin PinInfo := PinList.PinInfo; case PinInfo.dir of PINDIR_INPUT: IO := '输入'; //lbPins.Items.Add(format('(输入端子) %s', [PinInfo.achName])); PINDIR_OUTPUT: IO := ''; //lbPins.Items.Add(format('(输出端子) %s', [PinInfo.achName])); end; S := (IO + '接口，Pin 序号：' + inttostr(I) + ',名称:' + PinList.PinInfo.achName); begin if Failed(IPin(PinList.Items).Disconnect) then H := (S + ' 未断开') else H := (S + ' 已断开'); if IO <> '' then if Pos('Video', S) > 0 then List1.AddItem(S, nil); end; end; if AMCrossbar.Route(0, Comb1.ItemIndex + 1) <> 0 then Showmessage('没有该输入端口'); AMCrossBar := nil; with FilterGraph as ICaptureGraphBuilder2 do CheckDSError(RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, nil, VideoWindow as IbaseFilter)); FilterGraph.Play;end;procedure TVideoForm.ChangeInterface(Sender: TObject);var FilterList: TFilterList; PinList: TPinList; PinInfo: TPinInfo; BaseFilter: IBaseFilter; i, j: integer; FI: IBaseFilter; H, S, T, IO: string;begin SetVideoInput(1); exit; FilterGraph.Stop; List1.Clear; FilterList := TFilterList.Create(FilterGraph as IFilterGraph); S := ('接口数量：' + inttostr(FilterList.Count)); List1.AddItem(S, nil); if FilterList.Count > 0 then for i := 0 to FilterList.Count - 1 do begin BaseFilter := FilterList.Items as IBaseFilter; FI := BaseFilter; T := FilterList.FilterInfo.achName; PinList := TPinList.Create(BaseFilter); if PinList.Count > 0 then for j := 0 to PinList.Count - 1 do begin PinInfo := PinList.PinInfo[J]; case PinInfo.dir of PINDIR_INPUT: IO := '输入 '; //lbPins.Items.Add(format('(输入端子) %s', [PinInfo.achName])); PINDIR_OUTPUT: IO := '输出 '; //lbPins.Items.Add(format('(输出端子) %s', [PinInfo.achName])); end; S := (IO + '序号：' + inttostr(I) + ',' + T + '接口, Pin 名称:' + inttostr(J) + PinList.PinInfo[j].achName); //if Pos('Video', S) > 0 then begin if Failed(IPin(PinList.Items[j]).Disconnect) then H := ('aaa' + S + ' 未断开') else H := (S + ' 已断开'); List1.AddItem(H, nil); end; end; PinList.Free; BaseFilter := nil; end;end;end.//下面的程序欲接口没有什么关系，仅仅作为参考procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin ReleaseCapture; Panel1.Perform(WM_SYSCOMMAND, $F012, SC_MOVE); exit; Application.ProcessMessages; BitBlt(GetDc(Panel1.Handle), 0, 0, Panel1.Width, Panel1.Height, Image1.Canvas.Handle, Panel1.Left, Panel1.Top, SRCAND); DBGrid1.refresh;end;procedure TVideoForm.SnapShotClick(Sender: TObject);begin SampleGrabber.GetBitmap(Image.Picture.Bitmap);end;procedure TVideoForm.SampleGrabberBuffer(sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);begin if CallBack.Checked then begin Image.Canvas.Lock; try SampleGrabber.GetBitmap(Image.Picture.Bitmap, pBuffer, BufferLen); finally Image.Canvas.Unlock; end; end;end;sysdevice := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);.......Filter.BaseFilter.Moniker := sysdevice.GetMoniker(Vindex);Vindex视频源序列号希望对你有点用procedure CreateVideo;var pmt: PAMMediaType; pvih: ^VIDEOINFOHEADER; sysdevice: TSysDevEnum; //设备管理器begin sysdevice := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory); try //Vindex变量(int 0,1,2...) 视频源序号 之前需要初始化 if sysdevice.GetMoniker(Vindex) = nil then Exit; try FilterGraph.ClearGraph; FilterGraph.Active := False; Filter.BaseFilter.Moniker := sysdevice.GetMoniker(Vindex); FilterGraph.Active := True; with FilterGraph as ICaptureGraphBuilder2 do begin FindInterface(@PIN_CATEGORY_CAPTURE, nil, Filter as IBaseFilter, IID_IAMStreamConfig, pconfig); pconfig.GetFormat(pmt); pvih := pmt.pbFormat; pvih.bmiHeader.biWidth := VbiWidth; pvih.bmiHeader.biHeight := VbiHeight; //VbiWidth,VbiHeight变量(int) 之前需要初始化 pconfig.SetFormat(pmt^); DeleteMediaType(pmt); VideoWindow.mode := VideoMode; //VideoMode变量VideoMode: TVideoMode; (vmNormal,vmVMR,vmNormal)之前需要初始化 VideoWindow.VMROptions.KeepAspectRatio := VKeepAspectRatio; //VKeepAspectRatio变量 (true,false) 之前需要初始化 //初始化视频分辨率 SetVideoParams(FilterGraph as ICaptureGraphBuilder2, PIN_CATEGORY_CAPTURE, Filter as IBaseFilter, VbiWidth, VbiHeight); CheckDSError( RenderStream( @PIN_CATEGORY_CAPTURE, nil, Filter as ibasefilter, SampleGrabber as ibasefilter, VideoWindow as ibasefilter) ); pconfig := nil; end; FilterGraph.Play; finally sysdevice.free; end; except //do something end;end;var pcrossbar: IAMCrossbar = nil; Hr: HRESULT;begin Hr := (FilterGraph as ICaptureGraphBuilder2).FindInterface(@LOOK_UPSTREAM_ONLY, nil, Filter as IBaseFilter, IID_IAMCrossbar, pcrossbar); if Succeeded(Hr) then begin pcrossbar.Route(0, I_index); //注意这个 I_Index就是输入视频源的序号,好像是从1开始的 pcrossbar := nil; end;end;procedure TVideoForm.OnSelectDevice(sender: TObject);var PinList: TPinList; FSize: TPoint; pcrossbar: IAMCrossbar; Hr: HRESULT; I_index: Integer;begin FilterGraph.ClearGraph; FilterGraph.Active := false; Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag); FilterGraph.Active := true; with FilterGraph as ICaptureGraphBuilder2 do begin RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, SampleGrabber as IBaseFilter, VideoWindow as IbaseFilter); end; FilterGraph.Play; Hr := (FilterGraph as ICaptureGraphBuilder2).FindInterface(@LOOK_UPSTREAM_ONLY, nil, FilterGraph as IBaseFilter, IID_IAMCrossbar, pcrossbar); if Succeeded(Hr) then begin pcrossbar.Route(0, I_index); //注意这个 I_Index就是输入视频源的序号,好像是从1开始的 pcrossbar := nil; end;end;对我有用[0]丢个板砖[0]引用 举报 管理 TOPsparklerl(阿飞)等　级：#11 楼 得分：0回复于：2009 - 08 - 06 11: 57: 53 就上面的不行嘛, 把I_index赋值I_index := 2procedure TVideoForm.OnSelectDevice(sender: TObject);var CaptureGraph: ICaptureGraphBuilder2; SourceFilter, DestFilter: IBaseFilter;begin FilterGraph.ClearGraph; FilterGraph.Active := false; Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag); FilterGraph.Active := true; FilterGraph.QueryInterface(ICaptureGraphBuilder2, CaptureGraph); Filter.QueryInterface(IBaseFilter, SourceFilter); VideoWindow.QueryInterface(IBaseFilter, DestFilter); CaptureGraph.RenderStream(nil, nil, SourceFilter, nil, DestFilter); FilterGraph.Play; CaptureGraph := nil; SourceFilter := nil; DestFilter := nil;end;dspack采集视频卡时遇到 输入端子切换问题～从网上到的代码：CaptureGraph.FindInterface(@LOOK_UPSTREAM_ONLY, nil, SourceFilter, IID_IAMCrossBar, AMCrossBar);AMCrossbar.CanRoute(0, n); //n 值为 2或3但是无法切换s端子和av端子盼望高手指教，并再开帖送300分表示敬意procedure TVideoForm.OnSelectDevice(sender: TObject);var pin1: Ipin;begin FilterGraph.ClearGraph; FilterGraph.Active := false; Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag); FilterGraph.Active := true; with FilterGraph as ICaptureGraphBuilder2 do //找pin脚 FindInterface(nil, nil, Filter as IBaseFilter, IID_Ipin, pin1); with FilterGraph as ICaptureGraphBuilder2 do RenderStream(nil, nil, Filter as IBaseFilter, SampleGrabber as IBaseFilter, VideoWindow as IbaseFilter); FilterGraph.Play;end;你可以使用IAMcrossbar interface 来取得!用get_pincounts来取得所有的PIN，get_crossbarpinfo 来取得PIN再用route来启用一个PIN!!!!!!!PhysConn_Video_SVideo类型的为S端子，以下是类型PhysConn_Video_Tuner = 1,PhysConn_Video_Composite,PhysConn_Video_SVideo,PhysConn_Video_RGB,PhysConn_Video_YRYBY,PhysConn_Video_SerialDigital,PhysConn_Video_ParallelDigital,PhysConn_Video_SCSI,PhysConn_Video_AUX,PhysConn_Video_1394,PhysConn_Video_USB,PhysConn_Video_VideoDecoder,PhysConn_Video_VideoEncoder,PhysConn_Video_SCART,PhysConn_Audio_Tuner = 4096,PhysConn_Audio_Line,PhysConn_Audio_Mic,PhysConn_Audio_AESDigital,PhysConn_Audio_SPDIFDigital,PhysConn_Audio_SCSI,PhysConn_Audio_AUX,PhysConn_Audio_1394,PhysConn_Audio_USB,PhysConn_Audio_AudioDecoder,* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *CLSID_CrossbarFilterPropertyPage选建立crossbarfilter,filter_crossbar: ibasefilter;tmp_crossbar: iamcrossbar;filter_crossbarfilter := createcomobject(clsid_crossbarfilterpropertypage) as ibasefilter;//可以直接用showfilterpropertypage(filter_corssbarfilter)来显示对话框;//你也可以用graphbuilder: Igraphbuilder2;filtergraph.queryinterface(IGraphbuilder2, graphbuilder);graphbuilder.findinterface(IID_Iamcrossbar, tmp_crossbar);.........再进行操作!来自：coolsoft, 时间：2003 - 4 - 5 10: 28: 00, ID：1739893或者你可以先得到它的AM_KSCATEGORY_CROSSBARTSysDevEnum.Create(AM_KSCATEGORY_CROSSBAR);SysDev.SelectIndexCategory(0);得到crossbarfilter再来进行操作!三种方法都可以的!来自：oldfly, 时间：2003 - 4 - 5 12: 17: 00, ID：1740256问题解决了！谢谢coolsoft了！！！等我把两个贴子的分给你！再加你300分！你试试这段：function DisplayCrossbarInfo(wnd: HWND; pXBar: IAMCrossbar): HResult;var pPage: ISpecifyPropertyPages; uid: CAUUID;begin Result := pXBar.QueryInterface(IID_ISpecifyPropertyPages, pPage); if Failed(Result) then Exit; Result := pPage.GetPages(uid); if Failed(Result) then Exit; Result := OleCreatePropertyFrame(wnd, 0, 0, '', 1, @pXBar, uid.cElems, uid.pElems, 0, 0, nil); if Failed(Result) then Exit; CoTaskMemFree(uid.pElems);end;procedure TVideoForm.OnSelectDevice(sender: TObject);var PinList: TPinList; FSize: TPoint; pcrossbar: IAMCrossbar; Hr: HRESULT; I_index: Integer;begin FilterGraph.ClearGraph; FilterGraph.Active := false; Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag); FilterGraph.Active := true; with FilterGraph as ICaptureGraphBuilder2 do begin RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, SampleGrabber as IBaseFilter, VideoWindow as IbaseFilter); end; FilterGraph.Play; Hr := (FilterGraph as ICaptureGraphBuilder2).FindInterface(@LOOK_UPSTREAM_ONLY, nil, FilterGraph as IBaseFilter, IID_IAMCrossbar, pcrossbar); if Succeeded(Hr) then begin pcrossbar.Route(0, I_index); //注意这个 I_Index就是输入视频源的序号,好像是从1开始的 pcrossbar := nil; end;end;{请熟悉DShow接口的朋友帮我看看下面的代码，其问题是图像有马赛克，而且在窗口关闭时出读地址错。unit main;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, DSUtil, StdCtrls, DSPack, DirectShow9, Menus, ExtCtrls, ComCtrls, ExtDlgs, ActiveX;type TVideoForm = class(TForm) MainMenu1: TMainMenu; Devices: TMenuItem; SavePictureDialog1: TSavePictureDialog; Bitmap1: TMenuItem; Setup1: TMenuItem; Bitmap2: TMenuItem; Callback1: TMenuItem; VideoSize1: TMenuItem; N320X2401: TMenuItem; N640X4801: TMenuItem; N720X5761: TMenuItem; Debug1: TMenuItem; procedure FormCreate(Sender: TObject); procedure N720X5761Click(Sender: TObject); procedure FormResize(Sender: TObject); procedure FormDestroy(Sender: TObject); private public end;var VideoForm: TVideoForm; //DirectShow 接口定义 GraphBuilder : IGraphBuilder; CaptureGraphBuilder : ICaptureGraphBuilder2; MediaControl : IMediaControl; MediaSeeking : IMediaSeeking; MediaPosition : IMediaPosition; MediaEventEx : IMediaEventEx; BasicAudio : IBasicAudio; BasicVideo : IBasicVideo; VideoWindow : IVideoWindow; SampleGrabber : ISampleGrabber; VideoFrameStep : IVideoFrameStep; CreateDevEnum : ICreateDevEnum; EnumMoniker : IEnumMoniker;implementation{$R *.dfm}procedure TVideoForm.FormCreate(Sender: TObject);var HR: HResult; DebugMsg: string; Moniker: IMoniker; cFetched: PLongInt; BaseFilter: IBaseFilter;begin Self.Width := 640; Self.Height := 480; Self.Left := (Screen.Width - Self.Width) div 2; Self.Top := (Screen.Height - Self.Height) div 2; //初始化接口... try HR := CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER, IID_IGraphBuilder, GraphBuilder); if not Succeeded(HR) then Exit; DebugMsg := 'GraphBuilder Created！'; HR := CoCreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC_SERVER, IID_ICaptureGraphBuilder2, CaptureGraphBuilder); if not Succeeded(HR) then Exit; DebugMsg := 'CaptureGraphBuilder Created！'; GraphBuilder.QueryInterface(IID_IMediaControl, MediaControl); GraphBuilder.QueryInterface(IID_IMediaEventEx, MediaEventEx); GraphBuilder.QueryInterface(IID_IVideoWindow, VideoWindow); MediaEventEx.SetNotifyWindow(Self.Handle, WM_GRAPHNOTIFY, 0); CaptureGraphBuilder.SetFiltergraph(GraphBuilder); //设备枚举 HR := CoCreateInstance(CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC_SERVER, IID_ICreateDevEnum, CreateDevEnum); if not Succeeded(HR) then Exit; CreateDevEnum.CreateClassEnumerator(CLSID_VideoInputDeviceCategory, EnumMoniker, 0); if EnumMoniker = nil then Exit; if EnumMoniker.Next(1, Moniker, cFetched) = S_OK then begin Moniker.BindToObject(nil, nil, IID_IBaseFilter, BaseFilter); Moniker := nil; end else Exit; //将设备添加到graph HR := GraphBuilder.AddFilter(BaseFilter, 'Video Capture'); if not Succeeded(HR) then Exit; //连接源... HR := CaptureGraphBuilder.RenderStream(nil, nil, BaseFilter, nil, nil); if not Succeeded(HR) then Exit; //视频窗口... HR := VideoWindow.put_Owner(Self.Handle); if not Succeeded(HR) then Exit; HR := VideoWindow.put_WindowStyle(WS_CHILD and WS_CLIPCHILDREN); if not Succeeded(HR) then Exit; VideoWindow.SetWindowPosition(0, 0, 640, 480); VideoWindow.put_Visible(True); // MediaControl.Run; finally Self.Caption := DebugMsg; end;end;procedure TVideoForm.FormDestroy(Sender: TObject);begin CaptureGraphBuilder := nil; GraphBuilder := nil; MediaControl := nil; MediaEventEx := nil; VideoWindow := nil; CreateDevEnum := nil; EnumMoniker := nil;end;end.}Hr := (FilterGraph as ICaptureGraphBuilder2).FindInterface(@LOOK_UPSTREAM_ONLY, nil, FilterGraph as IBaseFilter, IID_IAMCrossbar, pcrossbar);还是pcrossbar.Route(0, I_index);sysdevice := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);.......Filter.BaseFilter.Moniker := sysdevice.GetMoniker(Vindex);2009 - 08 - 24 04: 11: 44 　 齐楚秦 Hr := (FilterGraph as ICaptureGraphBuilder2).FindInterface(@PIN_CATEGORY_PREVIEW, nil, FilterGraph as IBaseFilter, IID_IAMCrossbar, pcrossbar);换成这样试试Delphi(Pascal)code var pcrossbar: IAMCrossbar = nil; Hr: HRESULT; begin Hr := (FilterGraph as ICaptureGraphBuilder2).FindInterface(@LOOK_UPSTREAM_ONLY, nil, Filter as IBaseFilter, IID_IAMCrossbar, pcrossbar); if Succeeded(Hr) then begin pcrossbar.Route(0, I_index); //注意这个 I_Index就是输入视频源的序号,好像是从1开始的 pcrossbar := nil; end; end; 这个是在 视频初始化完成之后执行的 使用DirectShow开发视频采集程序 发表: 不详 阅读: 5847 次 关键字：不详 字体: [大 中 小]{******************************************************************* 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;interfaceuses 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;implementationvar 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< > p2.D4 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;// 创建graphfunction CDSCapture.MakeGraph: Boolean;begin Result := True; if Graph < > nil then Exit; if CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC, IID_IGraphBuilder, Graph)< > NOERROR then Result := False;end;function CDSCapture.InitCapFilters: Boolean;label InitCapFiltersFail, SkipAudio;var PropBag: IPropertyBag; hr: HRESULT; varOle: OleVariant; //tmt : TAM_MEDIA_TYPE; pmt: PAM_MEDIA_TYPE; pvih: PVIDEOINFOHEADER; Pin: IPin; pins: IEnumPins; n: Cardinal; pinInfo: TPIN_INFO; Found: Boolean; Ks: IKsPropertySet; guid: TGUID; dw: DWORD; fMatch: Boolean;begin hr := 0; Result := MakeBuilder; if Result = False then begin ErrMsg('Cannot instantiate graph builder'); Exit; end; VCap := nil; if mVideo < > nil then begin hr := mVideo.BindToStorage(nil, nil, IID_IPropertyBag, PropBag); if Succeeded(hr) then begin PropBag.Read('FriendlyName', varOle, nil); if hr = NOERROR then wachFriendlyName := varOle; PropBag := nil; end; hr := mVideo.BindToObject(nil, nil, IID_IBaseFilter, VCap); end; if VCap = nil then begin ErrMsg('Error %x: Cannot create video capture filter', hr); goto InitCapFiltersFail; end; // // 创建filtergraph, 付给构造对象连接视频 // 采集Filter // Result := MakeGraph; if Result = False then begin ErrMsg('Cannot instantiate filtergraph'); goto InitCapFiltersFail; end; hr := Builder.SetFiltergraph(Graph); if hr < > NOERROR then begin ErrMsg('Cannot give graph to builder'); goto InitCapFiltersFail; end; hr := Graph.AddFilter(VCap, nil); if hr < > NOERROR then begin ErrMsg('Error %x: Cannot add vidcap to filtergraph', hr); goto InitCapFiltersFail; end; // 调用FindInterface，确定流的源(如WDM TVTuners或Crossbars) // 用于得到驱动程序名称，端口连接前此界面可能无效 //或根本无法调用 hr := Builder.FindInterface(@PIN_CATEGORY_CAPTURE, @MEDIATYPE_Interleaved, VCap, @IID_IAMVideoCompression, VideoCompression); if hr < > S_OK then begin Builder.FindInterface(@PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, VCap, @IID_IAMVideoCompression, VideoCompression); end; // 设置帧速率和采集尺寸 hr := Builder.FindInterface(@PIN_CATEGORY_CAPTURE, @MEDIATYPE_Interleaved, VCap, @IID_IAMStreamConfig, VStreamConf); if hr < > NOERROR then begin hr := Builder.FindInterface(@PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, VCap, @IID_IAMStreamConfig, VStreamConf); if hr < > NOERROR then begin // this means we can't set frame rate (non-DV only) ErrMsg('Error %x: Cannot find VCapture:IAMStreamConfig', hr); end; end; fCapAudioIsRelevant := True; // 缺省采集格式 if (VStreamConf < > nil) and (VStreamConf.GetFormat(pmt) = S_OK) then begin // DV capture 不使用VIDEOINFOHEADER if CheckGUID(pmt^.formattype, FORMAT_VideoInfo) then begin // 窗口大小调整 gnRecurse := 0; pvih := pmt.pbFormat; ResizeWindow(pvih^.bmiHeader.biWidth, abs(pvih^.bmiHeader.biHeight)); end; if not CheckGUID(pmt^.majortype, MEDIATYPE_Video) then begin // 此采集filter 采集其他视频. fCapAudioIsRelevant := False; fCapAudio := False; end; DeleteMediaType(pmt); end; // 显示对话框 // NOTE: 仅VFW支持 Builder.FindInterface(@PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, VCap, @IID_IAMVfwCaptureDialogs, CaptureDialogs); Found := False; fMatch := False; Pin := nil; if Succeeded(VCap.EnumPins(pins)) then begin while not Found and (S_OK = pins.Next(1, pin, n)) do begin if S_OK = pin.QueryPinInfo(pinInfo) then begin if pinInfo.dir = PINDIR_INPUT then begin // ANALOGVIDEOIN input pin? if pin.QueryInterface(IID_IKsPropertySet, Ks) = S_OK then begin if Ks.Get(AMPROPSETID_Pin, 0, nil, 0, @guid, sizeof(TGUID), dw) = S_OK then begin if CheckGuid(guid, PIN_CATEGORY_ANALOGVIDEOIN) then fMatch := True; end; Ks := nil; end; if fMatch then begin Found := TRUE; end; end; pinInfo.pFilter := nil; end; pin := nil; end; pins := nil; end; // there's no point making an audio capture filter if fCapAudioIsRelevant = False then goto SkipAudio; // 创建音频采集filter, 尽管可能用不到 if mAudio = nil then begin // 不采集音频 fCapAudio := FALSE; goto SkipAudio; end; ACap := nil; mAudio.BindToObject(nil, nil, IID_IBaseFilter, ACap); if ACap = nil then begin // 不采集音频 fCapAudio := FALSE; ErrMsg('Cannot create audio capture filter'); goto SkipAudio; end; // // 放置音频插件 // hr := Graph.AddFilter(ACap, nil); if hr < > NOERROR then begin ErrMsg('Error %x: Cannot add audcap to filtergraph', hr); goto InitCapFiltersFail; end; // Calling FindInterface below will result in building the upstream // section of the capture graph (any WDM TVAudio's or Crossbars we might // need). // !!! What if this interface isn't supported? // we use this interface to set the captured wave format hr := Builder.FindInterface(@PIN_CATEGORY_CAPTURE, @MEDIATYPE_Audio, ACap, @IID_IAMStreamConfig, AStreamConf); if hr < > NOERROR then begin ErrMsg('Cannot find ACapture:IAMStreamConfig'); end; SkipAudio: // Can this filter do closed captioning? FillChar(guid, SizeOf(TGUID), 0); hr := Builder.FindPin(VCap, PINDIR_OUTPUT, @PIN_CATEGORY_VBI, nil, FALSE, 0, Pin); if hr < > S_OK then hr := Builder.FindPin(VCap, PINDIR_OUTPUT, @PIN_CATEGORY_CC, nil, FALSE, 0, Pin); if hr = S_OK then begin Pin := nil; fCCAvail := TRUE; end else fCapCC := FALSE; // can't capture it, then // potential debug output - what the graph looks like // DumpGraph(gcap.pFg, 1); Result := TRUE; Exit; InitCapFiltersFail: FreeCapFilters; Result := False; Exit;end;// build the preview graph!//// !!! PLEASE NOTE !!! Some new WDM devices have totally separate capture// and preview settings. An application that wishes to preview and then// capture may have to set the preview pin format using IAMStreamConfig on the// preview pin, and then again on the capture pin to capture with that format.// In this sample app, there is a separate page to set the settings on the// capture pin and one for the preview pin. To avoid the user// having to enter the same settings in 2 dialog boxes, an app can have its own// UI for choosing a format (the possible formats can be enumerated using// IAMStreamConfig) and then the app can programmatically call IAMStreamConfig// to set the format on both pins.//function CDSCapture.BuildPreviewGraph: Boolean;var cy, cyBorder: Integer; hr: HRESULT; pmt: PAM_MEDIA_TYPE; rc: TRect; pvih: PVIDEOINFOHEADER;begin // we have one already if fPreviewGraphBuilt then begin Result := True; Exit; end; Result := False; // No rebuilding while we're running if fCapturing or fPreviewing then Exit; // We don't have the necessary capture filters if VCap = nil then Exit; if (ACap = nil) and fCapAudio then Exit; // we already have another graph built... tear down the old one if fCaptureGraphBuilt then TearDownGraph; // // Render the preview pin - even if there is not preview pin, the capture // graph builder will use a smart tee filter and provide a preview. // // !!! what about latency/buffer issues? // NOTE that we try to render the interleaved pin before the video pin, because // if BOTH exist, it's a DV filter and the only way to get the audio is to use // the interleaved pin. Using the Video pin on a DV filter is only useful if // you don't want the audio. hr := Builder.RenderStream(@PIN_CATEGORY_PREVIEW, @MEDIATYPE_Interleaved, VCap, nil, nil); if hr = VFW_S_NOPREVIEWPIN then begin // preview was faked up for us using the (only) capture pin fPreviewFaked := TRUE; end else if hr < > S_OK then begin // maybe it's DV? hr := Builder.RenderStream(@PIN_CATEGORY_PREVIEW, @MEDIATYPE_Video, VCap, nil, nil); if hr = VFW_S_NOPREVIEWPIN then begin // preview was faked up for us using the (only) capture pin fPreviewFaked := TRUE; end else if hr < > S_OK then begin ErrMsg('This graph cannot preview!'); end; end; // // Render the closed captioning pin? It could be a CC or a VBI category pin, // depending on the capture driver // if fCapCC then begin hr := Builder.RenderStream(@PIN_CATEGORY_CC, nil, VCap, nil, nil); if hr < > NOERROR then begin hr := Builder.RenderStream(@PIN_CATEGORY_VBI, nil, VCap, nil, nil); if hr < > NOERROR then begin ErrMsg('Cannot render closed captioning'); // so what? goto SetupCaptureFail; end; end; end; // // Get the preview window to be a child of our app's window // // This will find the IVideoWindow interface on the renderer. It is // important to ask the filtergraph for this interface... do NOT use // ICaptureGraphBuilder2::FindInterface, because the filtergraph needs to // know we own the window so it can give us display changed messages, etc. hr := Graph.QueryInterface(IID_IVideoWindow, VideoWindow); if hr < > NOERROR then begin ErrMsg('This graph cannot preview properly'); end else begin VideoWindow.put_Owner(hwOwner); // We own the window now VideoWindow.put_WindowStyle(WS_CHILD); // you are now a child // give the preview window all our space but where the status bar is GetClientRect(hwOwner, rc); cyBorder := GetSystemMetrics(SM_CYBORDER); cy := cyBorder; // + statusGetHeight(); rc.bottom := rc.bottom - cy; VideoWindow.SetWindowPosition(0, 0, rc.right, rc.bottom); // be this big VideoWindow.put_Visible(TRUE); end; // now tell it what frame rate to capture at. Just find the format it // is capturing with, and leave everything alone but change the frame rate // No big deal if it fails. It's just for preview // !!! Should we then talk to the preview pin? if (VStreamConf < > nil) and fUseFrameRate then begin hr := VStreamConf.GetFormat(pmt); // DV capture does not use a VIDEOINFOHEADER if hr = NOERROR then begin if CheckGuid(pmt^.formattype, FORMAT_VideoInfo) then begin pvih := pmt^.pbFormat; pvih^.AvgTimePerFrame := round(10000000 / FrameRate); hr := VStreamConf.SetFormat(pmt^); if hr < > NOERROR then ErrMsg('%x: Cannot set frame rate for preview', hr); end; DeleteMediaType(pmt); end; end; // make sure we process events while we're previewing! hr := Graph.QueryInterface(IID_IMediaEventEx, MediaEvent); if hr = NOERROR then begin MediaEvent.SetNotifyWindow(hwOwner, WM_FGNOTIFY, 0); end; // All done. // potential debug output - what the graph looks like // DumpGraph(gcap.pFg, 1); fPreviewGraphBuilt := TRUE; Result := True;end;// Start previewing//function CDSCapture.StartPreview: Boolean;var MC: IMediaControl; hr: HRESULT;begin // way ahead of you if fPreviewing then begin Result := True; Exit; end; Result := False; if not fPreviewGraphBuilt then Exit; // run the graph hr := Graph.QueryInterface(IID_IMediaControl, MC); if Succeeded(hr) then begin hr := MC.Run; if FAILED(hr) then begin // stop parts that ran MC.Stop; end; MC := nil; end; if FAILED(hr) then begin ErrMsg('Error %x: Cannot run preview graph', hr); Exit; end; fPreviewing := TRUE; Result := True;end;// stop the preview graph//function CDSCapture.StopPreview: Boolean;var MC: IMediaControl; hr: HRESULT;begin Result := False; // way ahead of you if not fPreviewing then Exit; // stop the graph MC := nil; if Graph < > nil then begin hr := Graph.QueryInterface(IID_IMediaControl, MC); if SUCCEEDED(hr) then begin hr := MC.Stop; MC := nil; end; if FAILED(hr) then begin ErrMsg('Error %x: Cannot stop preview graph', hr); Exit; end; end; fPreviewing := FALSE; // !!! get rid of menu garbage InvalidateRect(hwOwner, nil, TRUE); Result := TRUE;end;// Tear down everything downstream of a given filterprocedure CDSCapture.NukeDownstream(pf: IBaseFilter);var pP, pTo: IPin; u: Cardinal; pins: IEnumPins; pininfo: TPIN_INFO; hr: HRESULT;begin //DbgLog((LOG_TRACE,1,TEXT("Nuking..."))); pins := nil; hr := pf.EnumPins(pins); pins.Reset; while hr = NOERROR do begin hr := pins.Next(1, pP, u); if (hr = S_OK) and (pP < > nil) then begin pP.ConnectedTo(pTo); if pTo < > nil then begin hr := pTo.QueryPinInfo(pininfo); if hr = NOERROR then begin if pininfo.dir = PINDIR_INPUT then begin NukeDownstream(pininfo.pFilter); Graph.Disconnect(pTo); Graph.Disconnect(pP); Graph.RemoveFilter(pininfo.pFilter); end; pininfo.pFilter := nil; end; pTo := nil; end; pP := nil; end; end; pins := nil;end;// Tear down everything downstream of the capture filters, so we can build// a different capture graph. Notice that we never destroy the capture filters// and WDM filters upstream of them, because then all the capture settings// we've set would be lost.//procedure CDSCapture.TearDownGraph;begin Sink := nil; ConfigAviMux := nil; Render := nil; if VideoWindow < > nil then begin // stop drawing in our window, or we may get wierd repaint effects VideoWindow.put_Owner(0); VideoWindow.put_Visible(FALSE); end; VideoWindow := nil; MediaEvent := nil; DroppedFrames := nil; // destroy the graph downstream of our capture filters if VCap < > nil then NukeDownstream(VCap); if ACap < > nil then NukeDownstream(ACap); // potential debug output - what the graph looks like // if (gcap.pFg) DumpGraph(gcap.pFg, 1); fCaptureGraphBuilt := FALSE; fPreviewGraphBuilt := FALSE; fPreviewFaked := FALSE;end;// all done with the capture filters and the graph builder//procedure CDSCapture.FreeCapFilters;begin Graph := nil; Builder := nil; VCap := nil; ACap := nil; AStreamConf := nil; VStreamConf := nil; VideoCompression := nil; CaptureDialogs := nil;end;// make sure the preview window inside our window is as big as the// dimensions of captured video, or some capture cards won't show a preview.// (Also, it helps people tell what size video they're capturing)// We will resize our app's window big enough so that once the status bar// is positioned at the bottom there will be enough room for the preview// window to be w x h//procedure CDSCapture.ResizeWindow(w, h: Integer);var rcW, rcC: TRECT; cyBorder, xExtra, yExtra: Integer;begin cyBorder := GetSystemMetrics(SM_CYBORDER); gnRecurse := gnRecurse + 1; GetWindowRect(hwOwner, rcW); GetClientRect(hwOwner, rcC); xExtra := rcW.right - rcW.left - rcC.right; yExtra := rcW.bottom - rcW.top - rcC.bottom + cyBorder; // + statusGetHeight(); rcC.right := w; rcC.bottom := h; SetWindowPos(hwOwner, 0, 0, 0, rcC.right + xExtra, rcC.bottom + yExtra, SWP_NOZORDER or SWP_NOMOVE); // we may need to recurse once. But more than that means the window cannot // be made the size we want, trying will just stack fault. // if gnRecurse = 1 then if ((rcC.right + xExtra < > rcW.right - rcW.left) and (w > GetSystemMetrics(SM_CXMIN))) or (rcC.bottom + yExtra < > rcW.bottom - rcW.top) then ResizeWindow(w, h); gnRecurse := gnRecurse - 1;end;function CDSCapture.EnumVideoDevices: string;begin if EnumVD < NumVD then begin Result := VideoDevices[EnumVD].szName; EnumVD := EnumVD + 1; end else begin Result := '; EnumVD := 0; end;end;function CDSCapture.EnumAudioDevices: string;begin if EnumAD < NumAD then begin Result := AudioDevices[EnumAD].szName; EnumAD := EnumAD + 1; end else begin Result := '; EnumAD := 0; end;end;procedure CDSCapture.ChooseDevices(nmVideo, nmAudio: IMoniker);begin if (mVideo < > nmVideo) or (mAudio < > nmAudio) then begin if nmVideo < > nil then nmVideo._AddRef; if nmAudio < > nil then nmAudio._AddRef; mVideo := nil; mAudio := nil; mVideo := nmVideo; mAudio := nmAudio; if fCaptureGraphBuilt or fPreviewGraphBuilt then TearDownGraph; FreeCapFilters; InitCapFilters; if fWantPreview then begin BuildPreviewGraph; StartPreview; end; end;end;procedure CDSCapture.ChooseDevices(szVideo, szAudio: string);var nmVideo, nmAudio: IMoniker; i: Word;begin nmVideo := nil; nmAudio := nil; if szVideo < > ' then if szVideo[1] = ' &amp; ' then szVideo := Copy( szVideo, 2, Length( szVideo ) - 1 ); if szAudio < > ' then if szAudio[1] = ' &amp; ' then szAudio := Copy( szAudio, 2, Length( szAudio ) - 1 ); i := 0; while i < NumVD do begin if VideoDevices.szName = szVideo then nmVideo := VideoDevices.moniker; i := i + 1; end; i := 0; while i < NumAD do begin if AudioDevices.szName = szAudio then nmAudio := AudioDevices.moniker; i := i + 1; end; ChooseDevices(nmVideo, nmAudio); nmVideo := nil; nmAudio := nil;end;procedure CDSCapture.BuildDeviceList;var SysDevEnum: ICreateDevEnum; EnumCat: IEnumMoniker; Moniker: IMoniker; cFetched: Longint; PropBag: IPropertyBag; varName: OleVariant;begin SysDevEnum := nil; CoCreateInstance(CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, SysDevEnum); //SysDevEnum.CreateClassEnumerator( CLSID_VideoCompressorCategory, EnumCat, 0 ); // enum available video capture devices EnumCat := nil; SysDevEnum.CreateClassEnumerator(CLSID_VideoInputDeviceCategory, EnumCat, 0); while EnumCat.Next(1, Moniker, @cFetched) = S_OK do begin Moniker.BindToStorage(nil, nil, IID_IPropertyBag, PropBag); PropBag.Read('FriendlyName', varName, nil); NumVD := NumVD + 1; SetLength(VideoDevices, NumVD); VideoDevices[NumVD - 1].szName := varName; VideoDevices[NumVD - 1].moniker := Moniker; PropBag := nil; Moniker := nil; end; // enum available audio capture devices EnumCat := nil; SysDevEnum.CreateClassEnumerator(CLSID_AudioInputDeviceCategory, EnumCat, 0); while EnumCat.Next(1, Moniker, @cFetched) = S_OK do begin Moniker.BindToStorage(nil, nil, IID_IPropertyBag, PropBag); PropBag.Read('FriendlyName', varName, nil); NumAD := NumAD + 1; SetLength(AudioDevices, NumAD); AudioDevices[NumAD - 1].szName := varName; AudioDevices[NumAD - 1].Moniker := Moniker; PropBag := nil; Moniker := nil; end; EnumCat := nil; SysDevEnum := nil;end;function CDSCapture.Init: Boolean;begin Result := False; // Create the filter graph. if CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC, IID_IGraphBuilder, Graph)< > S_OK then Exit; // Create the capture graph builder. if CoCreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC, IID_ICaptureGraphBuilder2, Builder)< > S_OK then Exit; Builder.SetFiltergraph(Graph); BuildDeviceList; Result := (NumVD > 0) or (NumAd > 0);end;function CDSCapture.ErrMsg(szMsg: string; hr: HRESULT = 0): Boolean;begin MessageBox(GetForegroundWindow, PChar(szMsg), 'DirectShow - Capture', MB_OK or MB_ICONSTOP); Result := False;end;procedure CDSCapture.CleanUp;begin Graph := nil; Builder := nil; VideoWindow := nil; MediaEvent := nil; DroppedFrames := nil; VideoCompression := nil; CaptureDialogs := nil; AStreamConf := nil; VStreamConf := nil; Render := nil; VCap := nil; ACap := nil; Sink := nil; ConfigAviMux := nil;end;constructor CDSCapture.Create(handle: HWND);begin CleanUp; hwOwner := handle;end;destructor CDSCapture.Destroy;begin StopPreview; CleanUp;end;end.procedure TVideoForm.OnSelectDevice(sender: TObject);var PinList: TPinList; FSize: TPoint; pcrossbar: IAMCrossbar; Hr: HRESULT; I_index: Integer;begin FilterGraph.ClearGraph; FilterGraph.Active := false; Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag); FilterGraph.Active := true; with FilterGraph as ICaptureGraphBuilder2 do begin RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, SampleGrabber as IBaseFilter, VideoWindow as IbaseFilter); end; FilterGraph.Play; Hr := (FilterGraph as ICaptureGraphBuilder2).FindInterface(@LOOK_UPSTREAM_ONLY, nil, FilterGraph as IBaseFilter, IID_IAMCrossbar, pcrossbar); if Succeeded(Hr) then begin pcrossbar.Route(0, I_index); //注意这个 I_Index就是输入视频源的序号,好像是从1开始的 pcrossbar := nil; end;end;// configure output Video media typeif VideoSourceFilter.FilterGraph <> nil thenbegin PinList := TPinList.Create(VideoSourceFilter as IBaseFilter); if VideoFormats.ItemIndex <> -1 then// with (PinList[1] as Iamoviesetup) do with (PinList.Items[InputLines.ItemIndex] as IAMStreamConfig) do SetFormat(VideoMediaTypes.Items[VideoFormats.ItemIndex].AMMediaType^); PinList.Free;end;// now render streamswith CaptureGraph as IcaptureGraphBuilder2 dobegin // set the output filename MEDIASUBTYPE_ASF SetOutputFileName(MEDIASUBTYPE_AVI, PWideChar(CapFile), multiplexer, Writer); // Connect Video preview (VideoWindow) if VideoSourceFilter.BaseFilter.DataLength > 0 then RenderStream(@PIN_CATEGORY_PREVIEW, nil, VideoSourceFilter as IBaseFilter, VCompFilter as IBaseFilter, VideoWindow as IBaseFilter); // Connect Video capture streams if VideoSourceFilter.FilterGraph <> nil then RenderStream(@PIN_CATEGORY_CAPTURE, nil, VideoSourceFilter as IBaseFilter, nil, multiplexer as IBaseFilter);end;CaptureGraph.Play;procedure TVideoForm.BitBtn2Click(Sender: TObject);var nHeight, nWidth: integer; basicvideo: IBasicVideo; PinList: TPinList; i: integer;begin if filtergraph.Active then begin if succeeded(FilterGraph.QueryInterface(IID_IBasicVideo, BasicVideo)) then begin BasicVideo.get_VideoWidth(nwidth); BasicVideo.get_VideoHeight(nheight); StatusBar2.Panels[1].Text := (inttostr(nWidth) + ' x ' + inttostr(nHeight)); end; end; if dsutil.HaveFilterPropertyPage(vFilter as IBaseFilter, ppDefault) then ShowFilterPropertyPage(self.Handle, vFilter as IBaseFilter, ppdefault); FilterGraph.Stop; Pinlist := TPinList.Create(vFilter as IBaseFilter); for i := 0 to PinList.Count - 1 do begin if PinList.Connected then PinList.Items.ConnectionMediaType(VideoMediaTypes.Items[VST.videoFmt.uid].AMMediaType^); // ShowMessage(); // ShowPinPropertyPage(self.Handle,PinList.Items); end; PinList.Free; FilterGraph.Play;end;procedure TVideoForm.OnSelectDevice(sender: TObject);var PinList: TPinList; FSize: TPoint; pcrossbar: IAMCrossbar; Hr: HRESULT; I_index: Integer;begin FilterGraph.ClearGraph; FilterGraph.Active := false; Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag); FilterGraph.Active := true; with FilterGraph as ICaptureGraphBuilder2 do begin RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, SampleGrabber as IBaseFilter, VideoWindow as IbaseFilter); end; FilterGraph.Play; Hr := (FilterGraph as ICaptureGraphBuilder2).FindInterface(@LOOK_UPSTREAM_ONLY, nil, FilterGraph as IBaseFilter, IID_IAMCrossbar, pcrossbar); if Succeeded(Hr) then begin pcrossbar.Route(0, I_index); //注意这个 I_Index就是输入视频源的序号,好像是从1开始的 pcrossbar := nil; end;end;

object VideoForm: TVideoForm Left = 163 Top = 283 Width = 510 Height = 427 Caption = 'Video Capture Devices' Color = clBtnFace Font.Charset = ANSI_CHARSET Font.Color = clWindowText Font.Height = -12 Font.Name = '宋体' Font.Style = [] Menu = MainMenu1 OldCreateOrder = False OnClose = FormClose OnCreate = GetDeviceName OnDestroy = FormDestroy DesignSize = ( 502 381) PixelsPerInch = 96 TextHeight = 12 object Button1: TButton Left = 416 Top = 16 Width = 75 Height = 25 Anchors = [akTop, akRight] Caption = '打开视频' TabOrder = 0 OnClick = SelectDevice end object Button2: TButton Left = 416 Top = 50 Width = 75 Height = 25 Anchors = [akTop, akRight] Caption = '截取图象' TabOrder = 1 OnClick = Button2Click end object Button4: TButton Left = 416 Top = 120 Width = 75 Height = 25 Anchors = [akTop, akRight] Caption = '更改接口' TabOrder = 2 OnClick = ChangeInterface end object Button3: TButton Left = 416 Top = 85 Width = 75 Height = 25 Anchors = [akTop, akRight] Caption = '保存图象' TabOrder = 3 OnClick = Button3Click end object Panel2: TPanel Left = 0 Top = 16 Width = 405 Height = 361 Anchors = [akLeft, akTop, akRight, akBottom] TabOrder = 4 DesignSize = ( 405 361) object VideoWindow: TVideoWindow Left = 1 Top = 1 Width = 403 Height = 359 FilterGraph = FilterGraph VMROptions.Mode = vmrWindowless Color = clBlack Align = alClient end object Panel1: TPanel Left = 210 Top = 131 Width = 195 Height = 228 Anchors = [akRight, akBottom] TabOrder = 1 Visible = False OnMouseDown = Panel1MouseDown object Image1: TImage Left = 1 Top = 1 Width = 193 Height = 226 Align = alClient Stretch = True OnMouseDown = Panel1MouseDown end end end object List1: TListBox Left = 344 Top = 192 Width = 145 Height = 177 Anchors = [akLeft, akTop, akRight, akBottom] ItemHeight = 12 TabOrder = 5 end object Comb1: TComboBox Left = 416 Top = 155 Width = 75 Height = 20 ItemHeight = 12 TabOrder = 6 Text = '端口选择' OnClick = ChangeInterface Items.Strings = ( '端口选择' '端口1' '端口2') end object LBPins: TListBox Left = 216 Top = 176 Width = 121 Height = 201 ItemHeight = 12 TabOrder = 7 end object FilterGraph: TFilterGraph Mode = gmCapture GraphEdit = True LinearVolume = True Left = 88 Top = 32 end object OpenDialog: TOpenDialog Filter = 'BMP file|*.bmp' Left = 32 Top = 104 end object Filter: TFilter BaseFilter.data = {00000000} FilterGraph = FilterGraph Left = 144 Top = 32 end object MainMenu1: TMainMenu Left = 32 Top = 32 object Devices: TMenuItem Caption = '&A.设备名称' end object Blend1: TMenuItem Caption = '&B.混合图象' object ext1: TMenuItem Caption = 'Text' OnClick = ext1Click end object Bitmap1: TMenuItem Caption = 'Bitmap' OnClick = Bitmap1Click end end end object Timer1: TTimer Interval = 10 OnTimer = Button2Click Left = 368 Top = 168 endend

送分都不来人啊

多人接受答案了。