Platforms to show: All Mac Windows Linux Cross-Platform
/MacFrameworks/Vision Object Detection/Text Recognition
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/Text Recognition
This example is the version from Sun, 17th Aug 2019.
Project "Text Recognition.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
End Class
Class MainWindow Inherits Window
Control PicCanvas Inherits Canvas
ControlInstance PicCanvas Inherits Canvas
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect)
If pic <> Nil Then
Dim faktor As Double = Min( g.height / Pic.Height, g.Width / Pic.Width)
// Calculate new size
Dim w As Integer = Pic.Width * faktor
Dim h As Integer = Pic.Height * faktor
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
End If
End EventHandler
End Control
Control Output Inherits TextArea
ControlInstance Output Inherits TextArea
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("phototest.tif")
If f.Exists Then
Dim image As Picture = Picture.Open(f)
performVisionRequest image
End If
Me.AcceptFileDrop "" // all
me.AcceptPictureDrop
End EventHandler
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
Sub performVisionRequest(pic as Picture)
If pic = Nil Then Return
Self.pic = pic
// lets check for text
Dim requests() As VNRequestMBS
// Tell Vision to report bounding box around each character.
If VNRecognizeTextRequestMBS.available Then
// on MacOS 10.15 we can get texts
Dim textDetectRequest As New VNRecognizeTextRequestMBS
'textDetectRequest.recognitionLevel = textDetectRequest.RecognitionLevelAccurate
requests.Append textDetectRequest
Else
// on MacOS 10.13 or 10.14 we can get text rectangles
Dim textDetectRequest As New VNDetectTextRectanglesRequestMBS
requests.Append textDetectRequest
End If
Dim imageRequestHandler As VNImageRequestHandlerMBS = VNImageRequestHandlerMBS.RequestWithPicture(pic)
Dim error As NSErrorMBS
If imageRequestHandler.performRequests(requests, error) Then
// okay
Dim w As Integer = pic.Width
Dim h As Integer = pic.Height
Dim p As New Picture(w, h)
Dim g As Graphics = p.Graphics
Dim x As Integer = 0
Dim y As Integer = 0
g.DrawPicture pic, x, y, w, h, 0, 0, w, h
Dim parts() As String
For Each request As VNRequestMBS In requests
Dim results() As VNObservationMBS = request.results
For Each result As Variant In results
If result IsA VNTextObservationMBS Then
Dim r As VNTextObservationMBS = result
g.ForeColor = &c0000FF
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
Elseif result IsA VNRecognizedTextObservationMBS Then
Dim r As VNRecognizedTextObservationMBS = result
g.ForeColor = &c0000FF
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
// try to guess a good text size
Dim th As Integer = Abs(r.topLeft.Y - r.bottomLeft.Y)*h
g.TextSize = th
Dim px As Integer = x + (w * (r.topLeft.X))
Dim py As Integer = y + h - (h * (r.topLeft.Y+r.bottomRight.Y)/2)
Dim s As String = r.String
g.DrawString s, px, py+th/2
parts.Append s
End If
Next
Next
self.pic = p
output.Text = Join(parts, EndOfLine)
Else
MsgBox error.LocalizedDescription
End If
End Sub
Property pic As Picture
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.