Fredy finally Face detection can be done in VB here is the code, and it is quite fast as well. You need open Cv installed and a little libary called OpenCVLib.dll. If you are interested to run it please email me at idoumanis at yahoo.gr and I will send you all the files. My intention is to create a ActiveX component (a dll that can be regisred with Windows) that will allow everyone to use facwe detection in their applications. The problem however starts when I make the module a class, I get 'CommandLineArgs' is not a member of 'VB_Class.My.MyApplication'. Do you have any idea what is that? Also do you think that you can modify the code appropriately so I can expose the x, Y coordinates of the red circle that is drawn once a face is found, as properties inside my dll? Other interesting properties/methods would be a detect method with TRUE or FALSE values (if your character can not see you anymore you can display messages like "Hm, I wonder where you may be at the moment". Do you think you can modify the code to do that? I will continue my efforts and if I am succesful I will post the dll only for the users of this forum (as you were the only one that offered to help)
Option Explicit On
Option Strict On
Imports OpenCVLib
Imports System.Runtime.InteropServices
Module Module1
Private mStorage As IntPtr
Private mCascade As IntPtr
Sub Main()
Dim capture As IntPtr = IntPtr.Zero
Dim frame As IntPtr = IntPtr.Zero, frame_copy As IntPtr = IntPtr.Zero
Dim cascade_name As String
Dim input_name As String
Dim dllpath As String = CvUtility.GetDLLPath()
Dim argc As Integer = My.Application.CommandLineArgs.Count '�??G�?�?�?���?
If (argc > 0) AndAlso My.Application.CommandLineArgs(0).StartsWith("--cascade=") Then
cascade_name = My.Application.CommandLineArgs(0).Substring("--cascade=".Length)
If argc > 1 Then input_name = My.Application.CommandLineArgs(1) Else input_name = ""
Else
cascade_name = dllpath + "\data\haarcascades\haarcascade_frontalface_alt2.xml"
If argc > 0 Then input_name = My.Application.CommandLineArgs(0) Else input_name = ""
End If
mCascade = cvLoad(cascade_name, IntPtr.Zero, IntPtr.Zero, IntPtr.Zero)
If (mCascade = IntPtr.Zero) Then
Console.WriteLine("ERROR: Could not load classifier cascade")
Console.WriteLine("Usage: facedetect --cascade=""<cascade_path>"" [filename|camera_index]")
Exit Sub
End If
mStorage = cvCreateMemStorage(0)
Dim camidx As Integer = 0
If (input_name = "") OrElse Integer.TryParse(input_name, camidx) Then
capture = cvCaptureFromCAM(camidx)
Else
capture = cvCaptureFromAVI(input_name)
End If
cvNamedWindow("result", 1)
If capture <> IntPtr.Zero Then
Do
If cvGrabFrame(capture) = 0 Then Exit Do
frame = cvRetrieveFrame(capture)
If frame = IntPtr.Zero Then Exit Do
If frame_copy = IntPtr.Zero Then
frame_copy = cvCreateImage(CvUtility.GetIplImageSize(frame), IPL_DEPTH_8U, CvUtility.GetIplImagechannels(frame))
End If
If CvUtility.GetIplImageOrigin(frame) = IPL_ORIGIN_TL Then
cvCopy(frame, frame_copy, IntPtr.Zero)
Else
cvFlip(frame, frame_copy, 0)
End If
detect_and_draw(frame_copy)
If cvWaitKey(10) >= 0 Then Exit Do
Loop
cvReleaseImage(frame_copy)
cvReleaseCapture(capture)
Else
Dim filename As String = input_name
If filename = "" Then filename = dllpath + "\samples\c\lena.jpg"
Dim image As IntPtr = cvLoadImage(filename, 1)
If image <> IntPtr.Zero Then
detect_and_draw(image)
cvWaitKey(0)
cvReleaseImage(image)
Else
'assume it is a text file containing the
'list of the image filenames to be processed - one per line
Dim fs As New System.IO.FileStream(filename, IO.FileMode.Open)
Dim tr As New System.IO.StreamReader(fs)
Do While Not tr.EndOfStream
Dim buf As String = tr.ReadLine
buf = buf.Trim
image = cvLoadImage(buf, 1)
If image <> IntPtr.Zero Then
detect_and_draw(image)
cvWaitKey(0)
cvReleaseImage(image)
End If
Loop
tr.Close()
fs.Close()
End If
End If
cvDestroyWindow("result")
End Sub
Private Sub detect_and_draw(ByVal img As IntPtr)
Dim colors() As CvScalar = _
{ _
CV_RGB(255, 0, 0), _
CV_RGB(255, 128, 0), _
CV_RGB(255, 255, 0), _
CV_RGB(0, 255, 0), _
CV_RGB(0, 128, 255), _
CV_RGB(0, 255, 255), _
CV_RGB(0, 0, 255), _
CV_RGB(255, 0, 255) _
}
Dim scale As Double = 1.3
Dim sz As CvSize = CvUtility.GetIplImageSize(img)
Dim gray As IntPtr = cvCreateImage(sz, 8, 1)
Dim small_img As IntPtr = cvCreateImage(New CvSize(cvRound(sz.width / scale), cvRound(sz.height / scale)), 8, 1)
Dim i As Integer = 0
cvCvtColor(img, gray, CV_BGR2GRAY)
cvResize(gray, small_img, CV_INTER_LINEAR)
cvEqualizeHist(small_img, small_img)
cvClearMemStorage(mStorage)
If mCascade <> IntPtr.Zero Then
Dim t As Double = cvGetTickCount()
Dim faces As IntPtr = cvHaarDetectObjects(small_img, mCascade, mStorage, 1.1, 2, 0, New CvSize(30, 30))
t = cvGetTickCount() - t
Console.WriteLine("detection time = {0}", t / (cvGetTickFrequency() * 1000))
If faces <> IntPtr.Zero Then
Dim facesdata As CvSeq = CvSeq.CreateFrom(faces)
For i = 0 To facesdata.total - 1
Dim rptr As IntPtr = cvGetSeqElem(faces, i)
Dim r As CvRect = CvUtility.PtrToStructure(Of CvRect)(rptr)
Dim center As CvPoint
Dim radius As Integer
center.x = cvRound((r.x + r.width * 0.5) * scale)
center.y = cvRound((r.y + r.height * 0.5) * scale)
radius = cvRound((r.width + r.height) * 0.25 * scale)
cvCircle(img, center, radius, colors(i Mod 8), 3, 8, 0)
Next
End If
End If
cvShowImage("result", img)
cvReleaseImage(gray)
cvReleaseImage(small_img)
End Sub
End Module
