├── Blob.vb ├── CarsDrivingUnderBridge.mp4 ├── form_design.png ├── frmMain.vb └── readme.txt /Blob.vb: -------------------------------------------------------------------------------- 1 | 'MultipleObjectTrackingVB.sln 2 | 'Blob.vb 3 | 4 | 'Emgu CV 3.1.0 5 | 6 | Option Explicit On 'require explicit declaration of variables, this is NOT Python !! 7 | Option Strict On 'restrict implicit data type conversions to only widening conversions 8 | 9 | Imports System.Math 10 | 11 | Imports Emgu.CV ' 12 | Imports Emgu.CV.CvEnum 'Emgu Cv imports 13 | Imports Emgu.CV.Structure ' 14 | Imports Emgu.CV.UI ' 15 | Imports Emgu.CV.Util ' 16 | 17 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 18 | Public Class Blob 19 | 20 | Public currentContour As New VectorOfPoint() 21 | 22 | Public currentBoundingRect As Rectangle 23 | 24 | Public centerPositions As New List(Of Point) 25 | 26 | Public dblCurrentDiagonalSize As Double 27 | Public dblCurrentAspectRatio As Double 28 | 29 | Public intCurrentRectArea As Integer 30 | 31 | Public blnCurrentMatchFoundOrNewBlob As Boolean 32 | 33 | Public blnStillBeingTracked As Boolean 34 | 35 | Public intNumOfConsecutiveFramesWithoutAMatch As Integer 36 | 37 | Public predictedNextPosition As Point 38 | 39 | ' constructor ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 40 | Sub New(_contour As VectorOfPoint) 41 | 42 | currentContour = _contour 43 | 44 | currentBoundingRect = CvInvoke.BoundingRectangle(currentContour) 45 | 46 | Dim currentCenter As New Point() 47 | 48 | currentCenter.X = CInt(CDbl(currentBoundingRect.X + currentBoundingRect.X + currentBoundingRect.Width) / 2.0) 49 | currentCenter.Y = CInt(CDbl(currentBoundingRect.Y + currentBoundingRect.Y + currentBoundingRect.Height) / 2.0) 50 | 51 | centerPositions.Add(currentCenter) 52 | 53 | dblCurrentDiagonalSize = Math.Sqrt((currentBoundingRect.Width ^ 2) + (currentBoundingRect.Height ^ 2)) 54 | 55 | dblCurrentAspectRatio = CDbl(currentBoundingRect.Width) / CDbl(currentBoundingRect.Height) 56 | 57 | intCurrentRectArea = currentBoundingRect.Width * currentBoundingRect.Height 58 | 59 | blnStillBeingTracked = True 60 | blnCurrentMatchFoundOrNewBlob = True 61 | 62 | intNumOfConsecutiveFramesWithoutAMatch = 0 63 | 64 | End Sub 65 | 66 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 67 | Sub predictNextPosition() 68 | 69 | Dim numPositions As Integer = centerPositions.Count() 70 | 71 | If (numPositions = 1) Then 72 | 73 | predictedNextPosition.X = centerPositions.Last().X 74 | predictedNextPosition.Y = centerPositions.Last().Y 75 | 76 | ElseIf (numPositions = 2) Then 77 | 78 | Dim deltaX As Integer = centerPositions(1).X - centerPositions(0).X 79 | Dim deltaY As Integer = centerPositions(1).Y - centerPositions(0).Y 80 | 81 | predictedNextPosition.X = centerPositions.Last().X + deltaX 82 | predictedNextPosition.Y = centerPositions.Last().Y + deltaY 83 | 84 | ElseIf (numPositions = 3) Then 85 | 86 | Dim sumOfXChanges As Integer = ((centerPositions(2).X - centerPositions(1).X) * 2) + _ 87 | ((centerPositions(1).X - centerPositions(0).X) * 1) 88 | 89 | Dim deltaX As Integer = CInt(Math.Round(CDbl(sumOfXChanges / 3.0))) 90 | 91 | Dim sumOfYChanges As Integer = ((centerPositions(2).Y - centerPositions(1).Y) * 2) + _ 92 | ((centerPositions(1).Y - centerPositions(0).Y) * 1) 93 | 94 | Dim deltaY As Integer = CInt(Math.Round(CDbl(sumOfYChanges / 3.0))) 95 | 96 | predictedNextPosition.X = centerPositions.Last().X + deltaX 97 | predictedNextPosition.Y = centerPositions.Last().Y + deltaY 98 | 99 | ElseIf (numPositions = 4) Then 100 | 101 | Dim sumOfXChanges As Integer = ((centerPositions(3).X - centerPositions(2).X) * 3) + _ 102 | ((centerPositions(2).X - centerPositions(1).X) * 2) + _ 103 | ((centerPositions(1).X - centerPositions(0).X) * 1) 104 | 105 | Dim deltaX As Integer = CInt(Math.Round(CDbl(sumOfXChanges / 6.0))) 106 | 107 | Dim sumOfYChanges As Integer = ((centerPositions(3).Y - centerPositions(2).Y) * 3) + _ 108 | ((centerPositions(2).Y - centerPositions(1).Y) * 2) + _ 109 | ((centerPositions(1).Y - centerPositions(0).Y) * 1) 110 | 111 | Dim deltaY As Integer = CInt(Math.Round(CDbl(sumOfYChanges / 6.0))) 112 | 113 | predictedNextPosition.X = centerPositions.Last().X + deltaX 114 | predictedNextPosition.Y = centerPositions.Last().Y + deltaY 115 | 116 | ElseIf (numPositions >= 5) Then 117 | 118 | Dim sumOfXChanges As Integer = ((centerPositions(numPositions - 1).X - centerPositions(numPositions - 2).X) * 4) + _ 119 | ((centerPositions(numPositions - 2).X - centerPositions(numPositions - 3).X) * 3) + _ 120 | ((centerPositions(numPositions - 3).X - centerPositions(numPositions - 4).X) * 2) + _ 121 | ((centerPositions(numPositions - 4).X - centerPositions(numPositions - 5).X) * 1) 122 | 123 | Dim deltaX As Integer = CInt(Math.Round(CDbl(sumOfXChanges / 10.0))) 124 | 125 | Dim sumOfYChanges As Integer = ((centerPositions(numPositions - 1).Y - centerPositions(numPositions - 2).Y) * 4) + _ 126 | ((centerPositions(numPositions - 2).Y - centerPositions(numPositions - 3).Y) * 3) + _ 127 | ((centerPositions(numPositions - 3).Y - centerPositions(numPositions - 4).Y) * 2) + _ 128 | ((centerPositions(numPositions - 4).Y - centerPositions(numPositions - 5).Y) * 1) 129 | 130 | Dim deltaY As Integer = CInt(Math.Round(CDbl(sumOfYChanges / 10.0))) 131 | 132 | predictedNextPosition.X = centerPositions.Last().X + deltaX 133 | predictedNextPosition.Y = centerPositions.Last().Y + deltaY 134 | 135 | Else 136 | 'should never get here 137 | End If 138 | 139 | End Sub 140 | 141 | End Class 142 | 143 | 144 | 145 | -------------------------------------------------------------------------------- /CarsDrivingUnderBridge.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MicrocontrollersAndMore/OpenCV_3_Car_Counting_Visual_Basic/2df1e6ad18cff0eff9b9537451bdb9ce1156a5a0/CarsDrivingUnderBridge.mp4 -------------------------------------------------------------------------------- /form_design.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MicrocontrollersAndMore/OpenCV_3_Car_Counting_Visual_Basic/2df1e6ad18cff0eff9b9537451bdb9ce1156a5a0/form_design.png -------------------------------------------------------------------------------- /frmMain.vb: -------------------------------------------------------------------------------- 1 | 'MultipleObjectTrackingVB.sln 2 | 'frmMain.vb 3 | ' 4 | 'form components 5 | ' 6 | 'tableLayoutPanel 7 | 'btnOpenFile 8 | 'lblChosenFile 9 | 'imageBox 10 | 'txtInfo 11 | 'openFileDialog 12 | ' 13 | 'Emgu CV 3.1.0 14 | 15 | Option Explicit On 'require explicit declaration of variables, this is NOT Python !! 16 | Option Strict On 'restrict implicit data type conversions to only widening conversions 17 | 18 | Imports Emgu.CV ' 19 | Imports Emgu.CV.CvEnum 'usual Emgu Cv imports 20 | Imports Emgu.CV.Structure ' 21 | Imports Emgu.CV.UI ' 22 | Imports Emgu.CV.Util 23 | 24 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 25 | Public Class frmMain 26 | 27 | ' member variables '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 28 | Dim SCALAR_BLACK As New MCvScalar(0.0, 0.0, 0.0) 29 | Dim SCALAR_WHITE As New MCvScalar(255.0, 255.0, 255.0) 30 | Dim SCALAR_BLUE As New MCvScalar(255.0, 0.0, 0.0) 31 | Dim SCALAR_GREEN As New MCvScalar(0.0, 200.0, 0.0) 32 | Dim SCALAR_RED As New MCvScalar(0.0, 0.0, 255.0) 33 | 34 | Dim capVideo As Capture 35 | 36 | Dim blnFormClosing As Boolean = False 37 | 38 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 39 | Private Sub frmMain_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing 40 | blnFormClosing = True 41 | CvInvoke.DestroyAllWindows() 42 | End Sub 43 | 44 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 45 | Private Sub btnOpenFile_Click(sender As Object, e As EventArgs) Handles btnOpenFile.Click 46 | 47 | Dim drChosenFile As DialogResult 48 | 49 | drChosenFile = openFileDialog.ShowDialog() 'open file dialog 50 | 51 | If (drChosenFile <> DialogResult.OK Or openFileDialog.FileName = "") Then 'if user chose Cancel or filename is blank . . . 52 | lblChosenFile.Text = "file not chosen" 'show error message on label 53 | Return 'and exit function 54 | End If 55 | 56 | Try 57 | capVideo = New Capture(openFileDialog.FileName) 'attempt to open chosen video file 58 | Catch ex As Exception 'catch error if unsuccessful 59 | 'show error via message box 60 | MessageBox.Show("unable to read video file, error: " + ex.Message) 61 | Return 62 | End Try 63 | 64 | lblChosenFile.Text = openFileDialog.FileName 65 | 66 | If (capVideo Is Nothing) Then 67 | txtInfo.AppendText("unable to read video file") 68 | End If 69 | 70 | If (capVideo.GetCaptureProperty(CapProp.FrameCount) < 2) Then 'check and make sure the video has at least 2 frames 71 | txtInfo.AppendText("error: video file must have at least two frames") 72 | End If 73 | 74 | trackBlobsAndUpdateGUI() 75 | 76 | End Sub 77 | 78 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 79 | Sub trackBlobsAndUpdateGUI() 80 | 81 | Dim imgFrame1 As Mat 82 | Dim imgFrame2 As Mat 83 | 84 | Dim blobs As New List(Of Blob) 85 | 86 | Dim crossingLine(2) As Point 87 | 88 | Dim carCount As Integer = 0 89 | 90 | imgFrame1 = capVideo.QueryFrame() 91 | imgFrame2 = capVideo.QueryFrame() 92 | 93 | Dim horizontalLinePosition As Integer = CInt(Math.Round(CDbl(imgFrame1.Rows()) * 0.35)) 94 | 95 | crossingLine(0).X = 0 96 | crossingLine(0).Y = horizontalLinePosition 97 | 98 | crossingLine(1).X = imgFrame1.Cols() - 1 99 | crossingLine(1).Y = horizontalLinePosition 100 | 101 | Dim blnFirstFrame As Boolean = True 102 | 103 | While (blnFormClosing = False) 104 | 105 | Dim currentFrameBlobs As New List(Of Blob) 106 | 107 | Dim imgFrame1Copy As Mat = imgFrame1.Clone() 108 | Dim imgFrame2Copy As Mat = imgFrame2.Clone() 109 | 110 | Dim imgDifference As New Mat(imgFrame1.Size, DepthType.Cv8U, 1) 111 | Dim imgThresh As New Mat(imgFrame1.Size, DepthType.Cv8U, 1) 112 | 113 | CvInvoke.CvtColor(imgFrame1Copy, imgFrame1Copy, ColorConversion.Bgr2Gray) 114 | CvInvoke.CvtColor(imgFrame2Copy, imgFrame2Copy, ColorConversion.Bgr2Gray) 115 | 116 | CvInvoke.GaussianBlur(imgFrame1Copy, imgFrame1Copy, New Size(5, 5), 0) 117 | CvInvoke.GaussianBlur(imgFrame2Copy, imgFrame2Copy, New Size(5, 5), 0) 118 | 119 | CvInvoke.AbsDiff(imgFrame1Copy, imgFrame2Copy, imgDifference) 120 | 121 | CvInvoke.Threshold(imgDifference, imgThresh, 30, 255.0, ThresholdType.Binary) 122 | 123 | CvInvoke.Imshow("imgThresh", imgThresh) 124 | 125 | Dim structuringElement3x3 As Mat = CvInvoke.GetStructuringElement(ElementShape.Rectangle, New Size(3, 3), New Point(-1, -1)) 126 | Dim structuringElement5x5 As Mat = CvInvoke.GetStructuringElement(ElementShape.Rectangle, New Size(5, 5), New Point(-1, -1)) 127 | Dim structuringElement7x7 As Mat = CvInvoke.GetStructuringElement(ElementShape.Rectangle, New Size(7, 7), New Point(-1, -1)) 128 | Dim structuringElement9x9 As Mat = CvInvoke.GetStructuringElement(ElementShape.Rectangle, New Size(9, 9), New Point(-1, -1)) 129 | 130 | For i As Integer = 0 To 1 131 | CvInvoke.Dilate(imgThresh, imgThresh, structuringElement5x5, New Point(-1, -1), 1, BorderType.Default, New MCvScalar(0, 0, 0)) 132 | CvInvoke.Dilate(imgThresh, imgThresh, structuringElement5x5, New Point(-1, -1), 1, BorderType.Default, New MCvScalar(0, 0, 0)) 133 | CvInvoke.Erode(imgThresh, imgThresh, structuringElement5x5, New Point(-1, -1), 1, BorderType.Default, New MCvScalar(0, 0, 0)) 134 | Next 135 | 136 | Dim imgThreshCopy As Mat = imgThresh.Clone() 137 | 138 | Dim contours As New VectorOfVectorOfPoint() 139 | 140 | CvInvoke.FindContours(imgThreshCopy, contours, Nothing, RetrType.External, ChainApproxMethod.ChainApproxSimple) 141 | 142 | drawAndShowContours(imgThresh.Size(), contours, "imgContours") 143 | 144 | Dim convexHulls As New VectorOfVectorOfPoint(contours.Size()) 145 | 146 | For i As Integer = 0 To contours.Size() - 1 147 | CvInvoke.ConvexHull(contours(i), convexHulls(i)) 148 | Next 149 | 150 | drawAndShowContours(imgThresh.Size(), convexHulls, "imgConvexHulls") 151 | 152 | For i As Integer = 0 To contours.Size() - 1 153 | 154 | Dim possibleBlob As New Blob(convexHulls(i)) 155 | 156 | If (possibleBlob.intCurrentRectArea > 400 And _ 157 | possibleBlob.dblCurrentAspectRatio > 0.2 And _ 158 | possibleBlob.dblCurrentAspectRatio < 4.0 And _ 159 | possibleBlob.currentBoundingRect.Width > 30 And _ 160 | possibleBlob.currentBoundingRect.Height > 30 And _ 161 | possibleBlob.dblCurrentDiagonalSize > 60.0 And _ 162 | (CvInvoke.ContourArea(possibleBlob.currentContour) / possibleBlob.intCurrentRectArea) > 0.50) Then 163 | currentFrameBlobs.Add(possibleBlob) 164 | End If 165 | 166 | Next 167 | 168 | drawAndShowContours(imgThresh.Size(), currentFrameBlobs, "imgCurrentFrameBlobs") 169 | 170 | If (blnFirstFrame = True) Then 171 | For Each currentFrameBlob As Blob In currentFrameBlobs 172 | blobs.Add(currentFrameBlob) 173 | Next 174 | Else 175 | matchCurrentFrameBlobsToExistingBlobs(blobs, currentFrameBlobs) 176 | End If 177 | 178 | drawAndShowContours(imgThresh.Size(), blobs, "imgBlobs") 179 | 180 | imgFrame2Copy = imgFrame2.Clone() 181 | 182 | drawBlobInfoOnImage(blobs, imgFrame2Copy) 183 | 184 | Dim atLeastOneBlobCrossedTheLine = checkIfBlobsCrossedTheLine(blobs, horizontalLinePosition, carCount) 185 | 186 | If (atLeastOneBlobCrossedTheLine) Then 187 | CvInvoke.Line(imgFrame2Copy, crossingLine(0), crossingLine(1), SCALAR_GREEN, 2) 188 | Else 189 | CvInvoke.Line(imgFrame2Copy, crossingLine(0), crossingLine(1), SCALAR_RED, 2) 190 | End If 191 | 192 | drawCarCountOnImage(carCount, imgFrame2Copy) 193 | 194 | imageBox.Image = imgFrame2Copy 195 | 196 | 'now we prepare for the next iteration 197 | 198 | currentFrameBlobs.Clear() 199 | 200 | imgFrame1 = imgFrame2.Clone() 'move frame 1 up to where frame 2 is 201 | 202 | If (capVideo.GetCaptureProperty(CapProp.PosFrames) + 1 < capVideo.GetCaptureProperty(CapProp.FrameCount)) Then 'if there is at least one more frame 203 | imgFrame2 = capVideo.QueryFrame() 'get the next frame 204 | Else 'else if there is not at least one more frame 205 | txtInfo.AppendText("end of video") 'show end of video message 206 | Exit While 'and jump out of while loop 207 | End If 208 | 209 | blnFirstFrame = False 210 | 211 | Application.DoEvents() 212 | 213 | End While 214 | 215 | End Sub 216 | 217 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 218 | Sub matchCurrentFrameBlobsToExistingBlobs(ByRef existingBlobs As List(Of Blob), ByRef currentFrameBlobs As List(Of Blob)) 219 | 220 | For Each existingBlob As Blob In existingBlobs 221 | existingBlob.blnCurrentMatchFoundOrNewBlob = False 222 | existingBlob.predictNextPosition() 223 | Next 224 | 225 | For Each currentFrameBlob As Blob In currentFrameBlobs 226 | 227 | Dim intIndexOfLeastDistance As Integer = 0 228 | Dim dblLeastDistance As Double = 1000000.0 229 | 230 | For i As Integer = 0 To existingBlobs.Count() - 1 231 | 232 | If (existingBlobs(i).blnStillBeingTracked = True) Then 233 | 234 | Dim dblDistance As Double = distanceBetweenPoints(currentFrameBlob.centerPositions.Last(), existingBlobs(i).predictedNextPosition) 235 | 236 | If (dblDistance < dblLeastDistance) Then 237 | dblLeastDistance = dblDistance 238 | intIndexOfLeastDistance = i 239 | End If 240 | 241 | End If 242 | 243 | Next 244 | 245 | If (dblLeastDistance < currentFrameBlob.dblCurrentDiagonalSize * 0.5) Then 246 | addBlobToExistingBlobs(currentFrameBlob, existingBlobs, intIndexOfLeastDistance) 247 | Else 248 | addNewBlob(currentFrameBlob, existingBlobs) 249 | End If 250 | 251 | Next 252 | 253 | For Each existingBlob As Blob In existingBlobs 254 | 255 | If (existingBlob.blnCurrentMatchFoundOrNewBlob = False) Then 256 | existingBlob.intNumOfConsecutiveFramesWithoutAMatch = existingBlob.intNumOfConsecutiveFramesWithoutAMatch + 1 257 | End If 258 | 259 | If (existingBlob.intNumOfConsecutiveFramesWithoutAMatch >= 5) Then 260 | existingBlob.blnStillBeingTracked = False 261 | End If 262 | 263 | Next 264 | 265 | End Sub 266 | 267 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 268 | Sub addBlobToExistingBlobs(ByRef currentFrameBlob As Blob, ByRef existingBlobs As List(Of Blob), ByRef intIndex As Integer) 269 | 270 | existingBlobs(intIndex).currentContour = currentFrameBlob.currentContour 271 | existingBlobs(intIndex).currentBoundingRect = currentFrameBlob.currentBoundingRect 272 | 273 | existingBlobs(intIndex).centerPositions.Add(currentFrameBlob.centerPositions.Last()) 274 | 275 | existingBlobs(intIndex).dblCurrentDiagonalSize = currentFrameBlob.dblCurrentDiagonalSize 276 | existingBlobs(intIndex).dblCurrentAspectRatio = currentFrameBlob.dblCurrentAspectRatio 277 | 278 | existingBlobs(intIndex).blnStillBeingTracked = True 279 | existingBlobs(intIndex).blnCurrentMatchFoundOrNewBlob = True 280 | 281 | End Sub 282 | 283 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 284 | Sub addNewBlob(ByRef currentFrameBlob As Blob, ByRef existingBlobs As List(Of Blob)) 285 | 286 | currentFrameBlob.blnCurrentMatchFoundOrNewBlob = True 287 | 288 | existingBlobs.Add(currentFrameBlob) 289 | 290 | End Sub 291 | 292 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 293 | Function distanceBetweenPoints(point1 As Point, point2 As Point) As Double 294 | 295 | Dim intX As Integer = Math.Abs(point1.X - point2.X) 296 | Dim intY As Integer = Math.Abs(point1.Y - point2.Y) 297 | 298 | Return Math.Sqrt((intX ^ 2) + (intY ^ 2)) 299 | 300 | End Function 301 | 302 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 303 | Sub drawAndShowContours(imageSize As Size, contours As VectorOfVectorOfPoint, strImageName As String) 304 | 305 | Dim image As New Mat(imageSize, DepthType.Cv8U, 3) 306 | 307 | CvInvoke.DrawContours(image, contours, -1, SCALAR_WHITE, -1) 308 | 309 | CvInvoke.Imshow(strImageName, image) 310 | 311 | End Sub 312 | 313 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 314 | Sub drawAndShowContours(imageSize As Size, blobs As List(Of Blob), strImageName As String) 315 | 316 | Dim image As New Mat(imageSize, DepthType.Cv8U, 3) 317 | 318 | Dim contours As New VectorOfVectorOfPoint() 319 | 320 | For Each blob As Blob In blobs 321 | If (blob.blnStillBeingTracked = True) Then 322 | contours.Push(blob.currentContour) 323 | End If 324 | Next 325 | 326 | CvInvoke.DrawContours(image, contours, -1, SCALAR_WHITE, -1) 327 | 328 | CvInvoke.Imshow(strImageName, image) 329 | 330 | End Sub 331 | 332 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 333 | Function checkIfBlobsCrossedTheLine(ByRef blobs As List(Of Blob), ByRef horizontalLinePosition As Integer, ByRef carCount As Integer) As Boolean 334 | 335 | Dim atLeastOneBlobCrossedTheLine As Boolean = False 'this will be the return value 336 | 337 | For Each blob As Blob In blobs 338 | 339 | If (blob.blnStillBeingTracked = True And blob.centerPositions.Count() >= 2) Then 340 | 341 | Dim prevFrameIndex As Integer = blob.centerPositions.Count() - 2 342 | Dim currFrameIndex As Integer = blob.centerPositions.Count() - 1 343 | 344 | If (blob.centerPositions(prevFrameIndex).Y > horizontalLinePosition And blob.centerPositions(currFrameIndex).Y <= horizontalLinePosition) Then 345 | carCount = carCount + 1 346 | atLeastOneBlobCrossedTheLine = True 347 | End If 348 | 349 | End If 350 | 351 | Next 352 | 353 | Return(atLeastOneBlobCrossedTheLine) 354 | 355 | End Function 356 | 357 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 358 | Sub drawBlobInfoOnImage(ByRef blobs As List(Of Blob), ByRef imgFrame2Copy As Mat) 359 | 360 | For i As Integer = 0 To blobs.Count - 1 361 | 362 | If (blobs(i).blnStillBeingTracked = True) Then 363 | 364 | CvInvoke.Rectangle(imgFrame2Copy, blobs(i).currentBoundingRect, SCALAR_RED, 2) 365 | 366 | Dim fontFace As FontFace = FontFace.HersheySimplex 367 | Dim dblFontScale As Double = blobs(i).dblCurrentDiagonalSize / 60.0 368 | Dim intFontThickness As Integer = CInt(Math.Round(dblFontScale * 1.0)) 369 | 370 | CvInvoke.PutText(imgFrame2Copy, i.ToString(), blobs(i).centerPositions.Last(), fontFace, dblFontScale, SCALAR_GREEN, intFontThickness) 371 | 372 | End If 373 | 374 | Next 375 | 376 | End Sub 377 | 378 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 379 | Sub drawCarCountOnImage(ByRef carCount As Integer, ByRef imgFrame2Copy As Mat) 380 | 381 | Dim fontFace As FontFace = FontFace.HersheySimplex 382 | Dim dblFontScale As Double = CDbl(imgFrame2Copy.Rows() * imgFrame2Copy.Cols()) / 300000.0 383 | Dim intFontThickness As Integer = CInt(Math.Round(dblFontScale * 1.5)) 384 | 385 | Dim textSize As Size = getTextSize(carCount.ToString(), fontFace, dblFontScale, intFontThickness) 386 | 387 | Dim bottomLeftTextPosition As New Point() 388 | 389 | bottomLeftTextPosition.X = imgFrame2Copy.Cols - 1 - CInt(CDbl(textSize.Width) * 1.3) 390 | bottomLeftTextPosition.Y = CInt(CDbl(textSize.Height) * 1.3) 391 | 392 | CvInvoke.PutText(imgFrame2Copy, carCount.ToString(), bottomLeftTextPosition, fontFace, dblFontScale, SCALAR_GREEN, intFontThickness) 393 | End Sub 394 | 395 | ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 396 | Function getTextSize(strText As String, intFontFace As Integer, dblFontScale As Double, intFontThickness As Integer) As Size 397 | 398 | Dim textSize As New Size() 'this will be the return value 399 | 400 | Dim intNumChars As Integer = strText.Count() 401 | 402 | textSize.Width = 55 * intNumChars 403 | textSize.Height = 65 404 | 405 | Return(textSize) 406 | 407 | End Function 408 | 409 | End Class 410 | 411 | 412 | 413 | 414 | -------------------------------------------------------------------------------- /readme.txt: -------------------------------------------------------------------------------- 1 | The video pretty much explains it all: 2 | https://www.youtube.com/watch?v=PxTHbpxQ5hI --------------------------------------------------------------------------------