【Emgu.CV轮廓检测】VB.NET代码

Imports System.Drawing.Imaging
Imports System.IO
Imports System.Windows.Forms.VisualStyles.VisualStyleElement
Imports Emgu.CV
Imports Emgu.CV.CvEnum
Imports Emgu.CV.Structure
Imports System.Drawing
Imports Emgu.CV.Util
Imports System.Windows.Media.Imaging
Imports System.Windows.Controls
Imports Aspose.Imaging
Imports System.Windows.Documents

Module Module1
    Sub 目标检测()
        Dim 彩图 = New Image(Of Bgr, Byte)(Form1.读取图像路径)
        Dim 灰图 = 彩图.Mat.Clone()
        CvInvoke.CvtColor(彩图, 灰图, ColorConversion.Bgr2Gray)

        Dim 二值图 = New Mat()
        CvInvoke.Threshold(灰图, 二值图, 122, 255, ThresholdType.Binary)

        '查找轮廓
        Dim 轮廓信息 As VectorOfVectorOfPoint = New VectorOfVectorOfPoint()
        CvInvoke.FindContours(二值图, 轮廓信息, Nothing, RetrType.External, ChainApproxMethod.LinkRuns)

        '得出所有边界框
        Dim 边界框 As New List(Of Drawing.Rectangle)
        For i = 0 To 轮廓信息.Size - 1
            边界框.Add(CvInvoke.BoundingRectangle(轮廓信息(i)))
        Next

        '合并矩形框
        '差距如果是负数,将会屏蔽掉小矩形,如果是正数,可能会合并所有矩形
        Dim 差距 As Int16 = 10
        Dim 新轮廓 As New List(Of Drawing.Rectangle)
        Dim 元素数 As Int16 = 边界框.Count - 1
        For i = 0 To 元素数
            For j = i + 1 To 元素数
                If 边界框(i).Right > 边界框(j).X - 差距 AndAlso 边界框(i).Y < 边界框(j).Bottom + 差距 AndAlso
                   边界框(j).Right > 边界框(i).X - 差距 AndAlso 边界框(j).Y < 边界框(i).Bottom + 差距 Then
                    Dim 新矩形 = 创建Rectangle(边界框(i), 边界框(j))
                    If 新轮廓.Count > 1 Then
                        For k = 0 To 新轮廓.Count - 1
                            If 新矩形.Right > 新轮廓(k).X - 差距 AndAlso 新矩形.Y < 新轮廓(k).Bottom + 差距 AndAlso
                                   新轮廓(k).Right > 新矩形.X - 差距 AndAlso 新轮廓(k).Y < 新矩形.Bottom + 差距 Then
                                新轮廓(k) = 创建Rectangle(新矩形, 新轮廓(k))
                                GoTo 跳过
                            End If
                        Next
                    End If
                    新轮廓.Add(新矩形)
跳过:
                End If
            Next
        Next

        ' 在彩图上绘制边界框
        For i As Integer = 0 To 新轮廓.Count - 1
            CvInvoke.Rectangle(彩图, 新轮廓(i), New MCvScalar(0, 0, 255), 2)
        Next

        Dim jpegData = CvInvoke.Imencode(".jpg", 彩图)
        ' 将JPEG格式的图像数据转换为Bitmap类型的图像对象
        Dim bitmapImage = Nothing
        Using ms As New MemoryStream(jpegData)
            bitmapImage = New Bitmap(Drawing.Image.FromStream(ms))
        End Using
        Form1.显示图像.BackgroundImage = bitmapImage.Clone
    End Sub
    Function 创建Rectangle(矩形1 As Rectangle, 矩形2 As Rectangle) As Drawing.Rectangle
        Dim 最小X = Min(矩形1.X, 矩形2.X)
        Dim 最小Y = Min(矩形1.Y, 矩形2.Y)
        Dim 最大W = Max(矩形1.Right, 矩形2.Right) - 最小X
        Dim 最大H = Max(矩形1.Bottom, 矩形2.Bottom) - 最小Y
        Return New Drawing.Rectangle(最小X, 最小Y, 最大W, 最大H)
    End Function
    Function Max(x As Int32, y As Int32) As Int32
        If x > y Then
            Return x
        Else
            Return y
        End If
    End Function
    Function Min(x As Int32, y As Int32) As Int32
        If x < y Then
            Return x
        Else
            Return y
        End If
    End Function
End Module