VB.Net Directshow网络摄像头快照

时间:2014-02-16 13:44:11

标签: vb.net video webcam directshow directshow.net

我是stackoverflow的新手,但我注册了,因为我认为这里是获得编程专业帮助的合适场所:) 我的目标是创建一个网络摄像头快照工具,直接将快照保存到文件中。 我不需要在图片框或类似的东西中进行任何预览。 我正在考虑这样的应用程序:

带有Combobox的简单界面,用于连接的网络摄像头设备和一个按钮,可以拍摄快照并将其保存到文件中。 我喜欢使用DirectShow,因为所有其他方式使用AForge或advcap32.dll,因为它们有时会导致 要弹出的Videosourcedialog,我不想这样做。 我喜欢在我的组合框中手动选择一个网络摄像头设备,并能拍摄快照。 所以我喜欢使用DirectShow。

我已经将DirectShowLib-2005.dll添加到我的VB.Net项目中 我还添加了这个课程:

Imports System
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
Imports System.Diagnostics

Imports DirectShowLib

Public Class Capture
    Implements ISampleGrabberCB
    Implements IDisposable

#Region "Member variables"

    Private m_graphBuilder As IFilterGraph2 = Nothing
    Private m_mediaCtrl As IMediaControl = Nothing
    Private mediaEventEx As IMediaEventEx = Nothing
    Private videoWindow As IVideoWindow = Nothing
    Private UseHand As IntPtr = MainForm.PictureBox1.Handle
    Private Const WMGraphNotify As Integer = 13
    Private m_takePicture As Boolean = False
    Public mytest As String = "yes"
    Dim sampGrabber As ISampleGrabber = Nothing

    Private bufferedSize As Integer = 0
    Private savedArray() As Byte
    Public capturedPic As bitmap
    Public captureSaved As Boolean
    Public unsupportedVideo As Boolean

    ' <summary> Set by async routine when it captures an image </summary>
    Public m_bRunning As Boolean = False

    ' <summary> Dimensions of the image, calculated once in constructor. </summary>
    Private m_videoWidth As Integer
    Private m_videoHeight As Integer
    Private m_stride As Integer

    Private m_bmdLogo As BitmapData = Nothing
    Private m_Bitmap As Bitmap = Nothing

#If DEBUG Then
    ' Allow you to "Connect to remote graph" from GraphEdit
    Private m_rot As DsROTEntry = Nothing
#End If

#End Region

#Region "API"

    Declare Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As IntPtr, ByVal Source As IntPtr, <MarshalAs(UnmanagedType.U4)> ByVal Length As Integer)

