tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板) [ツリー表示へ]   [Home]
一括表示(VB.NET VB2005)
タイトルPictureBoxにUSBカメラの画像を表示させる方法
記事No3052
投稿日: 2006/02/06(Mon) 09:57
投稿者VBはじめたて
[OSのVer]:Windows xp   [VBのVer]:VB.NET 2003 
PictureBoxにUSBカメラの画像を簡単に表示させ、その画像を静止画で
保存させる方法をご教授お願いします。
よろしくお願いします。

[ツリー表示へ]
タイトルRe: PictureBoxにUSBカメラの画像を表示させる方法
記事No3055
投稿日: 2006/02/06(Mon) 21:22
投稿者YAS
VBではなくC#であれば,
DirectShow.NET
hhttp://www.codeproject.com/cs/media/directshownet.asp
にお求めのサンプルそのものがあります。ソース付きです。
SampleGrabberNETというサンプルがビデオキャプチャデバイスから静止画を
キャプチャすることが出来ます。

DShowNETをコンパイルしてDLLにできればVBからも利用できます。
SampleGrabberNETはC#->VBのコンバータを通せば僅かな手直しで実行できました。

DShowNETのコンパイルはC# Express版を使えば無料でできると思います。

[ツリー表示へ]
タイトルRe^2: PictureBoxにUSBカメラの画像を表示させる方法
記事No3056
投稿日: 2006/02/07(Tue) 00:28
投稿者VBはじめたて
[OSのVer]:Windows    [VBのVer]:VB.NET  
YASさんありがとうございます。
早速教えていただいたものを試してみます。
極力自分で考えてやってみますが、どうしても解決できなければまた尋ねさせていただきます。
よろしくお願いします。

[ツリー表示へ]
タイトルRe^3: PictureBoxにUSBカメラの画像を表示させる方法
記事No3063
投稿日: 2006/02/08(Wed) 08:59
投稿者花ちゃん
> 極力自分で考えてやってみますが、どうしても解決できなければまた尋ねさせていただきます。

下記の掲示板に色々投稿されているので参考にされるといいでしょう。
hhttp://hpcgi1.nifty.com/MADIA/VBBBS/wwwlng.cgi?print+200601/06010044.txt

[ツリー表示へ]
タイトルRe^4: PictureBoxにUSBカメラの画像を表示させる方法
記事No3090
投稿日: 2006/02/11(Sat) 21:49
投稿者VBはじめたて
[OSのVer]:Windows    [VBのVer]:VB.NET  
> > 極力自分で考えてやってみますが、どうしても解決できなければまた尋ねさせていただきま
す。
>
> 下記の掲示板に色々投稿されているので参考にされるといいでしょう。
> hhttp://hpcgi1.nifty.com/MADIA/VBBBS/wwwlng.cgi?print+200601/06010044.txt
花ちゃん さん ご協力ありがとうございます。
早速参考にさせて頂きます。また質問させていただくと思いますので、よろしくお願いします。

[ツリー表示へ]
タイトルRe: PictureBoxにUSBカメラの画像を表示させる方法
記事No3095
投稿日: 2006/02/12(Sun) 12:25
投稿者YAS
> PictureBoxにUSBカメラの画像を簡単に表示させ、その画像を静止画で
                               ^^^^
DirectShow.NETを使う場合はあまり「簡単」ではないですね。

VB用DirectShowタイプライブラリの公式なものとして
ActiveMovie control type libraryがあります。
しかし,たぶんVB6.0用なのだと思います。
参照設定して試してみると,USBカメラの動画をPictureBoxに
表示するところまでは「簡単」にできるのですが,
動画から静止画を切り出すことがうまくできませんでした。
(IBasicVideoインターフェイスのGetCurrentImageメソッドが
うまく動作してくれないのです。引数の与え方が違うのかな?)

グラフィックアクセラレータのハードウェアアクセラレータを
「無効」にしてしまい,画面コピーで画像をとるという裏技も
あります。

.NETで「簡単」な方法はなかなか無いようです。
VB6.0なら結構簡単なのですが...

ActiveMovie control type libraryでUSBカメラの動画をPictureBoxに表示する例です。

Imports System.Runtime.InteropServices
Imports QuartzTypeLib

Public Class Form1

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

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _
    Handles MyBase.Load
        Me.VideoWindow.Dock = DockStyle.Fill
        Me.Controls.Add(Me.VideoWindow)
        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 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

End Class

[ツリー表示へ]
タイトルRe^2: PictureBoxにUSBカメラの画像を表示させる方法
記事No3133
投稿日: 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

[ツリー表示へ]