所以我正在使用这个项目在我的表单上获取网络摄像头流。我想捕捉一个帧并立即保存。我怎么能这样做任何帮助将不胜感激。
Imports System
Imports System.Diagnostics
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports DirectShowLib
Imports System.Runtime.InteropServices.ComTypes
Namespace Capture_The_Webcam
Public Class Form1
Inherits System.Windows.Forms.Form
Enum PlayState
Stopped
Paused
Running
Init
End Enum
Dim CurrentState As PlayState = PlayState.Stopped
Dim D As Integer = Convert.ToInt32("0X8000", 16)
Public WM_GRAPHNOTIFY As Integer = D + 1
Dim VideoWindow As IVideoWindow = Nothing
Dim MediaControl As IMediaControl = Nothing
Dim MediaEventEx As IMediaEventEx = Nothing
Dim GraphBuilder As IGraphBuilder = Nothing
Dim CaptureGraphBuilder As ICaptureGraphBuilder2 = Nothing
Dim rot As DsROTEntry = Nothing
<STAThread()> Shared Sub Main()
Application.Run(New Form1)
End Sub
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
InitializeComponent()
CaptureVideo()
End Sub
Private Sub InitializeComponent()
Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(Form1))
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.ClientSize = New System.Drawing.Size(320, 320)
Me.Icon = CType((resources.GetObject("$this.Icon")), System.Drawing.Icon)
Me.Name = "Form1"
Me.Text = "Video Capture Previewer (PlayCap)"
Debug.WriteLine("I started Sub InitializeComponent")
End Sub
Private Sub CaptureVideo()
Dim hr As Integer = 0
Dim sourceFilter As IBaseFilter = Nothing
Try
GetInterfaces()
hr = Me.CaptureGraphBuilder.SetFiltergraph(Me.GraphBuilder) 'Specifies filter graph "graphbuilder" for the capture graph builder "captureGraphBuilder" to use.
Debug.WriteLine("Attach the filter graph to the capture graph : " & DsError.GetErrorText(hr))
DsError.ThrowExceptionForHR(hr)
sourceFilter = FindCaptureDevice()
hr = Me.GraphBuilder.AddFilter(sourceFilter, "Video Capture")
Debug.WriteLine("Add capture filter to our graph : " & DsError.GetErrorText(hr))
DsError.ThrowExceptionForHR(hr)
hr = Me.CaptureGraphBuilder.RenderStream(PinCategory.Preview, MediaType.Video, sourceFilter, Nothing, Nothing)
Debug.WriteLine("Render the preview pin on the video capture filter : " & DsError.GetErrorText(hr))
DsError.ThrowExceptionForHR(hr)
Marshal.ReleaseComObject(sourceFilter)
SetupVideoWindow()
rot = New DsROTEntry(Me.GraphBuilder)
hr = Me.MediaControl.Run()
Debug.WriteLine("Start previewing video data : " & DsError.GetErrorText(hr))
DsError.ThrowExceptionForHR(hr)
Me.CurrentState = PlayState.Running
Debug.WriteLine("The currentstate : " & Me.CurrentState.ToString)
Catch ex As Exception
MessageBox.Show("An unrecoverable error has occurred.With error : " & ex.ToString)
End Try
End Sub
Private Sub GetInterfaces()
Dim hr As Integer = 0
Me.GraphBuilder = CType(New FilterGraph, IGraphBuilder)
Me.CaptureGraphBuilder = CType(New CaptureGraphBuilder2, ICaptureGraphBuilder2)
Me.MediaControl = CType(Me.GraphBuilder, IMediaControl)
Me.VideoWindow = CType(Me.GraphBuilder, IVideoWindow)
Me.MediaEventEx = CType(Me.GraphBuilder, IMediaEventEx)
hr = Me.MediaEventEx.SetNotifyWindow(Me.Handle, WM_GRAPHNOTIFY, IntPtr.Zero) 'This method designates a window as the recipient of messages generated by or sent to the current DirectShow object
DsError.ThrowExceptionForHR(hr) 'ThrowExceptionForHR is a wrapper for Marshal.ThrowExceptionForHR, but additionally provides descriptions for any DirectShow specific error messages.If the hr value is not a fatal error, no exception will be thrown:
Debug.WriteLine("I started Sub Get interfaces , the result is : " & DsError.GetErrorText(hr))
End Sub
Public Function FindCaptureDevice() As IBaseFilter
Debug.WriteLine("Start the Sub FindCaptureDevice")
Dim hr As Integer = 0
Dim classEnum As IEnumMoniker = Nothing
Dim moniker As IMoniker() = New IMoniker(0) {}
Dim source As Object = Nothing
Dim devEnum As ICreateDevEnum = CType(New CreateDevEnum, ICreateDevEnum)
hr = devEnum.CreateClassEnumerator(FilterCategory.VideoInputDevice, classEnum, 0)
Debug.WriteLine("Create an enumerator for the video capture devices : " & DsError.GetErrorText(hr))
DsError.ThrowExceptionForHR(hr)
Marshal.ReleaseComObject(devEnum)
If classEnum Is Nothing Then
Throw New ApplicationException("No video capture device was detected.\r\n\r\n" & _
"This sample requires a video capture device, such as a USB WebCam,\r\n" & _
"to be installed and working properly. The sample will now close.")
End If
If classEnum.Next(moniker.Length, moniker, IntPtr.Zero) = 0 Then
Dim iid As Guid = GetType(IBaseFilter).GUID
moniker(0).BindToObject(Nothing, Nothing, iid, source)
Else
Throw New ApplicationException("Unable to access video capture device!")
End If
Marshal.ReleaseComObject(moniker(0))
Marshal.ReleaseComObject(classEnum)
Return CType(source, IBaseFilter)
End Function
Public Sub SetupVideoWindow()
Dim hr As Integer = 0
'set the video window to be a child of the main window
'putowner : Sets the owning parent window for the video playback window.
hr = Me.VideoWindow.put_Owner(Me.Handle)
DsError.ThrowExceptionForHR(hr)
hr = Me.VideoWindow.put_WindowStyle(WindowStyle.Child Or WindowStyle.ClipChildren)
DsError.ThrowExceptionForHR(hr)
'Use helper function to position video window in client rect of main application window
ResizeVideoWindow()
'Make the video window visible, now that it is properly positioned
'put_visible : This method changes the visibility of the video window.
hr = Me.VideoWindow.put_Visible(OABool.True)
DsError.ThrowExceptionForHR(hr)
End Sub
Protected Overloads Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case WM_GRAPHNOTIFY
HandleGraphEvent()
End Select
If Not (Me.VideoWindow Is Nothing) Then
Me.VideoWindow.NotifyOwnerMessage(m.HWnd, m.Msg, m.WParam.ToInt32, m.LParam.ToInt32)
End If
MyBase.WndProc(m)
End Sub
Public Sub HandleGraphEvent()
Dim hr As Integer = 0
Dim evCode As EventCode
Dim evParam1 As Integer
Dim evParam2 As Integer
If Me.MediaEventEx Is Nothing Then
Return
End If
While Me.MediaEventEx.GetEvent(evCode, evParam1, evParam2, 0) = 0
'// Free event parameters to prevent memory leaks associated with
'// event parameter data. While this application is not interested
'// in the received events, applications should always process them.
hr = Me.MediaEventEx.FreeEventParams(evCode, evParam1, evParam2)
DsError.ThrowExceptionForHR(hr)
'// Insert event processing code here, if desired
End While
End Sub
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
'// Stop capturing and release interfaces
closeinterfaces()
End If
MyBase.Dispose(disposing)
End Sub
Public Sub closeinterfaces()
'//stop previewing data
If Not (Me.MediaControl Is Nothing) Then
Me.MediaControl.StopWhenReady()
End If
Me.CurrentState = PlayState.Stopped
'//stop recieving events
If Not (Me.MediaEventEx Is Nothing) Then
Me.MediaEventEx.SetNotifyWindow(IntPtr.Zero, WM_GRAPHNOTIFY, IntPtr.Zero)
End If
'// Relinquish ownership (IMPORTANT!) of the video window.
'// Failing to call put_Owner can lead to assert failures within
'// the video renderer, as it still assumes that it has a valid
'// parent window.
If Not (Me.VideoWindow Is Nothing) Then
Me.VideoWindow.put_Visible(OABool.False)
Me.VideoWindow.put_Owner(IntPtr.Zero)
End If
' // Remove filter graph from the running object table
If Not (rot Is Nothing) Then
rot.Dispose()
rot = Nothing
End If
'// Release DirectShow interfaces
Marshal.ReleaseComObject(Me.MediaControl) : Me.MediaControl = Nothing
Marshal.ReleaseComObject(Me.MediaEventEx) : Me.MediaEventEx = Nothing
Marshal.ReleaseComObject(Me.VideoWindow) : Me.VideoWindow = Nothing
Marshal.ReleaseComObject(Me.GraphBuilder) : Me.GraphBuilder = Nothing
Marshal.ReleaseComObject(Me.CaptureGraphBuilder) : Me.CaptureGraphBuilder = Nothing
End Sub
Private Sub Form1_Resize1(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize
If Me.WindowState = FormWindowState.Minimized Then
ChangePreviewState(False)
End If
If Me.WindowState = FormWindowState.Normal Then
ChangePreviewState(True)
End If
ResizeVideoWindow()
End Sub
Public Sub ChangePreviewState(ByVal showVideo As Boolean)
Dim hr As Integer = 0
'// If the media control interface isn't ready, don't call it
If Me.MediaControl Is Nothing Then
Debug.WriteLine("MediaControl is nothing")
Return
End If
If showVideo = True Then
If Not (Me.CurrentState = PlayState.Running) Then
Debug.WriteLine("Start previewing video data")
hr = Me.MediaControl.Run
Me.CurrentState = PlayState.Running
End If
Else
Debug.WriteLine("Stop previewing video data")
hr = Me.MediaControl.StopWhenReady
Me.CurrentState = PlayState.Stopped
End If
End Sub
Public Sub ResizeVideoWindow()
'Resize the video preview window to match owner window size
'left , top , width , height
If Not (Me.VideoWindow Is Nothing) Then 'if the videopreview is not nothing
Me.VideoWindow.SetWindowPosition(0, 0, Me.Width, Me.ClientSize.Height)
End If
End Sub
End Class
End Namespace
项目链接 - http://www.codeproject.com/Articles/18511/Webcam-using-DirectShow-NET