EmguCV学习笔记 VB.Net 9.2 VideoWriter类

版权声明：本文为博主原创文章，转载请在显著位置标明本文出处以及作者网名，未经作者允许不得用于商业目的。

EmguCV是一个基于OpenCV的开源免费的跨平台计算机视觉库,它向C#和VB.NET开发者提供了OpenCV库的大部分功能。

教程VB.net版本请访问：EmguCV学习笔记 VB.Net 目录-CSDN博客

教程C#版本请访问：EmguCV学习笔记 C# 目录-CSDN博客

笔者的博客网址：https://blog.csdn.net/uruseibest

教程配套文件及相关说明以及如何获得pdf教程和代码，请移步：EmguCV学习笔记

学习VB.Net知识，请移步： vb.net 教程 目录_vb中如何用datagridview-CSDN博客

 学习C#知识，请移步：C# 教程 目录_c#教程目录-CSDN博客

9.2 VideoWriter类

VideoWriter类提供了将帧图像数据保存为视频文件的功能。

9.2.1 构造函数

VideoWriter类常用的1个构造函数：

Public Sub New(fileName As String, compressionCode As Integer, fps As Double, size As System.Drawing.Size, isColor As Boolean)

参数说明：

1. fileName：保存的视频文件名。如果需要保存的视频文件已经存在，那么videowriter类将会删除原文件，并创建一个新的视频文件。
2. codecId：视频编解码器的代码，详见9.2.2节【Fourcc方法】。
3. fps：视频的帧率。
4. size：视频的宽度和高度。
5. isColor：是否保存彩色视频。

以下是VideoWriter构造函数的示例代码：

Dim vw As New VideoWriter("C:\saved-movie.mp4", codecId, 25, New Drawing.Size(640, 480), True)

9.2.2 Fourcc方法

Four cc是一个用于指定视频编解码器的4字节代码，是一个由四个ASCII字符组成的标识符。Four cc的作用是告诉计算机如何编解码视频文件并正确地显示它。

常见的编解码器格式对应Four cc如下：

编码不同，对电脑性能要求不同，生成文件大小也不同。具体需要哪种编码，要根据实际需求进行综合考虑。

VideoWriter类提供了fourcc静态方法，通过传入的4字符返回一个编解码器的代码。声明如下：

Public Shared Function Fourcc(c1 As Char, c2 As Char, c3 As Char, c4 As Char) As Integer

9.2.3 Write方法

Write方法用于将一帧图像写入视频文件中。该方法声明如下：

Public Sub Write(frame As Emgu.CV.IInputArray)

参数说明：

1. frame：要写入视频文件的帧，类型为Mat。

write方法只能将一帧图像写入视频文件中。如果需要将多帧图像写入视频文件中，可以在write方法的调用中使用循环来实现。

【代码位置：frmChapter9_1】Button11_Click

    '写入视频文件

    Private Sub Button11_Click(sender As Object, e As EventArgs) Handles Button11.Click

        Dim vc As New VideoCapture("C:\learnEmgucv\movie1.mp4")

        If vc.IsOpened = False Then

            Exit Sub

        End If

        Dim codecId As Integer

        'Mpeg-4.2编码

        codecId = VideoWriter.Fourcc("M"c, "P"c, "4"c, "2"c)

        '宽度，同源视频文件

        Dim width As Integer = vc.Get(CapProp.FrameWidth)

        '高度，同源视频文件

        Dim height As Integer = vc.Get(CapProp.FrameHeight)

        '帧率，同源视频文件

        Dim movieFps As Double = vc.Get(CapProp.Fps)

        '使用Mpeg-4.2来编码

        Dim vw As New VideoWriter("C:\learnEmgucv\saved-movie.mp4", codecId, 50, New Drawing.Size(width, height), True)

        Dim m As Mat = New Mat()

        While True

            m = vc.QueryFrame

            If IsNothing(m) Then

                Exit While

            End If

            If m.IsEmpty Then

                Exit While

            End If

            ImageBox1.Image = m

            ImageBox1.Refresh()

            '将帧图像输出到文件

            vw.Write(m)

            Threading.Thread.Sleep(1000 \ movieFps)

        End While

        vc.Dispose()

        vw.Dispose()

        Label1.Text = "保存完毕"

