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

名前

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

本文

推奨フォーマットを取得し，ListBoxに列挙し，選択したフォーマットに設定するサンプルです。
COMの解放のあたりはこれでいいのか自信がなく，適当です。
参考程度にしてください。

Option Explicit On
Option Strict On

Imports DirectShowLib
Imports System.Runtime.InteropServices

Public Class Form1

Dim comGraph As New FilterGraph

Private Structure CameraSetting
        Dim Width As Integer
        Dim Height As Integer
        Dim AvgTimePerFrame As Long
    End Structure

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)
            SetupCameraSetting(comOutPin)
            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

Private Sub SetupCameraSetting(ByVal CameraPin As IPin)
        Dim myCameraSetting As CameraSetting() = DumpCameraSetting(CameraPin)
        Dim Form2 As New Form2
        Form2.CameraSetting = myCameraSetting
        Form2.ShowDialog()
        SetupCameraOutPin(CameraPin, myCameraSetting(Form2.Index))
    End Sub

Private Function DumpCameraSetting(ByVal CameraPin As IPin) As CameraSetting()
        Dim Config As IAMStreamConfig = DirectCast(CameraPin, IAMStreamConfig)
        Dim iCount As Integer, iSize As Integer
        Config.GetNumberOfCapabilities(iCount, iSize)
        Dim CameraSetting(iCount - 1) As CameraSetting
        Dim vih As New VideoInfoHeader
        Dim vsc As New VideoStreamConfigCaps
        Dim scc As IntPtr = Marshal.AllocHGlobal(iSize)
        Dim mt As AMMediaType = Nothing
        For i As Integer = 0 To iCount - 1
            Config.GetStreamCaps(i, mt, scc)
            Marshal.PtrToStructure(mt.formatPtr, vih)
            Marshal.PtrToStructure(scc, vsc)
            CameraSetting(i).Width = vih.BmiHeader.Width
            CameraSetting(i).Height = vih.BmiHeader.Height
            CameraSetting(i).AvgTimePerFrame = vih.AvgTimePerFrame
            Debug.Print("{0} x {1} Min:{2:0.00}fps Max:{3:0.00}fps", vih.BmiHeader.Width, vih.BmiHeader.Height, 10000000 / vsc.MaxFrameInterval, 10000000 / vsc.MinFrameInterval)
            DsUtils.FreeAMMediaType(mt)
        Next
        Marshal.FreeHGlobal(scc)
        Return CameraSetting
    End Function

Private Sub SetupCameraOutPin(ByVal CameraOut As IPin, ByVal CameraSetting As CameraSetting)
        Dim Config As IAMStreamConfig = DirectCast(CameraOut, IAMStreamConfig)
        Dim mt As AMMediaType = New AMMediaType
        Dim vih As VideoInfoHeader = New VideoInfoHeader
        Config.GetFormat(mt)
        Marshal.PtrToStructure(mt.formatPtr, vih)
        vih.BmiHeader.Width = CameraSetting.Width
        vih.BmiHeader.Height = CameraSetting.Height
        vih.AvgTimePerFrame = CameraSetting.AvgTimePerFrame
        Marshal.StructureToPtr(vih, mt.formatPtr, True)
        Config.SetFormat(mt)
        DsUtils.FreeAMMediaType(mt)
    End Sub

Private Class Form2
        Inherits Form

Dim ListBox1 As New ListBox
        Dim WithEvents Button1 As New Button

Public Property CameraSetting As CameraSetting()
        Public Property Index As Integer = -1

Private Sub Form2_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
            If Me._Index < 0 Then
                e.Cancel = True
            End If
        End Sub

Private Sub Form2_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
            Me.ListBox1.ItemHeight = 12
            Me.ListBox1.Location = New Point(14, 33)
            Me.ListBox1.Size = New Size(247, 76)
            Me.ListBox1.TabIndex = 2
            Me.Button1.Size = New Size(67, 21)
            Me.Button1.Location = New Point(194, 110)
            Me.Button1.Text = "OK"
            Me.Text = "カメラの設定を選択してください"
            Me.ClientSize = New Size(275, 140)
            Me.Controls.AddRange({ListBox1, Button1})
            For i As Integer = 0 To Me._CameraSetting.Length - 1
                With Me._CameraSetting(i)
                    ListBox1.Items.Add(String.Format("{0} x {1} {2:0.00}fps", .Width, .Height, 10000000 / .AvgTimePerFrame))
                End With
            Next
        End Sub

Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click
            Me._Index = Me.ListBox1.SelectedIndex
            If Me._Index >= 0 Then
                Me.Close()
            End If
        End Sub

End Class

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

戻る