利用电脑摄像头快速实时扫描读取二维码，简单，速度快，效率高，准确率高。可以快速的用在自已的软件中。
Imports Emgu.CVImports Emgu.CV.CvEnumImports Emgu.CV.UtilImports Emgu.CV.StructureImports ZXingPublic 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 SubEnd Class
评论