tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
[ツリー表示へ]　 [ワード検索]　 [Home]

タイトル ： Re^2: USBカメラの解像度の切り替え
投稿日： 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
- 関連一覧ツリー （ をクリックするとツリー全体を一括表示します）

古いスレッドにレスはつけられません。