#End Region

    ' zero based device index, and some device parms, plus the file name to save to
    Public Sub New(ByVal iDeviceNum As Integer, ByVal iFrameRate As Integer, ByVal iWidth As Integer, ByVal iHeight As Integer)
        Dim capDevices As DsDevice()

        ' Get the collection of video devices
        capDevices = DsDevice.GetDevicesOfCat(FilterCategory.VideoInputDevice)

        If (iDeviceNum + 1 > capDevices.Length) Then
            Throw New Exception("No video capture devices found at that index!")
        End If

        Dim dev As DsDevice = capDevices(iDeviceNum)

        Try
            ' Set up the capture graph
            SetupGraph(dev, iFrameRate, iWidth, iHeight)
        Catch
            Dispose()
            If unsupportedVideo Then
                msgbox("This video resolution isn't supported by the camera - please choose a different resolution.")
            Else
                Throw
            End If

        End Try
    End Sub
    ' <summary> release everything. </summary>
    Public Sub Dispose() Implements IDisposable.Dispose
        CloseInterfaces()
        If (Not m_Bitmap Is Nothing) Then
            m_Bitmap.UnlockBits(m_bmdLogo)
            m_Bitmap = Nothing
            m_bmdLogo = Nothing
        End If
    End Sub
    Protected Overloads Overrides Sub finalize()
        CloseInterfaces()
    End Sub

    ' <summary> capture the next image </summary>
    Public Sub Start()
        If (m_bRunning = False) Then
            Dim hr As Integer = m_mediaCtrl.Run()
            DsError.ThrowExceptionForHR(hr)

            m_bRunning = True
        End If
    End Sub
    ' Pause the capture graph.
    ' Running the graph takes up a lot of resources.  Pause it when it
    ' isn't needed.
    Public Sub Pause()
        If (m_bRunning) Then
            Dim hr As Integer = m_mediaCtrl.Pause()
            DsError.ThrowExceptionForHR(hr)

            m_bRunning = False
        End If
    End Sub

    'Added by jk
    Public Sub TakePicture()

        m_takePicture = True

    End Sub

    ' <summary> Specify the logo file to write onto each frame </summary>
    Public Sub SetLogo(ByVal fileName As String)
        SyncLock Me
            If (fileName.Length > 0) Then
                m_Bitmap = New Bitmap(fileName)

                Dim r As Rectangle = New Rectangle(0, 0, m_Bitmap.Width, m_Bitmap.Height)
                m_bmdLogo = m_Bitmap.LockBits(r, ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
            Else
                If Not m_Bitmap Is Nothing Then
                    m_Bitmap.UnlockBits(m_bmdLogo)
                    m_Bitmap = Nothing
                    m_bmdLogo = Nothing
                End If
            End If
        End SyncLock
    End Sub

    ' <summary> build the capture graph for grabber. </summary>
    Private Sub SetupGraph(ByVal dev As DsDevice, ByVal iFrameRate As Integer, ByVal iWidth As Integer, ByVal iHeight As Integer)

        Dim hr As Integer

        Dim baseGrabFlt As IBaseFilter = Nothing
        Dim capFilter As IBaseFilter = Nothing
        Dim muxFilter As IBaseFilter = Nothing
        Dim fileWriterFilter As IFileSinkFilter = Nothing
        Dim capGraph As ICaptureGraphBuilder2 = Nothing
        Dim sampGrabberSnap As ISampleGrabber = Nothing

        ' Get the graphbuilder object
        m_graphBuilder = DirectCast(New FilterGraph(), IFilterGraph2)
        m_mediaCtrl = DirectCast(m_graphBuilder, IMediaControl)

        'if taking a picture (a still snapshot), then remove the videowindow
        If Not m_takePicture Then
            mediaEventEx = DirectCast(m_graphBuilder, IMediaEventEx)
            videoWindow = DirectCast(m_graphBuilder, IVideoWindow)
        Else
            mediaEventEx = Nothing
            videoWindow = Nothing
        End If

#If DEBUG Then
        m_rot = New DsROTEntry(m_graphBuilder)
#End If

        Try


            ' Get the ICaptureGraphBuilder2
            capGraph = DirectCast(New CaptureGraphBuilder2(), ICaptureGraphBuilder2)

            ' Get the SampleGrabber interface
            sampGrabber = DirectCast(New SampleGrabber(), ISampleGrabber)
            sampGrabberSnap = DirectCast(New SampleGrabber(), ISampleGrabber)

            ' Start building the graph
            hr = capGraph.SetFiltergraph(DirectCast(m_graphBuilder, IGraphBuilder))
            DsError.ThrowExceptionForHR(hr)

            ' Add the video device
            hr = m_graphBuilder.AddSourceFilterForMoniker(dev.Mon, Nothing, dev.Name, capFilter)
            DsError.ThrowExceptionForHR(hr)

            baseGrabFlt = DirectCast(sampGrabber, IBaseFilter)
            ConfigureSampleGrabber(sampGrabber)

            ' Add the frame grabber to the graph
            hr = m_graphBuilder.AddFilter(baseGrabFlt, "Ds.NET Grabber")
            DsError.ThrowExceptionForHR(hr)

            ' If any of the default config items are set
            If (iFrameRate + iHeight + iWidth > 0) Then

                SetConfigParms(capGraph, capFilter, iFrameRate, iWidth, iHeight)
            End If

            hr = capGraph.RenderStream(PinCategory.Capture, MediaType.Video, capFilter, baseGrabFlt, muxFilter)
            DsError.ThrowExceptionForHR(hr)

            'if you set the m_takePicture it won't
            If Not m_takePicture Then

                'Set the output of the preview
                hr = mediaEventEx.SetNotifyWindow(UseHand, WMGraphNotify, IntPtr.Zero)
                DsError.ThrowExceptionForHR(hr)

                'Set Owner to Display Video
                hr = videoWindow.put_Owner(UseHand)
                DsError.ThrowExceptionForHR(hr)

                'Set window location - this was necessary so that the video didn't move down and to the right when you pushed the start/stop button
                hr = videoWindow.SetWindowPosition(0, 0, 320, 240)
                DsError.ThrowExceptionForHR(hr)

                'Set Owner Video Style
                hr = videoWindow.put_WindowStyle(WindowStyle.Child)
                DsError.ThrowExceptionForHR(hr)

            End If


            SaveSizeInfo(sampGrabber)

        Finally

            If (Not fileWriterFilter Is Nothing) Then
                Marshal.ReleaseComObject(fileWriterFilter)
                fileWriterFilter = Nothing
            End If
            If (Not muxFilter Is Nothing) Then
                Marshal.ReleaseComObject(muxFilter)
                muxFilter = Nothing
            End If
            If (Not capFilter Is Nothing) Then
                Marshal.ReleaseComObject(capFilter)
                capFilter = Nothing
            End If
            If (Not sampGrabber Is Nothing) Then
                Marshal.ReleaseComObject(sampGrabber)
                sampGrabber = Nothing
            End If
        End Try
    End Sub

    ' <summary> Read and store the properties </summary>
    Private Sub SaveSizeInfo(ByVal sampGrabber As ISampleGrabber)

        Dim hr As Integer

        ' Get the media type from the SampleGrabber
        Dim media As AMMediaType = New AMMediaType()
        hr = sampGrabber.GetConnectedMediaType(media)
        DsError.ThrowExceptionForHR(hr)

        If (Not (media.formatType.Equals(FormatType.VideoInfo)) AndAlso Not (media.formatPtr.Equals(IntPtr.Zero))) Then
            Throw New NotSupportedException("Unknown Grabber Media Format")
        End If

        ' Grab the size info
        Dim vInfoHeader As VideoInfoHeader = New VideoInfoHeader()
        Marshal.PtrToStructure(media.formatPtr, vInfoHeader)
        m_videoWidth = vInfoHeader.BmiHeader.Width
        m_videoHeight = vInfoHeader.BmiHeader.Height
        m_stride = CInt(m_videoWidth * (vInfoHeader.BmiHeader.BitCount / 8))

        DsUtils.FreeAMMediaType(media)
        media = Nothing
    End Sub
    ' <summary> Set the options on the sample grabber </summary>
    Private Sub ConfigureSampleGrabber(ByVal sampGrabber As ISampleGrabber)
        Dim hr As Integer
        Dim media As AMMediaType = New AMMediaType()

        media.majorType = MediaType.Video
        media.subType = MediaSubType.RGB24
        media.formatType = FormatType.VideoInfo
        hr = sampGrabber.SetMediaType(media)
        DsError.ThrowExceptionForHR(hr)

        DsUtils.FreeAMMediaType(media)
        media = Nothing

        ' Configure the samplegrabber callback
        hr = sampGrabber.SetOneShot(False)
        DsError.ThrowExceptionForHR(hr)

        If m_takePicture Then
            hr = sampGrabber.SetCallback(Me, 0)
        Else
            hr = sampGrabber.SetCallback(Me, 0)
        End If
        DsError.ThrowExceptionForHR(hr)

        DsError.ThrowExceptionForHR(hr)

        'set the samplegrabber
        sampGrabber.SetBufferSamples(False)

    End Sub

    ' Set the Framerate, and video size
    Private Sub SetConfigParms(ByVal capGraph As ICaptureGraphBuilder2, ByVal capFilter As IBaseFilter, ByVal iFrameRate As Integer, ByVal iWidth As Integer, ByVal iHeight As Integer)
        Dim hr As Integer

        Dim o As Object = Nothing
        Dim media As AMMediaType = Nothing
        Dim videoStreamConfig As IAMStreamConfig
        Dim videoControl As IAMVideoControl = DirectCast(capFilter, IAMVideoControl)

        ' Find the stream config interface
        hr = capGraph.FindInterface(PinCategory.Capture, MediaType.Video, capFilter, GetType(IAMStreamConfig).GUID, o)

        videoStreamConfig = DirectCast(o, IAMStreamConfig)
        Try
            If (videoStreamConfig Is Nothing) Then
                Throw New Exception("Failed to get IAMStreamConfig")
            End If

            ' Get the existing format block
            hr = videoStreamConfig.GetFormat(media)
            DsError.ThrowExceptionForHR(hr)

            ' copy out the videoinfoheader
            Dim v As VideoInfoHeader = New VideoInfoHeader()
            Marshal.PtrToStructure(media.formatPtr, v)

            ' if overriding the framerate, set the frame rate
            If (iFrameRate > 0) Then
                v.AvgTimePerFrame = CLng(10000000 / iFrameRate)
            End If

            ' if overriding the width, set the width
            If (iWidth > 0) Then
                v.BmiHeader.Width = iWidth
            End If

            ' if overriding the Height, set the Height
            If (iHeight > 0) Then
                v.BmiHeader.Height = iHeight
            End If

            ' Copy the media structure back
            Marshal.StructureToPtr(v, media.formatPtr, False)

            ' Set the new format
            hr = videoStreamConfig.SetFormat(media)
            If hr <> 0 Then unsupportedVideo = True Else unsupportedVideo = False
            DsError.ThrowExceptionForHR(hr)

            DsUtils.FreeAMMediaType(media)
            media = Nothing

            ' Fix upsidedown video
            If (Not videoControl Is Nothing) Then
                Dim pCapsFlags As VideoControlFlags

                Dim pPin As IPin = DsFindPin.ByCategory(capFilter, PinCategory.Capture, 0)
                hr = videoControl.GetCaps(pPin, pCapsFlags)
                DsError.ThrowExceptionForHR(hr)

                If (CDbl(pCapsFlags & VideoControlFlags.FlipVertical) > 0) Then
                    hr = videoControl.GetMode(pPin, pCapsFlags)
                    DsError.ThrowExceptionForHR(hr)

                    hr = videoControl.SetMode(pPin, 0)
                End If
            End If
        Finally
            Marshal.ReleaseComObject(videoStreamConfig)
        End Try
    End Sub

    ' <summary> Shut down capture </summary>
    Private Sub CloseInterfaces()
        Dim hr As Integer

        Try
            If (Not m_mediaCtrl Is Nothing) Then

                ' Stop the graph
                hr = m_mediaCtrl.Stop()
                m_mediaCtrl = Nothing
                m_bRunning = False

                'Release Window Handle, Reset back to Normal
                hr = videoWindow.put_Visible(OABool.False)
                DsError.ThrowExceptionForHR(hr)

                hr = videoWindow.put_Owner(IntPtr.Zero)
                DsError.ThrowExceptionForHR(hr)

                If mediaEventEx Is Nothing = False Then
                    hr = mediaEventEx.SetNotifyWindow(IntPtr.Zero, 0, IntPtr.Zero)
                    DsError.ThrowExceptionForHR(hr)
                End If

            End If
        Catch ex As Exception
            Debug.WriteLine(ex)
        End Try

#If DEBUG Then
        If (Not m_rot Is Nothing) Then
            m_rot.Dispose()
            m_rot = Nothing
        End If
#End If

        If (Not m_graphBuilder Is Nothing) Then
            Marshal.ReleaseComObject(m_graphBuilder)
            m_graphBuilder = Nothing
        End If
        GC.Collect()
    End Sub

    ' <summary> sample callback, Originally not used - call this with integer 0 on the setcallback method </summary>
    Function SampleCB(ByVal SampleTime As Double, ByVal pSample As IMediaSample) As Integer Implements ISampleGrabberCB.SampleCB
        myTest = "In SampleCB"

        Dim i As Integer = 0

        'jk added this code 10-22-13
        If IsDBNull(pSample) = True Then Return -1
        Dim myLen As Integer = pSample.GetActualDataLength()
        Dim pbuf As IntPtr
        If pSample.GetPointer(pbuf) = 0 And mylen > 0 Then
            Dim buf As Byte() = New Byte(myLen) {}
            Marshal.Copy(pbuf, buf, 0, myLen)

            'Alter the video - you could use this to adjust the brightness/red/green, etc.
            'for i = myLen-1 to 0 step -1
            '    buf(i) = (255 - buf(i))
            'Next i

            If m_takePicture Then
                Dim bm As New Bitmap(m_videoWidth, m_videoHeight, Imaging.PixelFormat.Format24bppRgb)
                Dim g_RowSizeBytes As Integer
                Dim g_PixBytes() As Byte

                mytest = "Execution point #1"
                Dim m_BitmapData As BitmapData = Nothing
                Dim bounds As Rectangle = New Rectangle(0, 0, m_videoWidth, m_videoHeight)

                mytest = "Execution point #2"
                m_BitmapData = bm.LockBits(bounds, Imaging.ImageLockMode.ReadWrite, Imaging.PixelFormat.Format24bppRgb)

                mytest = "Execution point #4"
                g_RowSizeBytes = m_BitmapData.Stride

                mytest = "Execution point #5"
                ' Allocate room for the data.
                Dim total_size As Integer = m_BitmapData.Stride * m_BitmapData.Height
                ReDim g_PixBytes(total_size)

                mytest = "Execution point #10"

                'this writes the data to the Bitmap
                Marshal.Copy(buf, 0, m_BitmapData.Scan0, mylen)
                capturedPic = bm
                mytest = "Execution point #15"

                ' Release resources.
                bm.UnlockBits(m_BitmapData)
                g_PixBytes = Nothing
                m_BitmapData = Nothing
                bm = Nothing
                buf = Nothing

                m_takePicture = False
                captureSaved = True
                mytest = "Execution point #20"
            End If
        End If


        Marshal.ReleaseComObject(pSample)
        Return 0

    End Function

    ' <summary> buffer callback, Not used - call this with integer 1 on the setcallback method </summary>
    Function BufferCB(ByVal SampleTime As Double, ByVal pBuffer As IntPtr, ByVal BufferLen As Integer) As Integer Implements ISampleGrabberCB.BufferCB

        SyncLock Me

            myTest = "In BufferCB"

        End SyncLock

        Return 0
    End Function
End Class

有人可以帮助实现上述目标。 1)枚举Combobox中的设备 2)快照选择网络摄像头设备到文件。

