VisualBasic.NET的OpenCvSharp4机器视觉编程简单应用

在.NET下常用OpenCV进行图像处理工作,而常用的OpenCV库有Emgu CV和OpenCvSharp。OpenCvSharp使用习惯比EmguCV更接近原始的OpenCV,有详细的使用样例供参考。因此在网上收集了一些OpenCV的应用。

准备工作

打开VS,创建VB.NET的Winform项目。NuGet安装OpenCvSharp4的两个包。

在Form中引用

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
Imports OpenCvSharp
Imports OpenCvSharp
Imports OpenCvSharp

轮廓

vb.net2019- 调用 opencv_AI_LX的博客-CSDN博客_opencv vb

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
Private Sub showPict(ByVal fileName As String)
' Dim src As Mat = New Mat(fileName, ImreadModes.Grayscale)
Dim src As Mat = Cv2.ImRead(fileName, ImreadModes.Grayscale)
Dim dst As Mat = New Mat()
Cv2.Canny(src, dst, 50, 100)
Using (New Window("src image", src))
Using (New Window("dst image", dst))
Cv2.WaitKey()
End Using
End Using
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
OpenFileDialog1.Filter = "Image Files(*.BMP;*.JPG;*.GIF;*.PNG)|*.BMP;*.JPG;*.GIF;*.PNG"
Dim fResult = OpenFileDialog1.ShowDialog() '打开文件选择框
If fResult = DialogResult.OK Then
Dim fileName As String = OpenFileDialog1.FileName '得到选择的文件
showPict(fileName)
End If
End Sub
Private Sub showPict(ByVal fileName As String) ' Dim src As Mat = New Mat(fileName, ImreadModes.Grayscale) Dim src As Mat = Cv2.ImRead(fileName, ImreadModes.Grayscale) Dim dst As Mat = New Mat() Cv2.Canny(src, dst, 50, 100) Using (New Window("src image", src)) Using (New Window("dst image", dst)) Cv2.WaitKey() End Using End Using End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click OpenFileDialog1.Filter = "Image Files(*.BMP;*.JPG;*.GIF;*.PNG)|*.BMP;*.JPG;*.GIF;*.PNG" Dim fResult = OpenFileDialog1.ShowDialog() '打开文件选择框 If fResult = DialogResult.OK Then Dim fileName As String = OpenFileDialog1.FileName '得到选择的文件 showPict(fileName) End If End Sub
Private Sub showPict(ByVal fileName As String)
    ' Dim src As Mat = New Mat(fileName, ImreadModes.Grayscale)
    Dim src As Mat = Cv2.ImRead(fileName, ImreadModes.Grayscale)
    Dim dst As Mat = New Mat()

    Cv2.Canny(src, dst, 50, 100)
    Using (New Window("src image", src))
        Using (New Window("dst image", dst))
            Cv2.WaitKey()
        End Using
    End Using

End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    OpenFileDialog1.Filter = "Image Files(*.BMP;*.JPG;*.GIF;*.PNG)|*.BMP;*.JPG;*.GIF;*.PNG"
    Dim fResult = OpenFileDialog1.ShowDialog() '打开文件选择框
    If fResult = DialogResult.OK Then
        Dim fileName As String = OpenFileDialog1.FileName '得到选择的文件
        showPict(fileName)
    End If
End Sub

调用本地摄像头

