2

我正在尝试在 Visual Studio 2008 中编写一个程序,该程序将访问网络摄像头,在屏幕上显示预览,然后在按下按钮时保存静止快照 (.jpg)。稍后我会将它与数据库集成,但我不应该对那部分有任何问题。在做了一些研究之后,看起来 DirectShow 是最好的选择,因为 WIA 不能在我拥有的相机上工作(而且我不确定它是否会在未来继续工作)。最好,我需要我的解决方案从 Windows XP 到 Windows 7。我以前从未使用过 DirectShow(或类似的)。我遇到的一个问题是大部分代码都是用 C# 编写的,而我从未学过。我找到了一个也使用 vb.net 的 DirectShow.Net 库,这很有帮助,但我仍然遇到问题。以下代码取自库中的示例,并且有效,但我想稍微改变它,但不能让它工作。代码现在将相机捕获保存到文件中。我可以删除“capGraph.SetOutputFileName”行,视频只会启动到它自己的窗口中,但我不知道如何控制它。基本上,我想知道如何做两件事:

  1. 如何让 DirectShow 在我指定的表单(图片框?)上的控件中显示?
  2. 然后,当用户单击按钮时,我是否可以获取该视频的快照(它可以暂停视频或其他任何内容,因为那时我不需要恢复预览,至少不需要几秒钟。)

非常感谢,如果其中一些措辞不是很好,我们深表歉意。我是自学成才的,在 vba 和 php 方面做了很多工作,但这有点超出我的经验。

'****************************************************************************
'While the underlying libraries are covered by LGPL, this sample is released 
'as public domain.  It is distributed in the hope that it will be useful, but 
'WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
'or FITNESS FOR A PARTICULAR PURPOSE.  
'*****************************************************************************/

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"

    ' <summary> graph builder interface. </summary>
    Private m_graphBuilder As IFilterGraph2 = Nothing
    Private m_mediaCtrl As IMediaControl = Nothing

    ' <summary> Set by async routine when it captures an image </summary>
    Private 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, ByVal FileName As String)
        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, FileName)
        Catch
            Dispose()
            Throw
        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

    ' <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, ByVal FileName As String)

        Dim hr As Integer

        Dim sampGrabber As ISampleGrabber = Nothing
        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

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

