Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/MacCG/FaceDetection
Function:
Required plugins for this example: MBS MacCG Plugin, MBS Main Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /MacCG/FaceDetection
This example is the version from Wed, 4th Sep 2012.
Project "FaceDetection.rbp"
Class App Inherits Application
Const kEditClear = "&Löschen"
Const kFileQuit = "Beenden"
Const kFileQuitShortcut = ""
EventHandler Sub Open() if not TargetMacOS then MsgBox "please run on Mac OS X 10.7 or newer." end if End EventHandler
End Class
Class Window1 Inherits Window
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
EventHandler Sub Paint(g As Graphics) 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 g.drawpicture Pic, 0, 0, w, h, 0, 0, Pic.Width, Pic.Height end if End EventHandler
End Control
Control BevelButton1 Inherits BevelButton
ControlInstance BevelButton1 Inherits BevelButton
EventHandler Sub Action() dim f as FolderItem = GetOpenFolderItem("") load f End EventHandler
End Control
Control info Inherits Label
ControlInstance info Inherits Label
End Control
EventHandler Sub Open() dim f as FolderItem = SpecialFolder.Desktop.Child("test.jpg") Load f End EventHandler
Sub load(f as FolderItem) if f = nil or f.Exists = false then Return dim p as Picture = Picture.Open(f) if p = nil then MsgBox "Can't load that picture." Return end if dim image as new CIImageMBS(f) dim dic as new Dictionary dic.Value(CIDetectorMBS.CIDetectorAccuracy) = CIDetectorMBS.CIDetectorAccuracyHigh pic = p dim detector as new CIDetectorMBS(CIDetectorMBS.CIDetectorTypeFace, nil, dic) dim features() as CIFeatureMBS = detector.featuresInImage(image) dim g as Graphics = p.Graphics g.PenWidth = 3 g.PenHeight = 3 dim pp as CGPointMBS for each fe as CIFeatureMBS in features dim r as CGRectMBS = fe.bounds swap r g.ForeColor = &c777777 g.DrawRect r.left, r.top, r.Width, r.Height dim facewidth as Double = r.Width if fe isa CIFaceFeatureMBS then dim fa as CIFaceFeatureMBS = CIFaceFeatureMBS(fe) dim w as Double = facewidth * 0.15 if fa.hasLeftEyePosition then g.ForeColor = &cFF7777 pp = fa.leftEyePosition Swap pp g.DrawOval pp.x-w/2, pp.y-w/2, w, w end if if fa.hasRightEyePosition then g.ForeColor = &cFF7777 pp = fa.rightEyePosition Swap pp g.DrawOval pp.x-w/2, pp.y-w/2, w, w end if w = facewidth * 0.2 if fa.hasMouthPosition then g.ForeColor = &c7777FF pp = fa.mouthPosition Swap pp g.DrawOval pp.x-w/2, pp.y-w/2, w, w end if else end if next // done canvas1.Refresh(false) info.Text = str(UBound(features)+1)+" faces detected." End Sub
Sub swap(p as CGPointMBS) p.y = pic.Height - p.y End Sub
Sub swap(r as CGRectMBS) r.top = pic.Height - r.Height - r.top End Sub
Property pic As Picture
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&Ablage"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Bearbeiten"
MenuItem EditUndo = "&Rückgängig"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "&Ausschneiden"
MenuItem EditCopy = "&Kopieren"
MenuItem EditPaste = "&Einfügen"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "&Alles auswählen"
End MenuBar
End Project

Feedback, Comments & Corrections

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




Links
MBS Xojo tutorial videos