c# OpenCvSharp调用电脑本机摄像头 – 蒋智昊的博客 (chanpinxue.cn)

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
' 定义图像捕捉方式 从摄像头 , 注意 Windows下需要选择 VideoCaptureAPIs.DSHOW
Dim capture = New VideoCapture(0, VideoCaptureAPIs.DSHOW)
If Not capture.IsOpened() Then Return
capture.XI_OffsetX = 0 '以左上角为起点 坐标X
capture.XI_OffsetY = 0 '以左上角为起点 坐标Y
capture.FrameWidth = 640 '
capture.FrameHeight = 480 '高
capture.AutoFocus = True
Const sleepTime As Integer = 10
Dim window = New Window("cv")
'Mat作为图像的存储容器
Dim image = New Mat()
While True
capture.Read(image)
If image.Empty() Then Exit While
window.ShowImage(image)
'Windows窗体PictureBox加载
'picboxDest.Image = image.ToBitmap()
Dim flag As Integer = Cv2.WaitKey(sleepTime)
If flag >= 0 Then
Exit While
End If
Application.DoEvents()
End While
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click ' 定义图像捕捉方式 从摄像头 , 注意 Windows下需要选择 VideoCaptureAPIs.DSHOW Dim capture = New VideoCapture(0, VideoCaptureAPIs.DSHOW) If Not capture.IsOpened() Then Return capture.XI_OffsetX = 0 '以左上角为起点 坐标X capture.XI_OffsetY = 0 '以左上角为起点 坐标Y capture.FrameWidth = 640 '宽 capture.FrameHeight = 480 '高 capture.AutoFocus = True Const sleepTime As Integer = 10 Dim window = New Window("cv") 'Mat作为图像的存储容器 Dim image = New Mat() While True capture.Read(image) If image.Empty() Then Exit While window.ShowImage(image) 'Windows窗体PictureBox加载 'picboxDest.Image = image.ToBitmap() Dim flag As Integer = Cv2.WaitKey(sleepTime) If flag >= 0 Then Exit While End If Application.DoEvents() End While End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
    ' 定义图像捕捉方式 从摄像头 , 注意 Windows下需要选择 VideoCaptureAPIs.DSHOW
    Dim capture = New VideoCapture(0, VideoCaptureAPIs.DSHOW)
    If Not capture.IsOpened() Then Return
    capture.XI_OffsetX = 0 '以左上角为起点 坐标X
    capture.XI_OffsetY = 0 '以左上角为起点 坐标Y
    capture.FrameWidth = 640 '宽
    capture.FrameHeight = 480 '高 
    capture.AutoFocus = True
    Const sleepTime As Integer = 10
    Dim window = New Window("cv")

    'Mat作为图像的存储容器
    Dim image = New Mat()

    While True
        capture.Read(image)
        If image.Empty() Then Exit While
        window.ShowImage(image)
        'Windows窗体PictureBox加载
        'picboxDest.Image = image.ToBitmap()

        Dim flag As Integer = Cv2.WaitKey(sleepTime)

        If flag >= 0 Then
            Exit While
        End If

        Application.DoEvents()
    End While
End Sub

面部识别