#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)

            ' 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.SetOutputFileName(MediaSubType.Avi, FileName, muxFilter, fileWriterFilter)
            DsError.ThrowExceptionForHR(hr)

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

            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 = 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.SetCallback(Me, 0)
        DsError.ThrowExceptionForHR(hr)
    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 = 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)
            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 ((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
            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
    Dim hr As Integer
        '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)
                for i = 0 to myLen-1 step 2
                    buf(i) = (255 - buf(i))
                Next i



                Dim g_RowSizeBytes As Integer
                Dim g_PixBytes() As Byte

                Dim bm As Bitmap = Nothing
                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 modified data
                Marshal.Copy(buf, 0, m_BitmapData.Scan0, mylen)

                ' Unlock the bitmap.
                bm.UnlockBits(m_BitmapData)

                ' Release resources.
                g_PixBytes = Nothing
                m_BitmapData = Nothing

            End If


    Marshal.ReleaseComObject(pSample)
    Return 0

End Function

    ' <summary> buffer callback, COULD BE FROM FOREIGN THREAD. </summary>
    Function BufferCB(ByVal SampleTime As Double, ByVal pBuffer As IntPtr, ByVal BufferLen As Integer) As Integer Implements ISampleGrabberCB.BufferCB
        SyncLock Me
            If (Not m_bmdLogo Is Nothing) Then
                Dim ipSource As IntPtr = m_bmdLogo.Scan0
                Dim ipDest As IntPtr = pBuffer
                Dim x As Integer
                For x = 0 To m_bmdLogo.Height - 1
                    CopyMemory(ipDest, ipSource, m_bmdLogo.Stride)
                    ipDest = New IntPtr(ipDest.ToInt32() + m_stride)
                    ipSource = New IntPtr(ipSource.ToInt32() + m_bmdLogo.Stride)
                Next x
            End If
        End SyncLock

        Return 0
    End Function
End Class
4

3 回答 3

2

这是我最终用于我的项目的内容 - 它为您提供了一个预览窗口,然后在另一个表单上您可以按下按钮来拍照。我拍摄照片并将该静止图像显示为主窗体上的另一个图片框(稍大一点)。我添加了一个裁剪框来选择您最终想要保存的图片框的哪个部分,但为了简单起见,我没有将其包含在这个答案中。

你用调用初始化它:cam = New Capture(my.Settings.VideoDeviceNum, FRAMERATE, my.Settings.CapturePictureWidth, my.Settings.CapturePictureHeight)cam.Start()

使用此调用拍摄快照:

Dim picError As Boolean=False

        cam.captureSaved=False
        cam.TakePicture
        Dim stTime As date = Now

        Do Until cam.captureSaved
            'do nothing - might want to have an automatic break if this takes too long
            If DateDiff(DateInterval.Second,stTime,Now) >15 then
                MsgBox("The camera is taking a long time to capture the picture. Please try again.")
                picError=True:Exit do
            End If

        Loop

        If not picError then
            cam.Capturedpic.RotateFlip (RotateFlipType.Rotate180FlipX)

            'scale the camera image and place it in the picture box
            CaptureBox.Image=scaleimage(cam.capturedpic,CaptureBox.Width,CaptureBox.Height)
        End If    

        SavePicture.Visible = True
        myStatus.Text = "Picture Taken."

scaleimage 函数只是将快照图像缩放到适合我在表单上的框的大小。我只使用缩放 x,因为我只允许特定的纵横比,所以如果您不打算锁定相机的纵横比,则需要对其进行调整:

Public Function ScaleImage(source As Bitmap, x As Integer, y As Integer) As Bitmap

        Dim scale As single = x / source.Width

        Dim myBmp As new Bitmap(cint(source.Width*scale), cint(source.height*scale),source.PixelFormat)

        Dim gr As Graphics = Graphics.FromImage(myBmp)

        gr.DrawImage(source, 0, 0, myBmp.Width + 1, myBmp.Height + 1)

        Return myBmp  

    End Function

主要的相机类如下:

'****************************************************************************
'While the underlying libraries are covered by LGPL, this sample is released 
'as public domain.  It is distributed in the hope that it will be useful, but 
'WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
'or FITNESS FOR A PARTICULAR PURPOSE.  
'*****************************************************************************/

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"

    ' <summary> graph builder interface. </summary>
    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.PreviewBox.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, my.Settings.previewwidth, my.Settings.previewHeight)
                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 = 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 = 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 ((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

我确信这可以改进,但它现在很适合我的目的,我希望它可以帮助某人。

于 2013-11-27T18:51:34.663 回答
0

要显示视频,您将需要类似VideoWindowBasicVideo2过滤器之类的东西,它允许您指定窗口控件以在其上绘制视频:

iVidWdw.put_Owner(mVidCtl.Handle). 

我从来没有SampleGrabber开始工作,但是BasicVideoVMR9并且MediaDetector都可以捕获(可能需要一两个MediaSeeking)。听起来您可能需要一个过滤器来保存到文件(如果需要)和另一个来播放/显示,这并不少见。此外,您几乎肯定需要处理 C# Lib 中的 getbitmap(快照)部分,以将 bmp 数据转换为托管资源。

帧捕获很大程度上取决于所使用的过滤器。正如我所说,我运气不佳,SampleGrabber其他人的工作方式都不同。大多数返回位图数据不是位图,并且有些图像是上下颠倒的,因此必须将数据传输到托管位图(在 C# 中更快),然后根据使用的过滤器进行旋转。

如果你必须SampleGrabber工作(这就是它抓取图像的全部 - 也许是剪辑,我忘记了),你应该能够保存位图/捕获 - 我不确定基于帖子的状态。听起来您有 3 个问题:a)捕获相机流 b)将流保存到磁盘(?)然后 c)获取快照

关于帧上限的另一个细节是,某些过滤器需要暂停图表才能捕获。对于网络摄像头流来说,这可能不是最理想的,因此它会排除 1 或 2(BasicVideo2至少是其中之一)。

于 2013-10-21T17:07:41.710 回答
0

以下是使用 Sample Grabber 在 C# 和 DirectShow 中处理网络摄像头视频流图像的简短示例:

http://www.infognition.com/blog/2013/working_with_raw_video_in_c_sharp_directshow.html

您只需要通过将其设置为样本采集器的首选格式或在接收到数据时转换数据来以合适的格式(RGB24 或 RGB32,而不是 YUY2)获取数据。然后将其保存到 jpeg/位图文件是微不足道的。

于 2013-10-22T11:59:18.837 回答