VB.NET的OpenCvSharp4简单应用

由纪小年 · 2023/01/31

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

准备工作

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

在Form中引用

Imports OpenCvSharp

1	Imports OpenCvSharp

轮廓

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

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

    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虚拟摄像头

    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:\桌面\Samples\EasyPR-master\opencv2\data\haarcascades\haarcascade_frontalface_default.xml")
            Dim eyeFinder As OpenCvSharp.CascadeClassifier = New CascadeClassifier("E:\桌面\Samples\EasyPR-master\opencv2\data\haarcascades\haarcascade_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:\桌面\Samples\EasyPR-master\opencv2\data\haarcascades\haarcascade_frontalface_default.xml")

Dim eyeFinder As OpenCvSharp.CascadeClassifier = New CascadeClassifier("E:\桌面\Samples\EasyPR-master\opencv2\data\haarcascades\haarcascade_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:\桌面\Samples\EasyPR-master\opencv2\data\haarcascades\haarcascade_frontalface_default.xml” 和

“E:\桌面\Samples\EasyPR-master\opencv2\data\haarcascades\haarcascade_eye_tree_eyeglasses.xml”

两个文件，这两个文件来自于Opencv(官方C++库),需要下载安装Opencv，在如上的的相应目录去找（我的安装在”E:\桌面\Samples\EasyPR-master\opencv2″目录）。

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

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

    ''' <summary>
    ''' 光流法，拼接两张图片
    ''' </summary>
    ''' <param name="PrevimgColo">第一张图片</param>
    ''' <param name="NextimgColo">第二张图片</param>
    ''' <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>
    ''' <param name="NextimgColo">第二张图片</param>
    ''' <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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

''' <summary>

''' 光流法，拼接两张图片

''' </summary>

''' <param name="PrevimgColo">第一张图片</param>

''' <param name="NextimgColo">第二张图片</param>

''' <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

#End Region

Return mergeImg

End Function

''' <summary>

''' 光流法，在一张图片上显示

''' </summary>

''' <param name="PrevimgColo">第一张图片</param>

''' <param name="NextimgColo">第二张图片</param>

''' <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

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

发表回复取消回复

此站点使用Akismet来减少垃圾评论。了解我们如何处理您的评论数据。

纪小年发表在在罗克韦尔AB官网免费下载软件(申请下载码)2024/04/24
谢谢提醒，已删 :)
jinlu zuo 发表在在罗克韦尔AB官网免费下载软件(申请下载码)2024/04/22
还有你上边文章的图片里有一个账户名没有打…
jinlu zuo 发表在在罗克韦尔AB官网免费下载软件(申请下载码)2024/04/22
这个可以的。
纪小年发表在在罗克韦尔AB官网免费下载软件(申请下载码)2024/04/17
https://commerce.roc…
jinluzuo 发表在在罗克韦尔AB官网免费下载软件(申请下载码)2024/04/15
请问是不是账号有区别我的登录进去以后没有…

VB.NET的OpenCvSharp4简单应用

准备工作

轮廓

调用本地摄像头

面部识别

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

您可能还喜欢...

发表回复取消回复

最新文章

最新评论

标签云

浏览次数

VB.NET的OpenCvSharp4简单应用

准备工作

轮廓

调用本地摄像头

面部识别

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

您可能还喜欢...

VB使用注册表方法,将程序在开机时自动运行

使用Visual Studio开发WINCC或FTView SE的.Net控件

VB6.0 通过WinSock控件实现TCP/IP通讯

发表回复 取消回复

最新文章

最新评论

标签云

浏览次数

发表回复取消回复