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.