タイトル | : Re^2: USBカメラの解像度の切り替え |
記事No | : 5002 |
投稿日 | : 2007/02/26(Mon) 17:18 |
投稿者 | : 影丸 |
どうもありがとうございます。 いろいろ試行錯誤して何とか340*240から680*480に変更する プログラムを以下のとおり作成したのですが、変更が反映されません。 どこか悪いのでしょうか?
Dim TypeObjet As Type 'IGraphBuilder作成 TypeObjet = Type.GetTypeFromCLSID(DefDirectShow.CLSID_FilterGraph) ObjetCOM = Activator.CreateInstance(TypeObjet) objGraphBuilder = CType(ObjetCOM, IGraphBuilder)
'フィルタ作成 Dim EnumerateurDevice As DefDirectShow.ICreateDevEnum Dim EnumerateurMoniker As IEnumMoniker Dim Moniker(0) As IMoniker Dim Fetched As Int32
'デバイス列挙子生成 TypeObjet = Type.GetTypeFromCLSID(DefDirectShow.CLSID_SystemDeviceEnum) ObjetCOM = Activator.CreateInstance(TypeObjet) EnumerateurDevice = CType(ObjetCOM, DefDirectShow.ICreateDevEnum) 'モニカ列挙子 EnumerateurDevice.CreateClassEnumerator(DefDirectShow.CLSID_VideoInputDeviceCategory, _ EnumerateurMoniker, 0) 'モニカの取得 If Not EnumerateurMoniker Is Nothing Then While EnumerateurMoniker.Next(1, Moniker, Fetched) = 0 Dim PropertyBag As DefDirectShow.IPropertyBag Dim ObjetTemporaire As Object, ObjetLu As Object
'モニカをデバイスフィルタにバインド Moniker(0).BindToStorage(Nothing, Nothing, GetType(DefDirectShow.IPropertyBag).GUID, ObjetTemporaire) PropertyBag = CType(ObjetTemporaire, DefDirectShow.IPropertyBag) PropertyBag.Read("FriendlyName", ObjetLu, IntPtr.Zero) If ObjetLu.ToString = objNomEntree Then If objFiltreEntree Is Nothing Then Moniker(0).BindToObject(Nothing, Nothing, GetType(DefDirectShow.IBaseFilter). GUID, ObjetTemporaire) objFiltreEntree = CType(ObjetTemporaire, DefDirectShow.IBaseFilter) End If End If Marshal.ReleaseComObject(PropertyBag) End While Marshal.ReleaseComObject(EnumerateurMoniker) End If Marshal.ReleaseComObject(EnumerateurDevice)
'解像度切り替え処理関数呼び出し SetResolution(objGraphBuilder)
'フィルタをグラフビルダーに追加 objGraphBuilder.AddFilter(objFiltreEntree, "Entry video")
'DebugPrint(objGraphBuilder)
'VMR作成 TypeObjet = Type.GetTypeFromCLSID(DefDirectShow.CLSID_VideoMixingRenderer) ObjetCOM = Activator.CreateInstance(TypeObjet) objFiltreSortie = CType(ObjetCOM, IBaseFilter) objGraphBuilder.AddFilter(objFiltreSortie, "Video VMR")
'VMR windowレス objConfigVMR = CType(objFiltreSortie, IVMRFilterConfig) objConfigVMR.SetRenderingMode(VMR9Mode.Windowless) objControleVMR = CType(objFiltreSortie, IVMRWindowlessControl) objControleVMR.SetVideoClippingWindow(objHandleFenetreVideo) objControleVMR.SetAspectRatioMode(VMR_ASPECT_RATIO_MODE.VMR_ARMODE_NONE)
'ICaptureGraphBuilder2 作成 TypeObjet = Type.GetTypeFromCLSID(DefDirectShow.CLSID_CaptureGraphBuilder2) ObjetCOM = Activator.CreateInstance(TypeObjet) objCaptureGraphBuilder2 = CType(ObjetCOM, ICaptureGraphBuilder2) objCaptureGraphBuilder2.SetFiltergraph(objGraphBuilder)
objCaptureGraphBuilder2.RenderStream(Pin_Category_Capture, _ MEDIATYPE_Video, _ objFiltreEntree, _ Nothing, _ objFiltreSortie)
objControleGraphe = CType(objGraphBuilder, IMediaControl) objControleGraphe.Run()
Dim Source As New Rectangle, Destination As New Rectangle objControleVMR.GetVideoPosition(Source, Destination) objControleVMR.SetVideoPosition(Source, objRectangleVideo)
Public Sub SetResolution(ByVal Graph As IGraphBuilder)
'フィルタ列挙子取得 Dim eflt As IEnumFilters = Nothing Graph.EnumFilters(eflt) 'フィルタ列挙 Dim fc As Integer Dim flt As IBaseFilter = Nothing Do While eflt.Next(1, flt, fc) = 0
'フィルタ情報の取得 Dim finfo As New FILTER_INFO Dim fltname As String = "(不明なフィルタ)" If flt.QueryFilterInfo(finfo) = 0 Then fltname = finfo.achName ReleaseInstance(finfo.pUnk) End If
'フィルタ情報表示 System.Console.WriteLine("[{0}]", fltname) 'ピン列挙子取得 Dim epin As IEnumPins = Nothing flt.EnumPins(epin)
'ピン列挙 Dim pc As Integer Dim pin As IPin = Nothing Do While epin.Next(1, pin, pc) = 0
'IAMStreamConfig取得() Dim obIAMS As IAMStreamConfig = CType(pin, IAMStreamConfig) If Not obIAMS Is Nothing Then
Dim iCount, iSize As Integer obIAMS.GetNumberOfCapabilities(iCount, iSize)
Dim obAMMType As New AMMediaType obIAMS.GetFormat(obAMMType) '現在のフォーマット取得 Dim vinfo As New DSVIDEOINFOHEADER vinfo = PtrToStructure(Of DSVIDEOINFOHEADER)(obAMMType.formatPtr) Dim sz As New Size(vinfo.BmiHeader.Width, vinfo.BmiHeader.Height) Graph.Disconnect(pin) If vinfo.BmiHeader.Height = 240 Then vinfo.BmiHeader.Height = 480 vinfo.BmiHeader.Width = 640 Marshal.StructureToPtr(vinfo, obAMMType.formatPtr, True) 'SetFormatでpbFormatの変更を適用させる obIAMS.SetFormat(obAMMType) End If End If Loop 'フィルタ解放 Marshal.ReleaseComObject(flt) Loop
'フィルタ列挙終了 Marshal.ReleaseComObject(eflt)
End Sub
|