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

タイトル ： Re^2: PictureBoxにUSBカメラの画像を表示させる方法
投稿日： 2006/02/17(Fri) 02:28
投稿者： YAS
調べてみるとIBasicVideo2インターフェイスのタイプライブラリに間違いがあり，そのため
GetCurrentImageが動作しないようです。
そこでDirectShow.NETを参考にIBasicVideo2を再定義してみました。

Imports QuartzTypeLib
Imports System.Runtime.InteropServices

Public Class Form1

    Const DeviceName As String = "Video Blaster WebCam 3/WebCam Plus (WDM)"
    Const CapturePinName As String = "キャプチャ"
    Private VideoWindow As New PictureBox
    Private PictureBox As New PictureBox
    WithEvents Button As New Button
    Private FM As New FilgraphManager

    Private Sub Form1_Load( _
        ByVal sender As System.Object, _
        ByVal e As System.EventArgs _
    ) Handles MyBase.Load
        Me.Size = New Size(640, 300)
        Me.VideoWindow.Size = New Size(320, 240)
        Me.VideoWindow.Location = New Point(0, 0)
        Me.PictureBox.Size = New Size(320, 240)
        Me.PictureBox.Location = New Point(320, 0)
        Me.Button.Location = New Point(0, 240)
        Me.Button.Text = "キャプチャ"
        Me.Controls.Add(Me.VideoWindow)
        Me.Controls.Add(Me.PictureBox)
        Me.Controls.Add(Me.Button)
        AddFilter(FM, DeviceName)
        RenderPin(FM, DeviceName, CapturePinName)
        Dim VW As IVideoWindow = DirectCast(FM, IVideoWindow)
        With VW
            .WindowStyle = CInt(&H6000000)
            .SetWindowPosition(0, 0, Me.VideoWindow.Width, Me.VideoWindow.Height)
            .Owner = Me.VideoWindow.Handle
        End With
        VW = Nothing
        FM.Run()
    End Sub

    Private Sub Form1_FormClosing(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        If FM IsNot Nothing Then Marshal.ReleaseComObject(FM)
    End Sub

    '静止画キャプチャする
    Private Sub Button1_Click( _
        ByVal sender As System.Object, _
        ByVal e As System.EventArgs _
    ) Handles Button.Click
        Dim BV As IBasicVideo2 = DirectCast(FM, IBasicVideo2)
        Dim BVdotNet As IBasicVideo2dotNET = DirectCast(FM, IBasicVideo2dotNET)
        Dim BufferSize As Integer
        BVdotNet.GetCurrentImage(BufferSize, IntPtr.Zero)
        Dim DIBImage As IntPtr = Marshal.AllocHGlobal(BufferSize)
        BVdotNet.GetCurrentImage(BufferSize, DIBImage)
        Dim Bmp As New Bitmap( _
            BV.SourceWidth, _
            BV.SourceHeight, _
            -4 * BV.SourceWidth, _
            Imaging.PixelFormat.Format32bppRgb, _
            CType(CType(DIBImage, Integer) + (BufferSize - 4 * BV.SourceWidth),IntPtr))
        Me.PictureBox.Image = New Bitmap(Bmp, Me.PictureBox.Size)
        Marshal.FreeHGlobal(DIBImage)
    End Sub

    'グラフにフィルタを追加する
    Private Sub AddFilter(ByVal Graph As FilgraphManager, ByVal FilterName As String)
        Dim RegFilterCollection As Object = Nothing
        Dim Filter As IFilterInfo = Nothing
        Try
            RegFilterCollection = Graph.RegFilterCollection
            For Each objFilter As IRegFilterInfo In RegFilterCollection
                If objFilter.Name = FilterName Then
                    objFilter.Filter(Filter)
                    Exit For
                End If
            Next
        Finally
            If Filter IsNot Nothing Then Marshal.ReleaseComObject(Filter)
            If RegFilterCollection IsNot Nothing Then _
            Marshal.ReleaseComObject(RegFilterCollection)
        End Try
    End Sub

    'ピンをレンダリングする
    Private Sub RenderPin(ByVal Graph As FilgraphManager, _
    ByVal FilterName As String, ByVal PinName As String)
        Dim FilterCollection As Object = Nothing
        Dim Pins As Object = Nothing
        Try
            FilterCollection = Graph.FilterCollection
            For Each Filter As IFilterInfo In FilterCollection
                If Filter.Name = FilterName Then
                    Pins = Filter.Pins
                    For Each Pin As IPinInfo In Pins
                        If Pin.Name = PinName Then
                            Pin.Render()
                            Exit For
                        End If
                    Next
                    Exit For
                End If
            Next
        Finally
            If FilterCollection IsNot Nothing Then Marshal.ReleaseComObject(FilterCollection)
            If Pins IsNot Nothing Then Marshal.ReleaseComObject(Pins)
        End Try
    End Sub

    'IBasicVideo2再定義
    <ComVisible(True), _
    ComImport(), _
    Guid("329bb360-f6ea-11d1-9038-00a0c9697298"), _
    InterfaceType(ComInterfaceType.InterfaceIsDual)> _
    Public Interface IBasicVideo2dotNET

        <PreserveSig()> Function AvgTimePerFrame( _
            <Out()> ByVal pAvgTimePerFrame As Double _
        ) As Integer
        <PreserveSig()> Function BitRate(<Out()> ByVal pBitRate As Integer) As Integer
        <PreserveSig()> Function BitErrorRate(<Out()> ByVal pBitRate As Integer) As Integer
        <PreserveSig()> Function VideoWidth(<Out()> ByVal pVideoWidth As Integer) As Integer
        <PreserveSig()> Function VideoHeight( _
            <Out()> ByVal pVideoHeight As Integer _
        ) As Integer
        <PreserveSig()> Function put_SourceLeft(ByVal SourceLeft As Integer) As Integer
        <PreserveSig()> Function get_SourceLeft( _
            <Out()> ByVal pSourceLeft As Integer _
        ) As Integer
        <PreserveSig()> Function put_SourceWidth(ByVal SourceWidth As Integer) As Integer
        <PreserveSig()> Function get_SourceWidth( _
            <Out()> ByVal pSourceWidth As Integer _
        ) As Integer
        <PreserveSig()> Function put_SourceTop(ByVal SourceTop As Integer) As Integer
        <PreserveSig()> Function get_SourceTop( _
            <Out()> ByVal pSourceTop As Integer _
        ) As Integer
        <PreserveSig()> Function put_SourceHeight(ByVal SourceHeight As Integer) As Integer
        <PreserveSig()> Function get_SourceHeight( _
            <Out()> ByVal pSourceHeight As Integer _
        ) As Integer
        <PreserveSig()> Function put_DestinationLeft( _
            ByVal DestinationLeft As Integer _
        ) As Integer
        <PreserveSig()> Function get_DestinationLeft( _
            <Out()> ByVal pDestinationLeft As Integer _
        ) As Integer
        <PreserveSig()> Function put_DestinationWidth( _
            ByVal DestinationWidth As Integer _
        ) As Integer
        <PreserveSig()> Function get_DestinationWidth( _
            <Out()> ByVal pDestinationWidth As Integer _
        ) As Integer
        <PreserveSig()> Function put_DestinationTop( _
            ByVal DestinationTop As Integer _
        ) As Integer
        <PreserveSig()> Function get_DestinationTop( _
            <Out()> ByVal pDestinationTop As Integer _
        ) As Integer
        <PreserveSig()> Function put_DestinationHeight( _
            ByVal DestinationHeight As Integer _
        ) As Integer
        <PreserveSig()> Function get_DestinationHeight( _
            <Out()> ByVal pDestinationHeight As Integer _
        ) As Integer
        <PreserveSig()> Function SetSourcePosition( _
            ByVal left As Integer, _
            ByVal top As Integer, _
            ByVal width As Integer, ByVal height As Integer _
        ) As Integer
        <PreserveSig()> Function GetSourcePosition( _
            <Out()> ByVal left As Integer, _
            <Out()> ByVal top As Integer, _
            <Out()> ByVal width As Integer, _
            <Out()> ByVal height As Integer _
         ) As Integer
        <PreserveSig()> Function SetDefaultSourcePosition() As Integer
        <PreserveSig()> Function SetDestinationPosition( _
            ByVal left As Integer, _
            ByVal top As Integer,  _
            ByVal width As Integer, _
            ByVal height As Integer _
        ) As Integer
        <PreserveSig()> Function GetDestinationPosition( _
            <Out()> ByVal left As Integer, _
            <Out()> ByVal top As Integer, _
            <Out()> ByVal width As Integer, _
            <Out()> ByVal height As Integer _
         ) As Integer
        <PreserveSig()> Function SetDefaultDestinationPosition() As Integer
        <PreserveSig()> Function GetVideoSize( _
            <Out()> ByVal pWidth As Integer, _
            <Out()> ByVal pHeight As Integer _
        ) As Integer
        <PreserveSig()> Function GetVideoPaletteEntries( _
            ByVal StartIndex As Integer, _
            ByVal Entries As Integer, _
            <Out()> ByVal pRetrieved As Integer, _
            ByVal pPalette As IntPtr _
        ) As Integer
        <PreserveSig()> Function GetCurrentImage( _
            ByRef pBufferSize As Integer, _
            ByVal pDIBImage As IntPtr _
        ) As Integer
        <PreserveSig()> Function IsUsingDefaultSource() As Integer
        <PreserveSig()> Function IsUsingDefaultDestination() As Integer
        <PreserveSig()> Function GetPreferredAspectRatio( _
            <Out()> ByVal plAspectX As Integer, _
            <Out()> ByVal plAspectY As Integer _
        ) As Integer

    End Interface

End Class
- 関連一覧ツリー （ をクリックするとツリー全体を一括表示します）

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