Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS Main Plugin, MBS MacCI Plugin, MBS MacCG Plugin, MBS MacCF 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.xojo_binary_project"
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
The items on this page are in the following plugins: MBS MacCG Plugin.
