基本信息

---

下载

   友情提示：（无需注册或充值，赞助后即可获取资源下载链接）

---

     嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：813200300

本次赞助数额为： 3 元　

支付宝支付

微信支付

   源码介绍

---

利用电脑摄像头快速实时扫描读取二维码，简单，速度快，效率高，准确率高。可以快速的用在自已的软件中。

Imports Emgu.CV
Imports Emgu.CV.CvEnum
Imports Emgu.CV.Util
Imports Emgu.CV.Structure
Imports ZXing

Public Class Form1
    Dim _capture As VideoCapture
    Dim _frame As Mat
    Dim _proc As Mat
    Dim _oproc As New Mat

    Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        RemoveHandler _capture.ImageGrabbed, AddressOf ProcessFrame
        End
    End Sub

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        _capture = New VideoCapture()
        _capture.Start()
        AddHandler _capture.ImageGrabbed, AddressOf ProcessFrame
    End Sub

    Private Sub ProcessFrame(ByVal sender As Object, ByVal e As System.EventArgs)
        _frame = New Mat
        _proc = New Mat
        _oproc = New Mat

        If _capture IsNot Nothing And _capture.Ptr <> IntPtr.Zero Then

            _capture.Retrieve(_frame, 0)

            REM 图形处理
            _proc = FilterGraphicsB(_frame)
            REM 发现二维码并截取
            _oproc = FindCodeMat(_frame, _proc)

            ImageBox1.Image = _frame

            If _oproc IsNot Nothing AndAlso IsDBNull(_oproc) = False Then
                REM 触发二维码识别程序
                Dim reader As IBarcodeReader = New BarcodeReader()
                Dim result = reader.Decode(_oproc.Bitmap)
                If result IsNot Nothing Then
                    If TextBox1.InvokeRequired Then
                        TextBox1.BeginInvoke(New MethodInvoker(Sub() ProcessFrame(sender, e)))
                    Else
                        TextBox1.Text = String.Format("{0} {1}", result.BarcodeFormat.ToString(), " " & result.Text)
                    End If
                End If
            End If
        End If

    End Sub

    Private Function FilterGraphicsB(ByVal um As Mat) As Mat
        Dim nm As New Mat
        CvInvoke.CvtColor(um, nm, ColorConversion.Bgr2Gray)
        CvInvoke.EqualizeHist(nm, nm)
        CvInvoke.GaussianBlur(nm, nm, New System.Drawing.Size(5, 5), 0, 0, BorderType.Default) '
        CvInvoke.Sobel(nm, nm, nm.Depth, 1, 0, 3, 1, 0, BorderType.Default) '
        CvInvoke.Threshold(nm, nm, 0, 255, ThresholdType.Binary   ThresholdType.Otsu)
        '膨胀          
        Dim StructingElement As Emgu.CV.Mat = CvInvoke.GetStructuringElement(Emgu.CV.CvEnum.ElementShape.Rectangle, New Size(12, 12), New Point(2, 2))
        CvInvoke.Dilate(nm, nm, StructingElement, New Point(2, 2), 1, Emgu.CV.CvEnum.BorderType.Default, New Emgu.CV.Structure.MCvScalar(0))
        Return nm
    End Function

    Private Function FindCodeMat(ByVal srcMat As Mat, ByVal grayMat As Mat) As Mat
        Dim tmp As Mat = grayMat.Clone
        Dim sMat As Mat = srcMat '.Clone
        Dim mrcMat As Mat
        mrcMat = srcMat.Clone

        Dim plate As New Mat
        Dim bkGrayWhite As New Gray(255)
        Dim contours As Emgu.CV.Util.VectorOfVectorOfPoint = New Emgu.CV.Util.VectorOfVectorOfPoint()
        Dim hierarchy As Emgu.CV.IOutputArray = New Image(Of Gray, Byte)(tmp.Width, tmp.Height, bkGrayWhite)
        CvInvoke.FindContours(tmp,
                                             contours,
                                             hierarchy,
                                             Emgu.CV.CvEnum.RetrType.External,
                                             Emgu.CV.CvEnum.ChainApproxMethod.ChainApproxSimple
                                              )

        For idx As Integer = 0 To contours.Size - 1
            Using contour As VectorOfPoint = contours(idx)
                Dim c As Double = CvInvoke.ContourArea(contour)
                If c < 18000 Or c > 25000 Then
                    Continue For
                End If

                Dim box As RotatedRect = CvInvoke.MinAreaRect(contour)
                If box.Angle < -45.0 Then
                    Dim ws As Single = box.Size.Width
                    box.Size.Width = box.Size.Height
                    box.Size.Height = ws
                    'box.Offset(-5, -5)
                    box.Angle  = 90.0F
                ElseIf box.Angle > 45.0 Then
                    Dim ws As Single = box.Size.Width
                    box.Size.Width = box.Size.Height
                    box.Size.Height = ws
                    'box.Offset(-5, -5)
                    box.Angle -= 90.0F
                End If

                Dim ratio As Single = box.Size.Width / box.Size.Height
                If ratio > 0.9 And ratio < 1.2 Then
                    Dim rect As Rectangle
                    rect = CvInvoke.BoundingRectangle(contour)
                    CvInvoke.Rectangle(sMat, rect, New Bgr(Color.Red).MCvScalar, 2)

                    Dim srcCorners As PointF() = box.GetVertices()
                    Dim destCorners As PointF() = New PointF() {New PointF(0, box.Size.Height - 1), New PointF(0, 0), New PointF(box.Size.Width - 1, 0), New PointF(box.Size.Width - 1, box.Size.Height - 1)}

                    Using tmp1 As New Mat()
                        Using rot As Mat = CvInvoke.GetAffineTransform(srcCorners, destCorners)
                            CvInvoke.WarpAffine(mrcMat, tmp1, rot, Size.Round(box.Size))
                            Return tmp1.Clone
                        End Using
                    End Using
                End If
            End Using
        Next
        'CvInvoke.Imshow(Now, sMat)
    End Function

    Private Sub Label1_Click(sender As System.Object, e As System.EventArgs) Handles Label1.Click
        System.Diagnostics.Process.Start("http://www.btw360.com:88")
    End Sub
End Class