カメラ映像を表示するには (ID:147254)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

VideoCaptureSourcesを検索し，最初に見つけたデバイスの映像をフォームに表示するサンプルです。
（DirectShowLib-2005.Dllを参照設定してください。）
デバイスの出力ピンを検索し，最初に見つけた出力ピンをレンダリングしているので，デバイスのピンの構成によっては映像が表示されません。その時は
comOutPin = DsFindPin.ByDirection(DirectCast(CameraFilter, IBaseFilter), PinDirection.Output, 0)
の最後の「0」を1や2などに変えてみてください。

Option Explicit On
Option Strict On

Imports DirectShowLib
Imports System.Runtime.InteropServices

Public Class Form1

Dim comGraph As New FilterGraph

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.SetupGraph()
        Me.SetupVideoWindow(Me.Handle)
        DirectCast(Me.comGraph, IMediaControl).Run()
    End Sub

Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        DirectCast(Me.comGraph, IMediaControl).Stop()
        If Me.comGraph IsNot Nothing Then
            Marshal.ReleaseComObject(Me.comGraph)
            Me.comGraph = Nothing
        End If
    End Sub

Private Sub SetupGraph()
        Dim CameraDevice As DsDevice = Nothing
        Dim CameraFilter As IBaseFilter = Nothing
        CameraDevice = GetCameraDevice()
        If CameraDevice Is Nothing Then
            Throw New Exception("カメラが接続されていません。")
        End If
        CameraFilter = GetCameraFilter(CameraDevice)
        DirectCast(Me.comGraph, IGraphBuilder).AddFilter(CameraFilter, "Camera")
        Dim comOutPin As IPin = Nothing
        Try
            comOutPin = DsFindPin.ByDirection(DirectCast(CameraFilter, IBaseFilter), PinDirection.Output, 0)
            DirectCast(Me.comGraph, IGraphBuilder).Render(comOutPin)
        Finally
            If comOutPin IsNot Nothing Then
                Marshal.ReleaseComObject(comOutPin)
                comOutPin = Nothing
            End If
        End Try
    End Sub

Private Sub SetupVideoWindow(ByVal hwnd As IntPtr)
        With DirectCast(Me.comGraph, IVideoWindow)
            .put_Owner(hwnd)
            .put_WindowStyle(WindowStyle.Child Or WindowStyle.ClipSiblings Or WindowStyle.ClipChildren)
            .SetWindowPosition(0, 0, Me.ClientSize.Width, Me.ClientSize.Height)
        End With
    End Sub

Private Function GetCameraDevice() As DsDevice
        Dim Devices() As DsDevice = Nothing
        Dim Device As DsDevice = Nothing
        Devices = DsDevice.GetDevicesOfCat(FilterCategory.VideoInputDevice)
        If Devices.Length > 0 Then
            Device = Devices(0)
        Else
            Device = Nothing
        End If
        Return Device
    End Function

Private Function GetCameraFilter(ByVal Device As DsDevice) As IBaseFilter
        Dim CameraFilter As Object = Nothing
        Device.Mon.BindToObject(Nothing, Nothing, GetType(IBaseFilter).GUID, CameraFilter)
        Return DirectCast(CameraFilter, IBaseFilter)
    End Function

End Class

←解決時は質問者本人がここをチェックしてください。

戻る