I am trying to use the OpenCV library for B4A for face tracking already under its last update and I have a problem when the video is displayed, the image is always in landscape mode.
B4X:
#Region Module Attributes
#FullScreen: False
#IncludeTitle: false
#ApplicationLabel: FaceDetector OCVforB4A
#VersionCode: 8
#VersionName:
#SupportedOrientations: portrait
#CanInstallToExternalStorage: False
#End Region
'
'Activity module
Sub Process_Globals
Dim cascadeFile As String = "lbpcascade_frontalface.xml"
End Sub
Sub Globals
Private Panel1 As Panel
'OCV
Dim ocl As OCVOpenCVLoader
Dim mOpenCvCameraView As OCVJavaCameraView
Dim mFaceDetector As OCVCascadeClassifier
Dim mCvt As OCVCvType
Dim mUtils As OCVUtils
Dim mImgProc As OCVImgproc
Dim mCore As OCVCore
'FACEDETECTOR
Private mRgba As OCVMat
Private mGray As OCVMat
Private mRelativeFacesize As Float = 0.2f
Private mAbsoluteFaceSize As Float
Dim drawRectangle As Boolean=True
Dim rp As RuntimePermissions
End Sub
Sub Activity_Create(FirstTime As Boolean)
'------------------------------------------------------------------
' Initialize Panel where cameraView surface will be placed
'------------------------------------------------------------------
Panel1.Initialize("")
Activity.AddView(Panel1,0,0,100%X,100%Y)
mOpenCvCameraView.Initialize("frameprocessor",Panel1,mOpenCvCameraView.CAMERA_ID_BACK)
'------------------------------------------------------------------
' Copy frontface classifier to DirInternal, since we can't access it from DirAssets
'------------------------------------------------------------------
If Not(File.Exists(File.DirInternal,cascadeFile)) Then
File.Copy(File.DirAssets,cascadeFile,File.DirInternal,cascadeFile)
End If
mAbsoluteFaceSize =640*mRelativeFacesize 'Minimum face size to detect
mFaceDetector.Initialize1
mFaceDetector.load(File.Combine(File.DirInternal,cascadeFile))
If mFaceDetector.empty Then
Msgbox("Failed to load cascade classifier file.","OpenCV for B4A")
Activity.Finish
End If
End Sub
Sub Activity_Resume
rp.CheckAndRequest(rp.PERMISSION_CAMERA)
Wait For Activity_PermissionResult (Permission As String, Result As Boolean)
If Result = False Then
MsgboxAsync("No Camera permission granted", "")
Else
mOpenCvCameraView.setMaxFrameSize(720,1080)
mOpenCvCameraView.connectCamera(720,1080)
End If
End Sub
Sub Activity_Pause (UserClosed As Boolean)
mOpenCvCameraView.disconnectCamera
End Sub
Public Sub frameprocessor_newFrame(myMat As OCVMat)
mImgProc.cvtColor(myMat,mGray,mImgProc.COLOR_RGBA2GRAY,1) 'Will use this one to procees
mRgba = myMat 'We are just getting the reference, so any changes made to mRgba will be made to Mat
Dim faces As OCVMatOfRect
faces.Initialize
Dim mSize As OCVSize
mSize.set(Array As Double(mAbsoluteFaceSize,mAbsoluteFaceSize)) 'Tell the detector minimum size to detect
Dim mSize2 As OCVSize
'mFaceDetector.detectMultiScale(mGray,faces,1.1,2,2,mSize,mSize2)
mFaceDetector.detectMultiScale(mGray,faces,1.1,10,2,mSize,mSize2)
' Check detected faces, if any.
Dim facesArray() As OCVRect = faces.toArray
If facesArray.Length>0 Then 'We are only interested in first detection
Dim myColorScalar As OCVScalar
myColorScalar.Initialize4(0,255,0,255) 'Order is R,G,B,A. In this case we are drawing a red rectangle
mImgProc.rectangle1(mRgba,facesArray(0).tl,facesArray(0).br,myColorScalar,4)
End If
End Sub
Sub Activity_Click
drawRectangle = Not(drawRectangle)
End Sub
