VBにWEBカメラの表示

解決

猫は炬燵で 2009-01-03 13:41:07 No: 101444

ＶＢ初心者です。DirectShowを使用してカメラの内容を表示しようと思うのですが。
http://www.geocities.co.jp/SiliconValley/7406/tips/dshow/dshow2.html
のサイトを参考に組んでみましたが、最後のIFilterInfoが定義されていないとエラーが出ます。そこをQuartzTypeLib.IFilterInfoにしてみるとエラーは無くなるのですがどうもうまくいきません。以下にソースを貼りますのでご教授お願いします。

Option Explicit On
Public Class Form1
Private Const CAMERA_FILTER_NAME$ = "Logicool Qcam Easy/Cool" 'カメラ
Private Const CAMERA_OUTPUTPIN_NAME$ = "~Capture"

'フィルタグラフマネージャ
Private mGrp As QuartzTypeLib.FilgraphManager

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        'グラフマネージャの作成
        mGrp = New QuartzTypeLib.FilgraphManager

        'グラフにキャプチャ（カメラ）フィルタを追加する
        Dim cameraflt As QuartzTypeLib.IFilterInfo
        cameraflt = AddFilter(mGrp, CAMERA_FILTER_NAME$)

        If cameraflt Is Nothing Then
            MsgBox("カメラ'" + CAMERA_FILTER_NAME + "'が見つかりません。" + vbCrLf + "カメラの名前を確認してください。")
            Exit Sub
        End If

        'グラフにビデオレンダラフィルタを追加する
        AddFilter(mGrp, "Video Renderer")

        'カメラの出力ピンを取得
        Dim camerapin As QuartzTypeLib.IPinInfo
        Try
            cameraflt.FindPin(CAMERA_OUTPUTPIN_NAME$, camerapin)

        Catch ex As Exception
            MsgBox("カメラのピン'" + CAMERA_OUTPUTPIN_NAME$ + "'が見つかりません。" + vbCrLf + "ピンの名前を確認してください。")
            Dim pp As QuartzTypeLib.IPinInfo
            For Each pp In cameraflt.Pins
                If pp.Direction = 1 Then
                    camerapin = pp
                    Exit For
                End If
            Next
            If camerapin Is Nothing Then
                MsgBox("出力ピンが見つかりません。")
                Exit Sub
            End If
        End Try

        'ビデオサイズ(縦横)を取得
        Dim bv As QuartzTypeLib.IBasicVideo
        Dim vx&, vy&
        bv = mGrp
        bv.GetVideoSize(vx, vy)

        'ビデオサイズに合わせてウィンドウを調整
        Dim winx&, winy&    'ウィンドウの縁サイズ
        winx = 30
        winy = 5
        Me.Width = winx + vx
        Me.Height = winy + vy

        'ウィンドウ内で動画を再生させる
        Dim vw As QuartzTypeLib.IVideoWindow
        vw = mGrp
        vw.WindowStyle = &H40000000 'WS_CHILD
        vw.SetWindowPosition(0, 0, vx, vy)
        vw.Owner = Me.Handle

'再生
mGrp.Run()

    End Sub
    'レジストリに登録されているフィルタをグラフに追加する
    Public Function AddFilter(ByRef Grp As QuartzTypeLib.FilgraphManager, ByVal FilterName$) As IFilterInfo
        Dim regflt As QuartzTypeLib.IRegFilterInfo
        For Each regflt In Grp.RegFilterCollection
            If regflt.Name = FilterName$ Then
                regflt.Filter(AddFilter)
                Exit Function
            End If
        Next
    End Function
End Class

コピペで使用しているので、完全にソースコードの意味を理解までは至っていません。

K.J.K. 2009-01-03 18:40:57 No: 101445

ここはVB6以前用です。VB.NETでの質問はVisual Basic .NET掲示板で行ってください。
また、その場合は、M.Osikiriさんのサイトの
http://www.geocities.co.jp/SiliconValley/7406/tips/dshow2005/index.html
http://www.geocities.co.jp/SiliconValley/7406/tips/dshowdll/index.html
を参考にするといいでしょう。

猫は炬燵で 2009-01-04 06:14:08 No: 101446

K.J.Kさん
返信ありがとうございます。
板違いでしたか、すみません。

参考ＵＲＬを読み漁ってみますね＾＾