End Sub

【代码位置：frmChapter9_1】Button12_Click、Button13_Click

    '是否停止录制视频标记

    Dim stopRecord As Boolean

    '开始录制摄像头视频

    Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click

        Dim vc As New VideoCapture(0)

        If vc.IsOpened = False Then

            Exit Sub

        End If

        Dim codecId As Integer

        'Mpeg-4.2编码

        codecId = VideoWriter.Fourcc("M"c, "P"c, "4"c, "2"c)

        '使用Mpeg-4.2来编码

        Dim vw As New VideoWriter("C:\learnEmgucv\saved-movie1.mp4", codecId, 25, New Drawing.Size(640, 480), True)

        Dim m As Mat = New Mat()

        stopRecord = False

        While stopRecord = False

            m = vc.QueryFrame

            If IsNothing(m) Then

                Exit While

            End If

            If m.IsEmpty Then

                Exit While

            End If

            Dim mout As New Mat

            CvInvoke.Canny(m, mout, 160, 250, 3)

            ImageBox1.Image = mout

            ImageBox1.Refresh()

            '输出到文件

            vw.Write(mout)

            '需要增加doevents，否则会出现不响应

            Application.DoEvents()

        End While

        '必须释放资源

        vc.Dispose()

        vw.Dispose()

        Label1.Text = "保存完毕"

    End Sub

    '停止录制摄像头视频

    Private Sub Button13_Click(sender As Object, e As EventArgs) Handles Button13.Click

        stopRecord = True

End Sub

事实上，在录制摄像头视频时，即使在循环中加了Application.DoEvents()，程序运行时也会出现卡顿的情况。在实际中最好是在ImageGrabbed事件中进行处理。

【代码位置：frmChapter9_1】Button14_Click、vc3_ImageGrabbed、Button15_Click

    Dim vc3 As VideoCapture

    Dim vw3 As VideoWriter

    '是否停止录制

    Dim stopRecord3 As Boolean = False

    '调用ImageGrabbed进行录制视频

    Private Sub Button14_Click(sender As Object, e As EventArgs) Handles Button14.Click

        vc3 = New VideoCapture(0)

        If vc3.IsOpened = False Then

            MessageBox.Show("打开摄像头失败")

            Exit Sub

        End If

        'stopRecord3 = False

        Dim codecId As Integer

        'Mpeg-4.2编码

        codecId = VideoWriter.Fourcc("M"c, "P"c, "4"c, "2"c)

        vw3 = New VideoWriter("C:\learnEmgucv\saved-movie2.mp4", codecId, 25, New Drawing.Size(640, 480), True)

        '添加ImageGrabbed事件

        AddHandler vc3.ImageGrabbed, AddressOf vc3_ImageGrabbed

        '启动

        vc3.Start()

    End Sub

    '在ImageGrabbed事件里面进行录制视频

    Private Sub vc3_ImageGrabbed(sender As Object, e As EventArgs)

        Dim nextframe As New Mat

        If stopRecord3 = True Then

            '取消事件

            RemoveHandler vc3.ImageGrabbed, AddressOf vc3_ImageGrabbed

            '释放资源

            vc3.Dispose()

            vw3.Dispose()

            Label1.Text = "录制结束"

        Else

            '获得视频图像

            vc3.Retrieve(nextframe)

            '输出

            vw3.Write(nextframe)

            ImageBox1.Image = nextframe

            Threading.Thread.Sleep(40)

        End If

    End Sub

    Private Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click

        stopRecord3 = True

End Sub

