Platforms to show: All Mac Windows Linux Cross-Platform

/MacFrameworks/Vision Object Detection/Vision Object Detection


Required plugins for this example: MBS MacFrameworks Plugin, MBS MacCG Plugin, MBS MacCF Plugin, MBS Main Plugin, MBS MacBase Plugin

You find this example project in your Plugins Download as a Xojo project file within the examples folder: /MacFrameworks/Vision Object Detection/Vision Object Detection

This example is the version from Sat, 13th Jan 2023.

Project "Vision Object Detection.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
EventHandler Sub Open() If VisionModuleMBS.available Then // okay Else MsgBox "Please run as 64-bit MacOS app on MacOS 10.13 or newer." end If End EventHandler
EventHandler Function UnhandledException(error As RuntimeException) As Boolean MsgBox Join(error.Stack, EndOfLine) End EventHandler
End Class
Class MainWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
EventHandler Sub ExpandRow(row As Integer) Dim v As Variant = Me.RowTag(row) If v <> Nil Then If v IsA VNObservationMBS Then Dim o As VNObservationMBS = v List.AddRow "Confidence", Str(o.Confidence) End If If v IsA VNClassificationObservationMBS Then Dim o As VNClassificationObservationMBS = v List.AddRow "identifier", o.identifier end if If v IsA VNRecognizedObjectObservationMBS Then Dim o As VNRecognizedObjectObservationMBS = v Dim labels() As VNClassificationObservationMBS = o.labels List.AddRow "recognized objects", Str(labels.Ubound+1)+" classifications" For Each label As VNClassificationObservationMBS In o.labels If label.Confidence > 0.5 Then List.AddRow "identifier", label.identifier Else // skip all others End If Next End If If v IsA VNRectangleObservationMBS Then Dim r As VNRectangleObservationMBS = v List.AddRow "topLeft", Str(r.topLeft.X)+"/"+Str(r.topLeft.Y) List.AddRow "topRight", Str(r.topRight.X)+"/"+Str(r.topRight.Y) List.AddRow "bottomLeft", Str(r.bottomLeft.X)+"/"+Str(r.bottomLeft.Y) List.AddRow "bottomRight", Str(r.bottomRight.X)+"/"+Str(r.bottomRight.Y) End If If v IsA VNBarcodeObservationMBS Then Dim r As VNBarcodeObservationMBS = v List.AddRow "symbology", r.symbology List.AddRow "payloadStringValue", r.payloadStringValue End If If v IsA VNRecognizedTextObservationMBS Then Dim r As VNRecognizedTextObservationMBS = v List.AddRow "String", r.String 'Dim canditates() As VNRecognizedTextMBS = r.topCandidates(1) 'If canditates.Ubound >= 0 Then 'List.AddRow "String", canditates(0).String 'End If End If If v IsA VNFaceObservationMBS then Dim r As VNFaceObservationMBS = v Dim landmarks As Variant = r.landmarks If landmarks IsA VNFaceLandmarks2DMBS Then Dim landmarks2D As VNFaceLandmarks2DMBS = landmarks List.AddRow "allPoints", ListPoints(landmarks2D.allPoints) List.AddRow "faceContour", ListPoints(landmarks2D.faceContour) List.AddRow "innerLips", ListPoints(landmarks2D.innerLips) List.AddRow "leftEye", ListPoints(landmarks2D.leftEye) List.AddRow "leftEyebrow", ListPoints(landmarks2D.leftEyebrow) List.AddRow "leftPupil", ListPoints(landmarks2D.leftPupil) List.AddRow "medianLine", ListPoints(landmarks2D.medianLine) List.AddRow "nose", ListPoints(landmarks2D.nose) List.AddRow "noseCrest", ListPoints(landmarks2D.noseCrest) List.AddRow "outerLips", ListPoints(landmarks2D.outerLips) List.AddRow "rightEye", ListPoints(landmarks2D.rightEye) List.AddRow "rightEyebrow", ListPoints(landmarks2D.rightEyebrow) List.AddRow "rightPupil", ListPoints(landmarks2D.rightPupil) End If End If End If End EventHandler
End Control
Control Output Inherits Canvas
ControlInstance Output Inherits Canvas
End Control
EventHandler Sub DropObject(obj As DragItem, action As Integer) Do If obj.FolderItemAvailable Then Dim image As Picture = Picture.Open(obj.FolderItem) performVisionRequest image return End If If obj.PictureAvailable Then Dim image As Picture = obj.Picture performVisionRequest image Return End If Loop Until Not obj.NextItem End EventHandler
EventHandler Sub Open() Dim f As FolderItem = FindFile("card.jpg") If f.Exists Then Dim image As Picture = Picture.Open(f) performVisionRequest image End If Me.AcceptFileDrop "" // all me.AcceptPictureDrop End EventHandler
EventHandler Sub Resized() redraw End EventHandler
Sub AddObjectRow(title as string, info as string, v as Variant) List.AddFolder title List.cell(List.LastIndex,1) = info List.RowTag(List.LastIndex) = v End Sub
Function FindFile(name as string) As FolderItem // Look for file in parent folders from executable on dim parent as FolderItem = app.ExecutableFile.Parent while parent<>Nil dim file as FolderItem = parent.Child(name) if file<>Nil and file.Exists then Return file end if parent = parent.Parent wend End Function
Function ListPoints(n as VNFaceLandmarkRegion2DMBS) As string If n = Nil Then Return "n/a" End If Dim points() As CGPointMBS If pic <> Nil Then // coordinates in picture space points = n.pointsInImageOfSize(New CGSizeMBS(pic.Width, pic.Height)) Else // 0.0 to 1.0 normalized coordinates 'points = n.normalizedPoints end if Dim result() As String For Each point As CGPointMBS In points result.Append Str(point.x) + "/" + Str(point.y) Next Return Join(result, ", ") End Function
Sub Redraw() If pic <> Nil Then Dim OutputWidth As Integer = output.Width Dim OutputHeight As Integer = output.Height Dim p As New Picture(outputWidth, outputHeight) Dim faktor As Double = Min( OutputHeight / Pic.Height, OutputWidth / Pic.Width) // Calculate new size Dim w As Integer = Pic.Width * faktor Dim h As Integer = Pic.Height * faktor Dim g As Graphics = p.Graphics Dim x As Integer = (g.width - w)/2 Dim y As Integer = (g.height - h)/2 g.DrawPicture pic, x, y, w, h, 0, 0, pic.Width, pic.Height g.PenWidth = 3 g.PenHeight = 3 For Each Observation As Variant In Observations If Observation IsA VNRectangleObservationMBS Then // show rectangles Dim r As VNRectangleObservationMBS = Observation If Observation IsA VNBarcodeObservationMBS Then // draw in blue g.ForeColor = &c0000FF Elseif Observation IsA VNTextObservationMBS Then // draw in violett g.ForeColor = &cFF00FF Else // normal rectangle g.ForeColor = &cFF0000 End If Dim points(0) As Double points.Append x + (w * r.topLeft.X) points.Append y + h - (h * r.topLeft.Y) points.Append x + (w * r.topRight.X) points.Append y + h - (h * r.topRight.Y) points.Append x + (w * r.bottomRight.X) points.Append y + h - (h * r.bottomRight.Y) points.Append x + (w * r.bottomLeft.X) points.Append y + h - (h * r.bottomLeft.Y) g.DrawPolygon points End If If Observation IsA VNFaceObservationMBS Then Dim r As VNFaceObservationMBS = Observation // show eyes for a face Dim vf As Variant = r.landmarks If vf IsA VNFaceLandmarks2DMBS Then Dim size As New CGSizeMBS(w,h) g.PenWidth = 1 g.PenHeight = 1 Dim l As VNFaceLandmarks2DMBS = vf Dim LeftEye As VNFaceLandmarkRegion2DMBS = l.leftEye If leftEye <> Nil Then Dim LeftEyePoints() As CGPointMBS = leftEye.pointsInImageOfSize(size) For Each pp As CGPointMBS In LeftEyePoints g.ForeColor = &cFF0000 Dim px As Double = x + (pp.X) Dim py As Double = y + h - (pp.Y) g.DrawOval px-2, py-2, 5, 5 Next End If Dim rightEye As VNFaceLandmarkRegion2DMBS = l.rightEye If rightEye <> Nil Then Dim rightEyePoints() As CGPointMBS = rightEye.pointsInImageOfSize(size) For Each pp As CGPointMBS In rightEyePoints g.ForeColor = &c0000FF Dim px As Double = x + (pp.X) Dim py As Double = y + h - (pp.Y) g.DrawOval px-2, py-2, 5, 5 Next End If End If End If Next output.Backdrop = p Else output.Backdrop = Nil End If End Sub
Sub RequestCompleted(request as VNRequestMBS, error as NSErrorMBS, tag as Variant) If error <> Nil Then List.AddRow request.className+" failed" AddObjectRow "Error", error.LocalizedDescription, error Else List.AddRow request.className+" succeeded" End If if request <> nil then Dim results() As VNObservationMBS = request.results If results.Ubound >= 0 Then For Each result As VNObservationMBS In results If result.Confidence > 0.5 Then AddObjectRow result.classname, result.UUID, result Observations.Append result Else // ignore bad things like low level classifications End If Next Redraw End If end if End Sub
Function createVisionRequests() As VNRequestMBS() Dim requests() As VNRequestMBS requests.append New VNDetectFaceRectanglesRequestMBS(WeakAddressOf RequestCompleted) requests.append New VNDetectFaceLandmarksRequestMBS(WeakAddressOf RequestCompleted) Requests.Append New VNDetectHumanRectanglesRequestMBS(WeakAddressOf RequestCompleted) Dim barcodeDetectRequest As New VNDetectBarcodesRequestMBS(WeakAddressOf RequestCompleted) // Restrict detection to most common symbologies. Dim symbologies() As String symbologies.append VNBarcodeObservationMBS.VNBarcodeSymbologyQR symbologies.append VNBarcodeObservationMBS.VNBarcodeSymbologyAztec symbologies.append VNBarcodeObservationMBS.VNBarcodeSymbologyUPCE barcodeDetectRequest.setSymbologies symbologies requests.append barcodeDetectRequest Dim rectDetectRequest As New VNDetectRectanglesRequestMBS(WeakAddressOf RequestCompleted) // Customize & configure the request to detect only certain rectangles. rectDetectRequest.maximumObservations = 8 // Vision currently supports up to 16. rectDetectRequest.minimumConfidence = 0.6 // Be confident. rectDetectRequest.minimumAspectRatio = 0.3 // height / width requests.append rectDetectRequest // text If VNRecognizeTextRequestMBS.available Then // text for 10.15 Dim textDetectRequest As New VNRecognizeTextRequestMBS(WeakAddressOf RequestCompleted) requests.append textDetectRequest else // just text rectangles for 10.13/10.14 Dim textDetectRequest As New VNDetectTextRectanglesRequestMBS(WeakAddressOf RequestCompleted) requests.append textDetectRequest End If // classify If VNClassifyImageRequestMBS.available Then Requests.Append New VNClassifyImageRequestMBS(WeakAddressOf RequestCompleted) End If If VNRecognizeAnimalsRequestMBS.available Then Requests.Append New VNRecognizeAnimalsRequestMBS(WeakAddressOf RequestCompleted) End If Return requests End Function
Sub performRequestsCompleted(Requests() as VNRequestMBS, result as boolean, error as NSErrorMBS, tag as Variant) If result Then list.AddRow "performRequests succeeded." Else list.AddRow "performRequests failed." End If If error <> Nil Then List.AddRow "Error", error.LocalizedDescription End If End Sub
Sub performVisionRequest(pic as Picture) Self.pic = pic Dim requests() As VNRequestMBS = createVisionRequests Dim imageRequestHandler As VNImageRequestHandlerMBS = VNImageRequestHandlerMBS.RequestWithPicture(pic) list.DeleteAllRows Redim Observations(-1) Dim error As NSErrorMBS list.AddRow "performRequests..." // store in property to avoid too early release currentRequests = requests If False Then // run async on background thread imageRequestHandler.performRequestsAsync(requests, WeakAddressOf performRequestsCompleted) else // sync Dim result As Boolean = imageRequestHandler.performRequests(requests, error) If result Then list.AddRow "performRequests succeeded." Else list.AddRow "performRequests failed." End If If error <> Nil Then List.AddRow "Error", error.LocalizedDescription End If End If End Sub
Property Observations() As VNObservationMBS
Property Pic As Picture
Property currentRequests As Variant
End Class
MenuBar MainMenuBar
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem EditSeparator1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem EditSeparator2 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
End Project

See also:

The items on this page are in the following plugins: MBS MacFrameworks Plugin.


The biggest plugin in space...