「图像处理」OpenCVSharp 调用摄像头及人脸识别_Raink_LH的博客-CSDN博客_opencvsharp虚拟摄像头

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Dim video As FrameSource = Cv2.CreateFrameSource_Camera(0)
Cv2.NamedWindow("video")
While True
Dim frame As Mat = New Mat()
video.NextFrame(frame)
Dim faceFinder As OpenCvSharp.CascadeClassifier = New CascadeClassifier("E:桌面SamplesEasyPR-masteropencv2datahaarcascadeshaarcascade_frontalface_default.xml")
Dim eyeFinder As OpenCvSharp.CascadeClassifier = New CascadeClassifier("E:桌面SamplesEasyPR-masteropencv2datahaarcascadeshaarcascade_eye_tree_eyeglasses.xml")
Dim faceRects As Rect() = faceFinder.DetectMultiScale(frame)
Dim eyeRects As Rect() = eyeFinder.DetectMultiScale(frame)
If faceRects.Length > 0 Then
Cv2.Rectangle(frame, faceRects(0), New Scalar(0, 0, 255), 3)
End If
If eyeRects.Length > 1 Then
Cv2.Rectangle(frame, eyeRects(0), New Scalar(255, 0, 0), 3)
Cv2.Rectangle(frame, eyeRects(1), New Scalar(255, 0, 0), 3)
End If
Cv2.ImShow("video", frame)
Cv2.WaitKey(1)
End While
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click Dim video As FrameSource = Cv2.CreateFrameSource_Camera(0) Cv2.NamedWindow("video") While True Dim frame As Mat = New Mat() video.NextFrame(frame) Dim faceFinder As OpenCvSharp.CascadeClassifier = New CascadeClassifier("E:桌面SamplesEasyPR-masteropencv2datahaarcascadeshaarcascade_frontalface_default.xml") Dim eyeFinder As OpenCvSharp.CascadeClassifier = New CascadeClassifier("E:桌面SamplesEasyPR-masteropencv2datahaarcascadeshaarcascade_eye_tree_eyeglasses.xml") Dim faceRects As Rect() = faceFinder.DetectMultiScale(frame) Dim eyeRects As Rect() = eyeFinder.DetectMultiScale(frame) If faceRects.Length > 0 Then Cv2.Rectangle(frame, faceRects(0), New Scalar(0, 0, 255), 3) End If If eyeRects.Length > 1 Then Cv2.Rectangle(frame, eyeRects(0), New Scalar(255, 0, 0), 3) Cv2.Rectangle(frame, eyeRects(1), New Scalar(255, 0, 0), 3) End If Cv2.ImShow("video", frame) Cv2.WaitKey(1) End While End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
    Dim video As FrameSource = Cv2.CreateFrameSource_Camera(0)
    Cv2.NamedWindow("video")

    While True
        Dim frame As Mat = New Mat()
        video.NextFrame(frame)
        Dim faceFinder As OpenCvSharp.CascadeClassifier = New CascadeClassifier("E:桌面SamplesEasyPR-masteropencv2datahaarcascadeshaarcascade_frontalface_default.xml")
        Dim eyeFinder As OpenCvSharp.CascadeClassifier = New CascadeClassifier("E:桌面SamplesEasyPR-masteropencv2datahaarcascadeshaarcascade_eye_tree_eyeglasses.xml")
        Dim faceRects As Rect() = faceFinder.DetectMultiScale(frame)
        Dim eyeRects As Rect() = eyeFinder.DetectMultiScale(frame)

        If faceRects.Length > 0 Then
            Cv2.Rectangle(frame, faceRects(0), New Scalar(0, 0, 255), 3)
        End If

        If eyeRects.Length > 1 Then
            Cv2.Rectangle(frame, eyeRects(0), New Scalar(255, 0, 0), 3)
            Cv2.Rectangle(frame, eyeRects(1), New Scalar(255, 0, 0), 3)
        End If

        Cv2.ImShow("video", frame)
        Cv2.WaitKey(1)
    End While
End Sub

对代码中的几个点做说明:

主要是检测到的人脸进行框出,并且实时显示

“E:桌面SamplesEasyPR-masteropencv2datahaarcascadeshaarcascade_frontalface_default.xml” 和

“E:桌面SamplesEasyPR-masteropencv2datahaarcascadeshaarcascade_eye_tree_eyeglasses.xml”

两个文件,这两个文件来自于Opencv(官方C 库),需要下载安装Opencv,在如上的的相应目录去找(我的安装在”E:桌面SamplesEasyPR-masteropencv2″目录)。

光流法检测图像位移及标注

基于opencvsharp的图像位移检测及相似点标注(光流金字塔法)_salt_bean_curd的博客-CSDN博客

