tagCANDY CGI VBレスキュー(花ちゃん) - PictureBoxにWEBカメラの動画を表示させる方法(VB.NET) - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
PictureBoxにWEBカメラの動画を表示させる方法(VB.NET)
元に戻る スレッド一覧へ 記事閲覧
このページ内の検索ができます。(AND 検索や OR 検索のような複数のキーワードによる検索はできません。)

PictureBoxにWEBカメラの動画を表示させる方法(VB.NET) [No.152の個別表示]
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
日時: 2013/01/25 09:13
名前: 花ちゃん

***********************************************************************************
* カテゴリー:[描画・画像][周辺機器][]                                            *
* キーワード:動画,USBカメラ,WEBカメラ,ライブ映像,DirectShow,                     *
***********************************************************************************

元質問:PictureBoxにUSBカメラの画像を.. - VBはじめたて 2006/02/06-09:57 No.3052

PictureBoxにUSBカメラの画像を簡単に表示させ、その画像を静止画で保存させる方法を
ご教授お願いします。

-----------------------------------------------------------------------------------
Re^2: PictureBoxにUSBカメラの.. - YAS  2006/02/17-02:28 No.3133
-----------------------------------------------------------------------------------
調べてみると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

下記のご自分のサイトにも掲載されておられるので下記もご覧下さい。
http://homepage1.nifty.com/yasunari/VB/VB2005/IBasicVideo.htm

上記がうまく動作しない場合は、下記を試して見て下さい。(同人が投稿されているコードです。)
こちらは、私も動作確認をしております。VB2010 / Windows 7
http://hpcgi1.nifty.com/MADIA/vbnet/wwwlng.cgi?print+201012/10120002.txt
メンテ

Page: 1 |

Re: PictureBoxにWEBカメラの動画を表示させる方法(VB.NET)  (No.1の個別表示) [スレッド一覧へ]
日時: 2018/07/24 09:57
名前: 魔界の仮面弁士

***********************************************************************************
* カテゴリー:[描画・画像][周辺機器][]                                            *
* キーワード:動画,USBカメラ,WEBカメラ,ライブ映像,DirectShow,                     *
***********************************************************************************
元質問:デスクトップアプリでWEBカメラを使いたい  - 耳たぶ黒 2017/10/24-19:44 No.11922


-----------------------------------------------------------------------------------
Re: デスクトップアプリでWEBカメラを使いたい - 魔界の仮面弁士  2017/10/24-21:27 No.11924
-----------------------------------------------------------------------------------
> 過去の掲示板に同様の質問があったようですが、同様にコードを書いても
> コンパイルエラーになってしまうのでお助け下さい。

http://hanatyan.sakura.ne.jp/patio/read.cgi?no=152
http://hanatyan.sakura.ne.jp/vbnetbbs/wforum.cgi?mode=allread&no=3052&page=1920

のことであれば、SDK 付属の QuartzTypeLib (ActiveMovie control type library) を
参照設定する必要があるはずです。今でも入手できるのかは知りませんが。



> リンクも切れてしまっているのでよくわかりません。
下記に、代替リンクを掲載しておきます。


> 下記のご自分のサイトにも掲載されておられるので下記もご覧下さい。
> http://homepage1.nifty.com/yasunari/VB/VB2005/IBasicVideo.htm
移転先があるのかはわかりませんでしたが、下記からキャッシュページを参照できます。
https://web.archive.org/web/20131222213404/homepage1.nifty.com/yasunari/VB/VB2005/IBasicVideo.htm


> 上記がうまく動作しない場合は、下記を試して見て下さい。(同人が投稿されているコードです。)
> http://hpcgi1.nifty.com/MADIA/vbnet/wwwlng.cgi?print+201012/10120002.txt
こちらは下記に移動しています。DirectShowLib による実装例ですね。
http://madia.world.coocan.jp/cgi-bin/vbnet/wwwlng.cgi?print+201012/10120002.txt


でもって、DirectShowLib についてはこちら。
http://directshownet.sourceforge.net
https://www.nuget.org/packages/DirectShowLib/coocan.jp/cgi-bin/vbnet/wwwlng.cgi?print+201012/10120002.txt
メンテ

Page: 1 |

 投稿フォーム               スレッド一覧へ
題  名 スレッドをトップへソート
名  前
パスワード (記事メンテ時に使用)
投稿キー (投稿時 投稿キー を入力してください)
コメント

   クッキー保存   
スレッド一覧へ