mainapp.vb

人体运动检测与运动跟踪的源代码

'Human Body Project
'Copyright (C) 2001-2004  Bob Mottram
'
'This program is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published by
'the Free Software Foundation; either version 2 of the License, or
'(at your option) any later version.
'
'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'GNU General Public License for more details.
'
'You should have received a copy of the GNU General Public License
'along with this program; if not, write to the Free Software
'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

'Use NDoc (http://ndoc.sourceforge.net) and VBCommenter to produce program documentation


Imports DirectX.Capture


''' <summary>
''' Tha main form
''' </summary>
Public Class MainApp
    Inherits System.Windows.Forms.Form

#Region "Local variables"
    'the location of the classifier data
    Dim classifier_filename As String = "c:\develop\hbp\faces.net"

    'SAPI speech, used for announcing names of people
    Dim Voice As New SpeechLib.SpVoice

    Dim busy As Boolean = False
    Dim initialised As Boolean = False
    Dim image_initialised As Boolean = False
    Dim bmp_small As Bitmap  'small bitmap
    Dim bmp As Bitmap        'full sized bitmap
    Dim bb_tx, bb_ty, bb_bx, bb_by As Integer  'top and bottom coords of the bounding box

    'show the camera image or not
    Const DISPLAY_CAMERA_IMAGE = False

    'define the dimensions of the bitmap
    Const IMAGE_WIDTH = 320
    Const IMAGE_HEIGHT = 320

    'size of the face image returned
    Const FACE_IMAGE_SIZE As Integer = 60

    Const SMALL_IMAGE_SIZE = 80
    Dim reductionFactor_x As Integer = IMAGE_WIDTH / SMALL_IMAGE_SIZE
    Dim reductionFactor_y As Integer = IMAGE_HEIGHT / SMALL_IMAGE_SIZE

    'presently unused
    Dim motionImage(IMAGE_WIDTH * IMAGE_HEIGHT * 3) As Byte

    'set to true if teh image is being updated
    Dim updating_image As Boolean = False

    'detection mode constants
    Const DETECTIONMODE_MOTION = 0
    Const DETECTIONMODE_FACES = 1
    Const DETECTIONMODE_BODY = 2
    Dim DETECTION_MODE As Integer = DETECTIONMODE_BODY

    'show the detected face image or not
    Dim showFaceImage As Boolean = False

    'show a jpg image of the recognised person
    Dim showPortrait As Boolean = False

    'show a processed image
    Dim showProcessedImage As Boolean = False
    Dim processedImageID As Integer = -1

    'current and previous person IDs
    Dim currentPersonID As Integer
    Dim prevPersonID As Integer = -1

    'graphics object used for drawing shapes
    Dim gr As Graphics

    'a blank canvas
    Dim blank_img As Image

    'previos person name
    Dim prev_personNameStr As String = ""

    'timeout period for clearing the portrait image
    Const PORTRAIT_TIMEOUT = 5

#End Region

#Region "drawing the Mr Plong avatar"

    ''' <summary>
    ''' Draw the mouth area of Mr Plong
    ''' </summary>
    ''' <param name="x">X coordinate of the centre of the mouth</param>
    ''' <param name="y">Y coordinate of the centre of the mouth</param>
    ''' <param name="mouth_width">a parameter indicating the width of the mouth in the range 0-100</param>
    ''' <param name="mouth_open">a parameter indicating how open the mouth is in the range 0-100 (0=closed, 100=wide open)</param>
    ''' <param name="smile">a parameter indicating smiling in the range 0-100 (0=neutral, 100=biggest smile)</param>
    Public Sub drawMouth(ByVal x As Integer, ByVal y As Integer, ByVal mouth_width As Integer, ByVal mouth_open As Integer, ByVal smile As Integer)
        Dim PenColour As System.Drawing.Color
        Dim PenWidth As Integer
        Dim x1, x2, x3, x4 As Integer
        Dim y1, y2, y3, y4 As Integer
        Dim w As Integer
        Dim h As Integer

        PenColour = Color.DarkRed
        w = mouth_width * (100 - mouth_open) / 100
        h = w / 4
        PenWidth = mouth_width * 0.1
        x1 = CInt(x - (w / 2))
        y1 = y - (smile * h / 100)

        x2 = CInt(x - (w / 3))
        y2 = y

        x3 = CInt(x + (w / 3))
        y3 = y

        x4 = CInt(x + (w / 2))
        y4 = y - (smile * h / 100)

        gr.DrawLine(New Pen(PenColour, PenWidth), x1, y1, x2, y2)
        gr.DrawLine(New Pen(PenColour, PenWidth), x2, y2, x3, y3)
        gr.DrawLine(New Pen(PenColour, PenWidth), x3, y3, x4, y4)

        w = mouth_width
        h = w * mouth_open / 200
        gr.FillEllipse(New SolidBrush(PenColour), CInt(x - (w / 2)), CInt(y - (h / 2)), w, h)

    End Sub


    ''' <summary>
    ''' Draws an eyebrow of Mr Plong
    ''' </summary>
    ''' <param name="x">X coordinate of the centre of the eyebrow</param>
    ''' <param name="y">Y coordinate of the centre of the eyebrow</param>
    ''' <param name="eyebrow_width">width of the eyebrow in pixels</param>
    ''' <param name="curvature_symetrical">curvature of the eyebrow in the range 0-100</param>
    ''' <param name="curvature_asymetrical"></param>
    ''' <param name="leftSide">true=left eyebrow, false=right eyebrow</param>
    Private Sub drawEyebrow(ByVal x As Integer, ByVal y As Integer, ByVal eyebrow_width As Integer, ByVal curvature_symetrical As Integer, ByVal curvature_asymetrical As Integer, ByVal leftSide As Boolean)
        Dim PenColour As System.Drawing.Color
        Dim PenWidth As Integer
        Dim y1, y2, y3, yy As Integer

        PenColour = Color.Black()
        PenWidth = eyebrow_width * 0.1
        y1 = y
        y2 = y - (eyebrow_width * curvature_symetrical / 100)
        y3 = y - (eyebrow_width * curvature_asymetrical / 100)
        If (leftSide) Then
            yy = y1
            y1 = y3
            y3 = yy
        End If
        If (y1 > y) Then y1 = y
        If (y2 > y) Then y2 = y
        If (y3 > y) Then y3 = y
        gr.DrawLine(New Pen(PenColour, PenWidth), CInt(x - (eyebrow_width / 2)), y1, x, y2)
        gr.DrawLine(New Pen(PenColour, PenWidth), x, y2, CInt(x + (eyebrow_width / 2)), y3)

    End Sub


    ''' <summary>
    ''' Draws an eye of Mr Plong
    ''' </summary>
    ''' <param name="x">X coordinate of the centre of the eye</param>
    ''' <param name="y">Y coordinate of the centre of the eye</param>
    ''' <param name="eye_width">width of the eye in pixels</param>
    ''' <param name="gazeLeft">how far is he looking to the left in the range -100 to 100</param>
    ''' <param name="gazeDown">how much is he looking down in the range 0-100</param>
    ''' <param name="eyelid">how far down is the eyelid in the range 0-100</param>
    Private Sub drawEye(ByVal x As Integer, ByVal y As Integer, ByVal eye_width As Integer, ByVal gazeLeft As Integer, ByVal gazeDown As Integer, ByVal eyelid As Integer)
        'draws an eye at the given coordinates
        Dim PenColour As System.Drawing.Color
        Dim tx As Integer
        Dim ty As Integer
        Dim w As Integer
        Dim h As Integer
        Dim iris_width As Integer
        Dim pupil_width As Integer
        Dim offset_x As Integer
        Dim offset_y As Integer
        Dim skin_colour As Integer = &HC0E0FF
        Dim rect As System.Drawing.Rectangle

        PenColour = Color.White
        w = eye_width
        h = w * 0.7
        tx = x
        ty = y
        gr.FillEllipse(New SolidBrush(PenColour), CInt(tx - (w / 2)), CInt(ty - (h / 2)), w, h)

        iris_width = eye_width * 0.47
        pupil_width = eye_width * 0.24
        offset_x = gazeLeft * eye_width / 100
        offset_y = gazeDown * h / 100
        PenColour = Color.LightBlue
        gr.FillEllipse(New SolidBrush(PenColour), CInt(tx - (iris_width / 2) + offset_x), CInt(ty - (iris_width / 2) + offset_y), iris_width, iris_width)
        PenColour = Color.Black
        gr.FillEllipse(New SolidBrush(PenColour), CInt(tx - (pupil_width / 2) + offset_x), CInt(ty - (pupil_width / 2) + offset_y), pupil_width, pupil_width)

        PenColour = ColorTranslator.FromWin32(skin_colour)
        rect.X = tx - (eye_width / 2)
        rect.Y = ty - (h / 2)
        rect.Width = eye_width
        rect.Height = h * eyelid / 100
        gr.FillRectangle(New SolidBrush(PenColour), rect)

    End Sub


    ''' <summary>
    ''' Draws the Mr Plong avatar
    ''' </summary>
    ''' <param name="pic">picture box control in which to draw the avatar</param>
    Private Sub showAvatar(ByVal pic As PictureBox)
        'shows a stick man avatar
        Dim leftShoulderElevation As Integer
        Dim rightShoulderElevation As Integer
        Dim centre_x As Integer
        Dim upperArmLength As Integer
        Static leftelbow_x As Integer
        Static leftelbow_y As Integer
        Static leftwrist_x As Integer
        Static leftwrist_y As Integer
        Static rightelbow_x As Integer
        Static rightelbow_y As Integer
        Static rightwrist_x As Integer
        Static rightwrist_y As Integer
        Dim neck_y As Integer
        Dim bodyHeight As Integer
        Dim leftElbowElevation As Integer
        Dim rightElbowElevation As Integer
        Static leftShoulderAngle As Single
        Static rightShoulderAngle As Single
        Static leftWristAngle As Single
        Static rightWristAngle As Single
        Dim lowerArmLength As Single
        Dim shoulderWidth As Single
        Static top_colour As Integer
        Static bottom_colour As Integer
        Dim skin_colour As Integer
        Dim face_tx As Integer
        Dim face_ty As Integer
        Dim face_bx As Integer
        Dim face_by As Integer
        Dim bodyWidth As Integer
        Dim scaleBody As Single
        Dim origin_x As Integer
        Dim origin_y As Integer
        Dim face_w As Integer
        Dim face_h As Integer
        Dim gazeDirection As Integer
        Static gazeShift As Integer
        Dim headTilt As Integer
        Static tiltshift As Integer
        Dim mouthWidth As Integer
        Dim MouthOpen As Integer
        Dim eyebrowsVertical As Integer
        Dim drawScale As Single
        Dim bodyColour_red As Integer
        Dim bodyColour_green As Integer
        Dim bodyColour_blue As Integer
        Dim backgroundColour_red As Integer
        Dim backgroundColour_green As Integer
        Dim backgroundColour_blue As Integer
        Dim personID As Integer
        Dim personName(20) As Byte
        Dim i As Integer
        Dim c As Integer
        Dim personNameStr As String
        Dim leftHandSize As Integer
        Dim rightHandSize As Integer
        Dim handMultiplier As Single
        Dim PenWidth As Integer
        Dim headPenWidth As Integer
        Dim PenColour As System.Drawing.Color
        Dim tx As Integer
        Dim bx As Integer
        Dim by As Integer
        Dim ty As Integer
        Dim cy As Integer
        Dim w As Integer
        Dim h As Integer
        Dim scale_x As Single = 0.3
        Dim scale_y As Single = 0.3
        Dim x As Integer
        Dim y As Integer
        Dim yy As Integer
        Dim eb1, eb2 As Integer
        Dim invalidFace As Boolean
        Static mouth_open As Integer
        Static gazeDir As Integer = 0
        Static eyebrow_vert As Integer = 30
        Static prev_gazeShift As Integer = 0
        Static prev_tiltShift As Integer = 0
        Static prev_centre_x As Integer = 50
        Static prev_neck_y As Integer = 50
        Static prev_scalebody As Single = 1

        Try
            Call RChbp_getBodyPosture(0, leftShoulderElevation, rightShoulderElevation, leftElbowElevation, rightElbowElevation, leftHandSize, rightHandSize, face_tx, face_ty, face_bx, face_by, bodyWidth, gazeDirection, headTilt, mouthWidth, MouthOpen, eyebrowsVertical, bodyColour_red, bodyColour_green, bodyColour_blue, backgroundColour_red, backgroundColour_green, backgroundColour_blue, personID, invalidFace)

            personID = RChbp_getPersonID()

            If (personID > 0) And (Not invalidFace) Then
                personNameStr = ""
                For i = 1 To 18
                    c = RChbp_getPersonName(personID, i)
                    If (c = 32) Or ((c > 64) And (c < 91)) Or ((c > 96) And (c < 123)) Then
                        personNameStr = personNameStr & Chr(c)
                    End If
                Next
                lblName.Text = personNameStr
            Else
                lblName.Text = ""
            End If


            gr = Graphics.FromImage(pic.Image)
            scale_x = pic.Width / 100 * 0.3
            scale_y = pic.Height / 100 * 0.3

            If (Not invalidFace) Then
                top_colour = RGB(bodyColour_red, bodyColour_green, bodyColour_blue) '&HC0&
            End If
            bottom_colour = &HC00000
            skin_colour = &HC0E0FF
            drawScale = 2

            mouthWidth = 20