感谢任何帮助:)

1 个答案:

答案 0 :(得分:0)

我正在使用AForge(我的程序做了一些,但这会给你一个开始) 我没有弹出对话框,因为它自己枚举它(你可能只想要那个代码块) 您还可以将所有My.Settings设置为硬编码设置。 这会为视频创建一个显示,但如果您不希望它显示,您只需设置vspMonitor.visible = False即可。

Imports AForge.Controls
Imports AForge.Video
Imports AForge.Video.DirectShow
Imports AForge.Video.VFW
Imports System.IO

Public Class Main

    Private WithEvents timer As New Timer
'Stores the file path, e.g.: "F:\Temp"
    Friend Shared strICLocation As String = My.Settings.ICSet
'Stores the common name for the file, such as "Capture" (Screenshot, whatever you want)
    Friend Shared strICFileRootName As String = My.Settings.ICRootName
'Stores the image format to save in a 3 char string: PNG, JPG, BMP
    Friend Shared strICType As String = My.Settings.ICType

Dim VideoCaptureSource As VideoCaptureDevice
Dim VideoDevices As New FilterInfoCollection(FilterCategory.VideoInputDevice)
Private Property VideoCapabilities As VideoCapabilities()
Dim frame As System.Drawing.Bitmap
Dim filename As String

