| | タイトル | : 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
 
 |