mainapp.vb

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

        Me.picCapture.SizeMode = System.Windows.Forms.PictureBoxSizeMode.StretchImage
        Me.picCapture.TabIndex = 7
        Me.picCapture.TabStop = False
        '
        'mnuMain
        '
        Me.mnuMain.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuMotionDetection, Me.MenuItem1, Me.MenuItem9})
        '
        'mnuMotionDetection
        '
        Me.mnuMotionDetection.Index = 0
        Me.mnuMotionDetection.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuExit})
        Me.mnuMotionDetection.Text = "File"
        '
        'mnuExit
        '
        Me.mnuExit.Index = 0
        Me.mnuExit.Text = "Exit"
        '
        'MenuItem1
        '
        Me.MenuItem1.Index = 1
        Me.MenuItem1.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.MenuItem2, Me.MenuItem3, Me.MenuItem4, Me.MenuItem5, Me.MenuItem6, Me.MenuItem7, Me.MenuItem8, Me.MenuItem11})
        Me.MenuItem1.Text = "Display"
        '
        'MenuItem2
        '
        Me.MenuItem2.Index = 0
        Me.MenuItem2.Text = "Whole body"
        '
        'MenuItem3
        '
        Me.MenuItem3.Index = 1
        Me.MenuItem3.Text = "Facial features only"
        '
        'MenuItem4
        '
        Me.MenuItem4.Index = 2
        Me.MenuItem4.Text = "Detected face"
        '
        'MenuItem5
        '
        Me.MenuItem5.Index = 3
        Me.MenuItem5.Text = "Input Image"
        '
        'MenuItem6
        '
        Me.MenuItem6.Index = 4
        Me.MenuItem6.Text = "Segmented Image"
        '
        'MenuItem7
        '
        Me.MenuItem7.Index = 5
        Me.MenuItem7.Text = "Body Segments"
        '
        'MenuItem8
        '
        Me.MenuItem8.Index = 6
        Me.MenuItem8.Text = "Skin colours"
        '
        'MenuItem11
        '
        Me.MenuItem11.Index = 7
        Me.MenuItem11.Text = "Portrait"
        '
        'MenuItem9
        '
        Me.MenuItem9.Index = 2
        Me.MenuItem9.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.MenuItem10, Me.MenuItem12})
        Me.MenuItem9.Text = "Tools"
        '
        'MenuItem10
        '
        Me.MenuItem10.Index = 0
        Me.MenuItem10.Text = "Create log"
        '
        'lblName
        '
        Me.lblName.Location = New System.Drawing.Point(12, 248)
        Me.lblName.Name = "lblName"
        Me.lblName.Size = New System.Drawing.Size(68, 12)
        Me.lblName.TabIndex = 8
        '
        'picAvatar
        '
        Me.picAvatar.Image = CType(resources.GetObject("picAvatar.Image"), System.Drawing.Image)
        Me.picAvatar.Location = New System.Drawing.Point(0, 0)
        Me.picAvatar.Name = "picAvatar"
        Me.picAvatar.Size = New System.Drawing.Size(204, 176)
        Me.picAvatar.SizeMode = System.Windows.Forms.PictureBoxSizeMode.StretchImage
        Me.picAvatar.TabIndex = 9
        Me.picAvatar.TabStop = False
        '
        'MenuItem12
        '
        Me.MenuItem12.Index = 1
        Me.MenuItem12.Text = "Speak names"
        '
        'MainApp
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(204, 177)
        Me.Controls.Add(Me.picAvatar)
        Me.Controls.Add(Me.lblName)
        Me.Controls.Add(Me.picCapture)
        Me.Controls.Add(Me.picEye)
        Me.Controls.Add(Me.picOutput)
        Me.MaximizeBox = False
        Me.Menu = Me.mnuMain
        Me.MinimizeBox = False
        Me.Name = "MainApp"
        Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
        Me.Text = "Human Body Project"
        Me.ResumeLayout(False)

    End Sub

#End Region


    ''' <summary>
    ''' Gets the name of the currently observed person
    ''' </summary>
    ''' <returns>the name of the person as a string up to 19 characters in length)</returns>
    Public Function getPersonName() As String
        'returns the name of the person
        Dim personNameStr As String
        Dim i As Integer
        Dim c As Byte
        Dim finished As Boolean

        personNameStr = ""
        finished = False
        i = 1
        While (i < 19) And (Not finished)
            c = RChbp_getPersonName(currentPersonID, i)
            If (c = 32) Or ((c > 64) And (c < 91)) Or ((c > 96) And (c < 123)) Then
                personNameStr = personNameStr & Chr(c)
            End If
            If ((c = 13) Or (c = 10)) Then
                finished = True
            End If
            i = i + 1
        End While
        getPersonName = personNameStr
    End Function