Private Sub Main_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'You'll need the following items in your UI at minimum:
'Button named btnConnect, button named btnDisconnect, Video Source Player (From AForge libraries) named vspMonitor, a Combo Box named cmbVideoSource
    EnumerateVideoDevices()
    btnDisconnect.Enabled = False
            btnConnect.Enabled = True
    strICFileRootName = My.Settings.ICRootName
            strICLocation = My.Settings.ICSet
            lblICLocation.Text = strICLocation
    End Sub

  Private Sub EnumerateVideoDevices()
        ' enumerate video devices
        VideoDevices = New FilterInfoCollection(FilterCategory.VideoInputDevice)
        If VideoDevices.Count <> 0 Then
            ' add all devices to combo
            For Each device As FilterInfo In VideoDevices
                cmbVideoSource.Items.Add(device.Name)
                cmbVideoSource.SelectedIndex = 0
                VideoCaptureSource = New VideoCaptureDevice(VideoDevices(cmbVideoSource.SelectedIndex).MonikerString)
                EnumerateVideoModes(VideoCaptureSource)
            Next
        Else
            cmbVideoSource.Items.Add("No DirectShow devices found")
        End If
        cmbVideoSource.SelectedIndex = 0
    End Sub
    Private Sub EnumerateVideoModes(device As VideoCaptureDevice)
        ' get resolutions for selected video source
        Me.Cursor = Cursors.WaitCursor
        cmbVideoModes.Items.Clear()
        Try
            Dim VideoCapabilities = device.VideoCapabilities
            For Each capabilty As VideoCapabilities In VideoCapabilities
                If Not cmbVideoModes.Items.Contains(capabilty.FrameSize) Then
                    cmbVideoModes.Items.Add(capabilty.FrameSize)
                End If
            Next
            If VideoCapabilities.Length = 0 Then
                cmbVideoModes.Items.Add("Not supported")
            End If
            cmbVideoModes.SelectedIndex = 0
        Finally
            Me.Cursor = Cursors.[Default]
        End Try
    End Sub

