サンプル投稿用掲示板 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
 |
Re: PictureBoxにWEBカメラの動画を表示させる方法(VB.NET)