Looking for someone with a strong VB background

  • 8 Replies
  • 6426 Views
*

wgb14

  • Trusty Member
  • ****
  • Electric Dreamer
  • *
  • 143
Looking for someone with a strong VB background
« on: July 28, 2008, 10:02:34 am »
Hi all,

I recently come across this video on youtube http://www.youtube.com/watch?v=wznrHpL8AJ8 and I start thinking that if we could implement something similar for our Haptek characters, the degree of realism and imersion would increase rapidly. The blog of the person that did this is: http://www.ar-lab.info/mt/weblog/archives/2008/02/face_tracking_ui_test.html. Please note that if the ocx control of the application will not register correctly on your machine use a tool called dependancy walker to look for any missing dll. Most of the dll are located in the opencv bin directory.

I tried to use the ocx that comes with the application inside Director 11, but for some reason it fails to load (despite that it has been perfectly regisred on my system). I tried to do something in VB6 but my background in Visual basic is really bad. If someone can check it, and somehow make it play with the Haptek player, then it will be a valuble addition for everyone.  

Is anyone up for the challenge?

Please let me know
« Last Edit: December 30, 2009, 03:21:02 pm by Freddy »

*

Freddy

  • Administrator
  • **********************
  • Colossus
  • *
  • 6855
  • Mostly Harmless
Re: Looking for someone with a strong VB background
« Reply #1 on: July 30, 2008, 01:52:29 pm »
Thanks for the invite and nice to see you return  :)

I know a bit of VB but I think this is a step too far for me at the moment.  I have another project I am working on and also I am now studying on a new computing course so my time is a bit tied up.

I like the video though, I can see it being useful, but at least for now I have to pass on this one.

*

wgb14

  • Trusty Member
  • ****
  • Electric Dreamer
  • *
  • 143
Re: Looking for someone with a strong VB background
« Reply #2 on: July 31, 2008, 05:14:34 pm »
Thanks Freddy,

From my brief investigation of the problem I realised the following things:

a) If it is going to be fast enough it has to be on VC++ or C# . It could be done in VB but I am unsure if it is going to be that fast
b) It has to be a COM component (ocx, dll) if its going to be usable Haptek-enabled applications
c) It is not that difficult as the OpenCV library provides all the functionality that is needed
d) There is similar project that provides all the core functionality see http://www.codeproject.com/KB/mcpp/iss.aspx. I tried to copy the code and create a com component but my C# knowledge is very very limtied.

I am trying to find someone to do it (if you have someone to suggest please let me know), If I can make it I will post the component on your forum

Wish my good luck

 

*

Freddy

  • Administrator
  • **********************
  • Colossus
  • *
  • 6855
  • Mostly Harmless
Re: Looking for someone with a strong VB background
« Reply #3 on: August 01, 2008, 12:39:01 pm »
Hmm well C++ is out of my scope anyway, I'm learning php at the moment as well so I wouldn't be able to help.  Can't think of anyone off the top of my head who could help, unless there's someone on the VHumans forum, but they seem all tied up on other projects.

I guess just wait and see if anyone comes along who's interested.  I'll sticky this topic for you.

*

wgb14

  • Trusty Member
  • ****
  • Electric Dreamer
  • *
  • 143
Re: Looking for someone with a strong VB background
« Reply #4 on: August 02, 2008, 06:31:53 pm »
Fredy a quick advice on VB

I have this lione of code which works fine when the application is WindowsForm Application works fine, but when a class returns an error. Any idea what can be wrong with it?


    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        CtlActiveFace1.TrainFace("Giannis", "d", 20)
    End Sub
End Class

*

Freddy

  • Administrator
  • **********************
  • Colossus
  • *
  • 6855
  • Mostly Harmless
Re: Looking for someone with a strong VB background
« Reply #5 on: August 03, 2008, 02:13:45 pm »
Sorry, no I don't see anything wrong with it.  ???

*

wgb14

  • Trusty Member
  • ****
  • Electric Dreamer
  • *
  • 143
Re: Looking for someone with a strong VB background
« Reply #6 on: August 03, 2008, 08:21:45 pm »
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)
 

Code
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
« Last Edit: February 25, 2013, 04:54:07 pm by Freddy »

*

wgb14

  • Trusty Member
  • ****
  • Electric Dreamer
  • *
  • 143
Re: Looking for someone with a strong VB background
« Reply #7 on: August 03, 2008, 08:24:22 pm »
The last part of the code should read like this (without the smily)

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)   ---- the smily is 8

                Next
            End If

        End If

        cvShowImage("result", img)
        cvReleaseImage(gray)
        cvReleaseImage(small_img)

    End Sub

End Module

*

Freddy

  • Administrator
  • **********************
  • Colossus
  • *
  • 6855
  • Mostly Harmless
Re: Looking for someone with a strong VB background
« Reply #8 on: August 05, 2008, 02:13:04 pm »
Well done for getting so far.  Like I said I am a bit too busy at the moment to work on this.  The project I am working on will probably take up the rest of this week and after then I may have some time to look at this properly.  So far I see a lot of code I can only partly understand, it would have been nice if he had commented on his code.

Quote
..when I make the module a class, I get I get 'CommandLineArgs' is not a member of 'VB_Class.My.MyApplication'. Do you have any idea what is that?

I don't know why that is.

Quote
...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?


I haven't gone as far as making dll's yet, so I can't comment on that.

Sorry I couldn't be much help, but I have a lot on my plate at the moment.  What we need is someone who has a lot of experience with VBasic and dll's.  Maybe someone on the VHUmans forum could help?

 


OpenAI Speech-to-Speech Reasoning Demo
by ivan.moony (AI News )
Today at 01:31:53 pm
Say good-bye to GPUs...
by MikeB (AI News )
March 23, 2024, 09:23:52 am
Google Bard report
by ivan.moony (AI News )
February 14, 2024, 04:42:23 pm
Elon Musk's xAI Grok Chatbot
by MikeB (AI News )
December 11, 2023, 06:26:33 am
Nvidia Hype
by 8pla.net (AI News )
December 06, 2023, 10:04:52 pm
How will the OpenAI CEO being Fired affect ChatGPT?
by 8pla.net (AI News )
December 06, 2023, 09:54:25 pm
Independent AI sovereignties
by WriterOfMinds (AI News )
November 08, 2023, 04:51:21 am
LLaMA2 Meta's chatbot released
by 8pla.net (AI News )
October 18, 2023, 11:41:21 pm

Users Online

300 Guests, 0 Users

Most Online Today: 346. Most Online Ever: 2369 (November 21, 2020, 04:08:13 pm)

Articles