#Region "IC (Image Capture)"
    Private Sub btnICOptions_Click(sender As Object, e As EventArgs) Handles btnICOptions.Click
' I use a form to set to image save type; handle it however you want, including hard-coding it            
Dim frm As New frmICOptions
        frm.Show()
    End Sub

    Private Sub btnICSet_Click(sender As Object, e As EventArgs) Handles btnICSet.Click
'Make a button called btnICSet to set the save path
        Dim dialog As New FolderBrowserDialog()
        dialog.Description = "Select Image Capture save path"
        If dialog.ShowDialog() = Windows.Forms.DialogResult.OK Then
            strICLocation = dialog.SelectedPath
            lblICLocation.Text = strICLocation
        End If
    End Sub

    Private Sub ICCapture_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnICCapture.Click
'Need a button called btnICCapture.  This is what will initiate the screen cap.
        Try
            If vspMonitor.IsRunning = True Then
                If My.Settings.ICType = "PNG" Then
                    Dim strFilename As String = strICFileRootName & " " & Format(Now, "yyyy-MMM-dd HH.mm.ss.fff") & ".png"
                    vspMonitor.GetCurrentVideoFrame.Save(strICLocation & "\" & strFilename, System.Drawing.Imaging.ImageFormat.Png)
                ElseIf My.Settings.ICType = "JPG" Then
                    Dim strFilename As String = strICFileRootName & " " & Format(Now, "yyyy-MMM-dd HH.mm.ss.fff") & ".jpg"
                    vspMonitor.GetCurrentVideoFrame.Save(strICLocation & "\" & strFilename, System.Drawing.Imaging.ImageFormat.Jpeg)
                Else
                    Dim strFilename As String = strICFileRootName & " " & Format(Now, "yyyy-MMM-dd HH.mm.ss.fff") & ".bmp"
                    vspMonitor.GetCurrentVideoFrame.Save(strICLocation & "\" & strFilename, System.Drawing.Imaging.ImageFormat.Bmp)
                End If
            End If
        Catch ex As Exception
            MessageBox.Show("Try taking snapshot again when video image is visible.", "Cannot Save Image", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try
    End Sub

#End Region
End Class

可能有一些无关的(为了您的目的)变量和设置(我的应用程序执行图像捕获,屏幕捕获,视频捕获,停止动作捕获(到图像或视频)和动态检测捕获到视频,所以我基本上猛拉了这个它的代码试图让你朝着正确的方向前进。)如果我遗漏任何错误,我会很乐意修改它。