【代码位置：frmChapter9_1】Button16_Click、getMask

    '模拟实现绿幕视频和其他视频合并并输出

    '1、为了简化说明，未采用在ImageGrabbed事件中进行处理

    '2、为了取得更好的效果，在实际中还需要考虑对抠图的部分进行边缘处理

    Private Sub Button16_Click(sender As Object, e As EventArgs) Handles Button16.Click

        '前景是一个绿幕视频

        Dim vc1 As New VideoCapture("c:\learnEmgucv\前景.wmv")

        If vc1.IsOpened = False Then

            MessageBox.Show("打开前景文件失败")

            Exit Sub

        End If

        '获得前景视频的帧率

        Dim fps1 As Double = vc1.Get(CapProp.Fps)

        '获得前景文件的帧数

        Dim frames1 As Integer = vc1.Get(CapProp.FrameCount)

        '背景视频

        Dim vc2 As New VideoCapture("c:\learnEmgucv\背景.mp4")

        If vc2.IsOpened = False Then

            MessageBox.Show("打开背景文件失败")

            Exit Sub

        End If

        '获得背景视频的帧率

        Dim fps2 As Double = vc2.Get(CapProp.Fps)

        '获得背景文件的帧数

        Dim frames2 As Integer = vc2.Get(CapProp.FrameCount)

        '输出编码，使用MPEG-4.3

        Dim vfourcc As Integer

        vfourcc = Emgu.CV.VideoWriter.Fourcc("D"c, "I"c, "V"c, "3"c)

        Dim vw As New VideoWriter("c:\learnEmgucv\output-movie.avi", vfourcc, 25, New Size(vc1.Width, vc1.Height), True)

        '输出帧数为两个视频帧数相比较最小的

        Dim maxframecount As Integer = IIf(frames1 > frames2, frames2, frames1)

        For i As Integer = 0 To maxframecount - 1

            Console.WriteLine("处理：" & i)

            '读取前景视频的一帧

            Dim m1 As New Mat

            vc1.Read(m1)

            Dim mmask1 As New Mat

            mmask1 = getMask(m1)

            Dim mfront As New Mat

            CvInvoke.BitwiseAnd(m1, mmask1, mfront)

            '读取背景视频的一帧

            Dim m2 As New Mat

            vc2.Read(m2)

            Dim mmask2 As New Mat

            mmask2 = Not mmask1

            Dim mback As New Mat

            CvInvoke.BitwiseAnd(m2, mmask2, mback)

            Dim mout As New Mat

            mout = mfront + mback

            vw.Write(mout)

            '代码会不定位置出现错误提示：

            'OpenCV: Failed to allocate xxxxx bytes”

            '错误的原因主要是提供的内存不足，无法加载更多数据。

            '解决方法：

            '有些网站提出需要切换到64位编译

            '但是经过测试仍然会出现上述错误

            '最好是把所有资源都释放了（如下）。经测试没有发生错误。

            mmask1.Dispose()

            mmask2.Dispose()

            mfront.Dispose()

            mback.Dispose()

            mout.Dispose()

            Threading.Thread.Sleep(40)

        Next

        vc1.Dispose()

        vc2.Dispose()

        Label1.Text = "输出视频完成"

    End Sub

    '将获得的图像根据颜色范围二值化。

    Private Function getMask(ByVal inputMat As Mat) As Mat

        Dim mhsv As New Mat

        CvInvoke.CvtColor(inputMat, mhsv, ColorConversion.Bgr2Hsv)

        '这里测试的是在这两个颜色范围之间

        Dim lower As New ScalarArray(New MCvScalar(35, 43, 46))

        Dim upper As New ScalarArray(New MCvScalar(77, 255, 255))

        '提取图像中某个颜色范围内的像素

        '颜色值在范围内，则将其设置为白色（255），否则将其设置为黑色（0）

        Dim mmask As New Mat

        CvInvoke.InRange(mhsv, lower, upper, mmask)

        '根据实际需要判断是否反转颜色

        Dim mreversalmask As New Mat

        mreversalmask = Not mmask

        '以下代码输出二值图作为mask的彩色图，也就是原图去除了绿色背景

        Dim m3channel As New Mat

        CvInvoke.CvtColor(mreversalmask, m3channel, ColorConversion.Gray2Bgr)

        Return m3channel

End Function

输出结果如下图所示：

图9-4 模拟绿幕抠图生成视频