#End Region

#Region "Speech (SAPI) functions"

    ''' <summary>
    ''' Use SAPI to speak the name of the currently observed person
    ''' </summary>
    Public Sub speakName()
        Dim personNameStr As String

        personNameStr = getPersonName()
        If (personNameStr <> prev_personNameStr) Then
            'You might want to add your own salutation here
            Voice.Speak(personNameStr)
        End If
        prev_personNameStr = personNameStr
    End Sub

#End Region

#Region "Other stuff"
    ''' <summary>
    ''' Does absolutely nothing
    ''' </summary>
    Private Function ThumbNailAbort() As Boolean
        'Do Nothing Here
    End Function


    ''' <summary>
    ''' Grab an image from the camera periodically, using a timer control
    ''' </summary>
    Public Sub timGrab_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timGrab.Tick
        If (initialised) And (Not busy) Then
            busy = True

            Try

                'grab an image from the camera
                CaptureInformation.CaptureInfo.CaptureFrame()

                'occasionally save data
                autoSave()

            Catch ex As Exception

            End Try
            busy = False
        End If
    End Sub

    ''' <summary>
    ''' Exit the application
    ''' </summary>
    Private Sub mnuExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExit.Click
        End
    End Sub

    Private Sub picCapture_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles picCapture.Paint
        'If (DISPLAY_CAMERA_IMAGE) Then
        'Me.picCapture.Refresh()
        'End If
    End Sub



    ''' <summary>
    ''' Save anything which was learned during this session before closing
    ''' </summary>
    Public Sub MainApp_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
        'save the classifier data before closing
        RChbp_save(CPP_Path(classifier_filename))
    End Sub





    ''' <summary>
    ''' Load the face recognition classifier
    ''' </summary>
    Public Sub MainApp_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'load the classifier data
        If (classifier_filename = "") Then
            classifier_filename = System.AppDomain.CurrentDomain.BaseDirectory() & "\faces.net"
        Else
            RChbp_load(classifier_filename)
        End If
    End Sub




    Private Sub MenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem2.Click
        selectDisplaymode(0)
    End Sub

    Private Sub MenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem3.Click
        selectDisplaymode(1)
    End Sub

    Private Sub MenuItem4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem4.Click
        selectDisplaymode(2)
    End Sub


    Private Sub MenuItem5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem5.Click
        selectDisplaymode(3)
    End Sub

    Private Sub MenuItem6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem6.Click
        selectDisplaymode(4)
    End Sub


    Private Sub MenuItem7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem7.Click
        selectDisplaymode(5)
    End Sub


    Private Sub MenuItem8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem8.Click
        selectDisplaymode(6)
    End Sub


    Private Sub MenuItem11_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem11.Click
        selectDisplaymode(7)
    End Sub

    Private Sub MenuItem10_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem10.Click
        'switch logging on or off
        MenuItem10.Checked = Not MenuItem10.Checked
        If (MenuItem10.Checked) Then
            CamSettings.createLog = True
        Else
            CamSettings.createLog = False
        End If
        'save the new setting
        CamSettings.Save()
    End Sub


    ''' <summary>
    ''' Converts an ordinary path (eg C:\mypath\stuff) to a C++ style path (eg C:\\mypath\\stuff)
    ''' </summary>
    ''' <param name="filename">The path to be converted</param>
    ''' <returns>A C++ style path</returns>
    Public Function CPP_Path(ByVal filename As String) As String
        'convert to a c++ path using \\ instead of \
        Dim cpp_filename As String
        Dim i As Integer
        Dim c As String

        cpp_filename = ""
        For i = 1 To Len(filename)
            c = Mid$(filename, i, 1)
            cpp_filename = cpp_filename & c
            If (c = "\") Then
                cpp_filename = cpp_filename & c
            End If
        Next
        CPP_Path = cpp_filename
    End Function


    ''' <summary>
    ''' Occasionally save the face classifier data.  This ensures that any new faces learned are not forgotten.
    ''' </summary>
    Public Sub autoSave()
        'occasionally save the classifier data
        Static prev_hour As Integer
        Dim curr_hour As Integer

        curr_hour = Val(Format$(Now, "hh"))
        If (curr_hour <> prev_hour) Then
            busy = True
            RChbp_save(CPP_Path(classifier_filename))
            busy = False
            prev_hour = curr_hour
        End If
    End Sub

    Private Sub MenuItem12_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem12.Click
        CamSettings.speakNames = Not CamSettings.speakNames
        If (CamSettings.speakNames) Then
            MenuItem12.Checked = True
        Else
            MenuItem12.Checked = False
        End If
        CamSettings.Save()
    End Sub

#End Region

End Class