Plain text
Copy to clipboard
Open code in new window
EnlighterJS 3 Syntax Highlighter
''' <summary>
''' 光流法,拼接两张图片
''' </summary>
''' <param name="PrevimgColo">第一张图片
''' <param name="NextimgColo">第二张图片
''' <returns></returns>
Private Function MM(PrevimgColo As Mat, NextimgColo As Mat) As Mat
Dim previmg As Mat = New Mat()
Dim nextimg As Mat = New Mat()
Cv2.CvtColor(PrevimgColo, previmg, ColorConversionCodes.BGR2GRAY)
Cv2.CvtColor(NextimgColo, nextimg, ColorConversionCodes.BGR2GRAY)
'特征点检测(角、点)
Const MAX_Count As Integer = 500
Const Win_size As Integer = 10
'像素级检测特征点
Dim points1 As Point2f()
points1 = Cv2.GoodFeaturesToTrack(previmg, MAX_Count, 0.01, 5, New Mat(), 3, False, 0.04)
'亚像素级检测
Dim points1Sub As Point2f()
points1Sub = Cv2.CornerSubPix(previmg, points1, New Size(Win_size, Win_size), New Size(-1, -1), New TermCriteria())
'迭代控制
Dim criteria As TermCriteria = New TermCriteria(CriteriaTypes.Eps And CriteriaTypes.Count, 20, 0.03)
'光流金字塔,输出图二的特征点
Dim status As Byte()
Dim err As Single()
Dim points2 As Point2f() = New Point2f(points1Sub.Length - 1) {}
Cv2.CalcOpticalFlowPyrLK(previmg, nextimg, points1Sub, points2, status, err)
#Region "输出偏移量,两图像拼接,可视化结果"
Dim Coll As Mat() = New Mat(1) {}
Coll(0) = PrevimgColo
Coll(1) = NextimgColo
Dim mergeImg As Mat = New Mat()
Cv2.HConcat(Coll, mergeImg)
Dim points_temp As Point2f() = points2
Dim blue As Scalar = Scalar.Blue
For num As Integer = 0 To points1Sub.Length - 1
If status(num) = 1 Then
points_temp(num).X = PrevimgColo.Width
Cv2.Line(mergeImg, CType(points1Sub(num), Point), CType(points_temp(num), Point), blue, 1, LineTypes.AntiAlias)
End If
Next
#End Region
Return mergeImg
End Function
''' <summary>
''' 光流法,在一张图片上显示
''' </summary>
''' <param name="PrevimgColo">第一张图片
''' <param name="NextimgColo">第二张图片
''' <returns></returns>
Private Function MM1(PrevimgColo As Mat, NextimgColo As Mat) As Mat
Dim previmg As Mat = New Mat()
Dim nextimg As Mat = New Mat()
Cv2.CvtColor(PrevimgColo, previmg, ColorConversionCodes.BGR2GRAY)
Cv2.CvtColor(NextimgColo, nextimg, ColorConversionCodes.BGR2GRAY)
'特征点检测(角、点)
Const MAX_Count As Integer = 500
Const Win_size As Integer = 10
'像素级检测特征点
Dim points1 As Point2f()
points1 = Cv2.GoodFeaturesToTrack(previmg, MAX_Count, 0.01, 5, New Mat(), 3, False, 0.04)
'亚像素级检测
Dim points1Sub As Point2f()
points1Sub = Cv2.CornerSubPix(previmg, points1, New Size(Win_size, Win_size), New Size(-1, -1), New TermCriteria())
'迭代控制
Dim criteria As TermCriteria = New TermCriteria(CriteriaTypes.Eps And CriteriaTypes.Count, 20, 0.03)
'光流金字塔,输出图二的特征点
Dim status As Byte()
Dim err As Single()
Dim points2 As Point2f() = New Point2f(points1Sub.Length - 1) {}
Cv2.CalcOpticalFlowPyrLK(previmg, nextimg, points1Sub, points2, status, err)
#Region "输出偏移量,可视化结果"
Dim mergeImg As Mat = NextimgColo
Dim blue As Scalar = Scalar.Blue
Debug.Print("===========")
For num As Integer = 0 To points1Sub.Length - 1
If status(num) = 1 Then
Cv2.Line(mergeImg, CType(points1Sub(num), Point), CType(points2(num), Point), blue, 1, LineTypes.AntiAlias)
DistanceBetween(points1Sub(num).X, points1Sub(num).Y, points2(num).X, points2(num).Y)
End If
Next
#End Region
Return mergeImg
End Function
Public Function DistanceBetween(ByVal X1 As Single, ByVal Y1 As Single, ByVal X2 As Single, ByVal Y2 As Single) As Single
' Calculate the distance between two points, given their X/Y coordinates.
' The short version...
DistanceBetween = Math.Sqrt((Math.Abs(X2 - X1) ^ 2) (Math.Abs(Y2 - Y1) ^ 2))
' The longer version, to illustrate how it works...
Dim Horizontal As Single, Vertical As Single
Horizontal = Math.Abs(X2 - X1)
Vertical = Math.Abs(Y2 - Y1)
DistanceBetween = Math.Sqrt((Horizontal * Horizontal) (Vertical * Vertical))
If DistanceBetween > 2 Then
Debug.Print(Format(DistanceBetween, "#00.00") & vbTab & Format(X1 - X2, "#00.00") & vbTab & Format(Y1 - Y2, "#00.00"))
End If
End Function
Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
Dim video As FrameSource = Cv2.CreateFrameSource_Camera(0)
Cv2.NamedWindow("video")
While True
Dim frame0 As Mat = New Mat()
video.NextFrame(frame0)
Dim flag As Integer = Cv2.WaitKey(1000)
If flag >= 0 Then
Exit While
End If
Dim frame1 As Mat = New Mat()
video.NextFrame(frame1)
Cv2.ImShow("video", MM1(frame0, frame1))
Cv2.WaitKey(1)
End While
End Sub
''' <summary> ''' 光流法,拼接两张图片 ''' </summary> ''' <param name="PrevimgColo">第一张图片 ''' <param name="NextimgColo">第二张图片 ''' <returns></returns> Private Function MM(PrevimgColo As Mat, NextimgColo As Mat) As Mat Dim previmg As Mat = New Mat() Dim nextimg As Mat = New Mat() Cv2.CvtColor(PrevimgColo, previmg, ColorConversionCodes.BGR2GRAY) Cv2.CvtColor(NextimgColo, nextimg, ColorConversionCodes.BGR2GRAY) '特征点检测(角、点) Const MAX_Count As Integer = 500 Const Win_size As Integer = 10 '像素级检测特征点 Dim points1 As Point2f() points1 = Cv2.GoodFeaturesToTrack(previmg, MAX_Count, 0.01, 5, New Mat(), 3, False, 0.04) '亚像素级检测 Dim points1Sub As Point2f() points1Sub = Cv2.CornerSubPix(previmg, points1, New Size(Win_size, Win_size), New Size(-1, -1), New TermCriteria()) '迭代控制 Dim criteria As TermCriteria = New TermCriteria(CriteriaTypes.Eps And CriteriaTypes.Count, 20, 0.03) '光流金字塔,输出图二的特征点 Dim status As Byte() Dim err As Single() Dim points2 As Point2f() = New Point2f(points1Sub.Length - 1) {} Cv2.CalcOpticalFlowPyrLK(previmg, nextimg, points1Sub, points2, status, err) #Region "输出偏移量,两图像拼接,可视化结果" Dim Coll As Mat() = New Mat(1) {} Coll(0) = PrevimgColo Coll(1) = NextimgColo Dim mergeImg As Mat = New Mat() Cv2.HConcat(Coll, mergeImg) Dim points_temp As Point2f() = points2 Dim blue As Scalar = Scalar.Blue For num As Integer = 0 To points1Sub.Length - 1 If status(num) = 1 Then points_temp(num).X = PrevimgColo.Width Cv2.Line(mergeImg, CType(points1Sub(num), Point), CType(points_temp(num), Point), blue, 1, LineTypes.AntiAlias) End If Next #End Region Return mergeImg End Function ''' <summary> ''' 光流法,在一张图片上显示 ''' </summary> ''' <param name="PrevimgColo">第一张图片 ''' <param name="NextimgColo">第二张图片 ''' <returns></returns> Private Function MM1(PrevimgColo As Mat, NextimgColo As Mat) As Mat Dim previmg As Mat = New Mat() Dim nextimg As Mat = New Mat() Cv2.CvtColor(PrevimgColo, previmg, ColorConversionCodes.BGR2GRAY) Cv2.CvtColor(NextimgColo, nextimg, ColorConversionCodes.BGR2GRAY) '特征点检测(角、点) Const MAX_Count As Integer = 500 Const Win_size As Integer = 10 '像素级检测特征点 Dim points1 As Point2f() points1 = Cv2.GoodFeaturesToTrack(previmg, MAX_Count, 0.01, 5, New Mat(), 3, False, 0.04) '亚像素级检测 Dim points1Sub As Point2f() points1Sub = Cv2.CornerSubPix(previmg, points1, New Size(Win_size, Win_size), New Size(-1, -1), New TermCriteria()) '迭代控制 Dim criteria As TermCriteria = New TermCriteria(CriteriaTypes.Eps And CriteriaTypes.Count, 20, 0.03) '光流金字塔,输出图二的特征点 Dim status As Byte() Dim err As Single() Dim points2 As Point2f() = New Point2f(points1Sub.Length - 1) {} Cv2.CalcOpticalFlowPyrLK(previmg, nextimg, points1Sub, points2, status, err) #Region "输出偏移量,可视化结果" Dim mergeImg As Mat = NextimgColo Dim blue As Scalar = Scalar.Blue Debug.Print("===========") For num As Integer = 0 To points1Sub.Length - 1 If status(num) = 1 Then Cv2.Line(mergeImg, CType(points1Sub(num), Point), CType(points2(num), Point), blue, 1, LineTypes.AntiAlias) DistanceBetween(points1Sub(num).X, points1Sub(num).Y, points2(num).X, points2(num).Y) End If Next #End Region Return mergeImg End Function Public Function DistanceBetween(ByVal X1 As Single, ByVal Y1 As Single, ByVal X2 As Single, ByVal Y2 As Single) As Single ' Calculate the distance between two points, given their X/Y coordinates. ' The short version... DistanceBetween = Math.Sqrt((Math.Abs(X2 - X1) ^ 2) (Math.Abs(Y2 - Y1) ^ 2)) ' The longer version, to illustrate how it works... Dim Horizontal As Single, Vertical As Single Horizontal = Math.Abs(X2 - X1) Vertical = Math.Abs(Y2 - Y1) DistanceBetween = Math.Sqrt((Horizontal * Horizontal) (Vertical * Vertical)) If DistanceBetween > 2 Then Debug.Print(Format(DistanceBetween, "#00.00") & vbTab & Format(X1 - X2, "#00.00") & vbTab & Format(Y1 - Y2, "#00.00")) End If End Function Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click Dim video As FrameSource = Cv2.CreateFrameSource_Camera(0) Cv2.NamedWindow("video") While True Dim frame0 As Mat = New Mat() video.NextFrame(frame0) Dim flag As Integer = Cv2.WaitKey(1000) If flag >= 0 Then Exit While End If Dim frame1 As Mat = New Mat() video.NextFrame(frame1) Cv2.ImShow("video", MM1(frame0, frame1)) Cv2.WaitKey(1) End While End Sub
    ''' 
    ''' 光流法,拼接两张图片
    ''' 
    ''' 第一张图片
    ''' 第二张图片
    ''' 
    Private Function MM(PrevimgColo As Mat, NextimgColo As Mat) As Mat

        Dim previmg As Mat = New Mat()
        Dim nextimg As Mat = New Mat()
        Cv2.CvtColor(PrevimgColo, previmg, ColorConversionCodes.BGR2GRAY)
        Cv2.CvtColor(NextimgColo, nextimg, ColorConversionCodes.BGR2GRAY)
        '特征点检测(角、点)
        Const MAX_Count As Integer = 500
        Const Win_size As Integer = 10
        '像素级检测特征点
        Dim points1 As Point2f()
        points1 = Cv2.GoodFeaturesToTrack(previmg, MAX_Count, 0.01, 5, New Mat(), 3, False, 0.04)
        '亚像素级检测
        Dim points1Sub As Point2f()
        points1Sub = Cv2.CornerSubPix(previmg, points1, New Size(Win_size, Win_size), New Size(-1, -1), New TermCriteria())
        '迭代控制
        Dim criteria As TermCriteria = New TermCriteria(CriteriaTypes.Eps And CriteriaTypes.Count, 20, 0.03)
        '光流金字塔,输出图二的特征点
        Dim status As Byte()
        Dim err As Single()
        Dim points2 As Point2f() = New Point2f(points1Sub.Length - 1) {}
        Cv2.CalcOpticalFlowPyrLK(previmg, nextimg, points1Sub, points2, status, err)
#Region "输出偏移量,两图像拼接,可视化结果"
        Dim Coll As Mat() = New Mat(1) {}
        Coll(0) = PrevimgColo
        Coll(1) = NextimgColo
        Dim mergeImg As Mat = New Mat()
        Cv2.HConcat(Coll, mergeImg)
        Dim points_temp As Point2f() = points2
        Dim blue As Scalar = Scalar.Blue

        For num As Integer = 0 To points1Sub.Length - 1
            If status(num) = 1 Then
                points_temp(num).X  = PrevimgColo.Width
                Cv2.Line(mergeImg, CType(points1Sub(num), Point), CType(points_temp(num), Point), blue, 1, LineTypes.AntiAlias)
            End If
        Next
#End Region
        Return mergeImg
    End Function

    ''' 
    ''' 光流法,在一张图片上显示
    ''' 
    ''' 第一张图片
    ''' 第二张图片
    ''' 
    Private Function MM1(PrevimgColo As Mat, NextimgColo As Mat) As Mat

        Dim previmg As Mat = New Mat()
        Dim nextimg As Mat = New Mat()
        Cv2.CvtColor(PrevimgColo, previmg, ColorConversionCodes.BGR2GRAY)
        Cv2.CvtColor(NextimgColo, nextimg, ColorConversionCodes.BGR2GRAY)
        '特征点检测(角、点)
        Const MAX_Count As Integer = 500
        Const Win_size As Integer = 10
        '像素级检测特征点
        Dim points1 As Point2f()
        points1 = Cv2.GoodFeaturesToTrack(previmg, MAX_Count, 0.01, 5, New Mat(), 3, False, 0.04)
        '亚像素级检测
        Dim points1Sub As Point2f()
        points1Sub = Cv2.CornerSubPix(previmg, points1, New Size(Win_size, Win_size), New Size(-1, -1), New TermCriteria())
        '迭代控制
        Dim criteria As TermCriteria = New TermCriteria(CriteriaTypes.Eps And CriteriaTypes.Count, 20, 0.03)
        '光流金字塔,输出图二的特征点
        Dim status As Byte()
        Dim err As Single()
        Dim points2 As Point2f() = New Point2f(points1Sub.Length - 1) {}
        Cv2.CalcOpticalFlowPyrLK(previmg, nextimg, points1Sub, points2, status, err)
#Region "输出偏移量,可视化结果"
        Dim mergeImg As Mat = NextimgColo
        Dim blue As Scalar = Scalar.Blue
        Debug.Print("===========")
        For num As Integer = 0 To points1Sub.Length - 1
            If status(num) = 1 Then
                Cv2.Line(mergeImg, CType(points1Sub(num), Point), CType(points2(num), Point), blue, 1, LineTypes.AntiAlias)
                DistanceBetween(points1Sub(num).X, points1Sub(num).Y, points2(num).X, points2(num).Y)
            End If
        Next
#End Region
        Return mergeImg
    End Function
    Public Function DistanceBetween(ByVal X1 As Single, ByVal Y1 As Single, ByVal X2 As Single, ByVal Y2 As Single) As Single
        ' Calculate the distance between two points, given their X/Y coordinates. 
        ' The short version...
        DistanceBetween = Math.Sqrt((Math.Abs(X2 - X1) ^ 2)   (Math.Abs(Y2 - Y1) ^ 2))
        ' The longer version, to illustrate how it works...
        Dim Horizontal As Single, Vertical As Single
        Horizontal = Math.Abs(X2 - X1)
        Vertical = Math.Abs(Y2 - Y1)
        DistanceBetween = Math.Sqrt((Horizontal * Horizontal)   (Vertical * Vertical))
        If DistanceBetween > 2 Then
            Debug.Print(Format(DistanceBetween, "#00.00") & vbTab & Format(X1 - X2, "#00.00") & vbTab & Format(Y1 - Y2, "#00.00"))
        End If
    End Function

    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
        Dim video As FrameSource = Cv2.CreateFrameSource_Camera(0)
        Cv2.NamedWindow("video")

        While True
            Dim frame0 As Mat = New Mat()
            video.NextFrame(frame0)
            Dim flag As Integer = Cv2.WaitKey(1000)

            If flag >= 0 Then
                Exit While
            End If

            Dim frame1 As Mat = New Mat()
            video.NextFrame(frame1)

            Cv2.ImShow("video", MM1(frame0, frame1))
            Cv2.WaitKey(1)
        End While

    End Sub

MM:

MM1:

版权声明:本文内容来源于网络搜集无法获知原创作者,仅供个人学习用途,若侵犯到您的权益请联系我们及时删除。邮箱:1370723259@qq.com

发表评论

Slide to verify