Option Strict Off
Option Explicit On

Imports OpenCVLib
'Imports DShowLib
Imports System.Runtime.InteropServices
Imports System.Threading


Friend Class Form1
    Inherits System.Windows.Forms.Form

    Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Integer, ByVal dwFlags As Integer) As Integer
    Private intPortNo As Integer = 5001
    Private objNetStream As System.Net.Sockets.NetworkStream
    Private objTcpClient As System.Net.Sockets.TcpClient
    Private Declare Ansi Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
    Private WithEvents Speech As MiraiSpeechLib.MiraiSpeech

    Private mCap As IntPtr                  'キャプチャ
    Private mStorage As IntPtr
    Private mCascade As IntPtr
    Private capture1 As IntPtr = IntPtr.Zero, frame_copy As IntPtr = IntPtr.Zero
    Private x As Integer
    Private fd As Boolean
    Private di As Integer
    Private dgs As String
    Private dgc As Integer
    Private dg As Integer = 0
    Private dg1 As String = "0"
    Private dg2 As String = "0"
    Private rf As Boolean = False
    Private mvf As Integer = 0
    Private radius As Integer
    Private nct As Integer = 0
    Private mtr As String                               'モーションID
    Private face_c As Integer = 0
    Private hit_c1 As Integer = 0
    Private hit_c2 As Integer = 0

    Private Const WINDOWNAME As String = "Video"
    Private Const FILENAME As String = "capture.avi"

    'various tracking parameters (in seconds)
    Private Const MHI_DURATION As Double = 10
    Private Const MAX_TIME_DELTA As Double = 0.5
    Private Const MIN_TIME_DELTA As Double = 0.05

    'number of cyclic frame buffer used for motion detection
    '(should, probably, depend on FPS)
    Private Const N As Integer = 6

    'ring image buffer
    Private buf As IntPtr()
    Private last As Integer = 0
    'temporary images
    Private mhi As IntPtr       'MHI(Motion History Image)
    Private orient As IntPtr    'orientation
    Private mask As IntPtr      'valid orientation mask
    Private segmask As IntPtr   'motion segmentation map
    Private storage As IntPtr   'temporary storage

    Protected Overrides Function ProcessDialogKey( _
            ByVal keyData As Keys) As Boolean
        If (keyData And Keys.KeyCode) = Keys.Left Then
            '左キーが押されているか調べる
            btnLeft.PerformClick()
            '左キーの本来の処理（左側のコントロールにフォーカスを移す）を
            'させたくないときは、trueを返す
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.Right Then
            btnRight.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.Up Then
            btnUp.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.Down Then
            btnDown.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.F1 Then
            'F1キーが押されているか調べる
            btnF01.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.F2 Then
            btnF02.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.F3 Then
            btnF03.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.F4 Then
            btnF04.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.F5 Then
            btnF05.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.F6 Then
            btnF06.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.F7 Then
            btnF07.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.F8 Then
            btnF08.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.F9 Then
            btnF09.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.F10 Then
            btnF10.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.F11 Then
            btnF11.PerformClick()
            Return True
        ElseIf (keyData And Keys.KeyCode) = Keys.F12 Then
            btnF12.PerformClick()
            Return True
        End If

        Return MyBase.ProcessDialogKey(keyData)

    End Function

    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        If chkTcp.Checked Then
            With objTcpClient
                Try
                    'リモートホストを切断します。
                    If objTcpClient.Connected Then
                        objTcpClient.Close()
                    End If
                    Speech.Enabled = False
                Catch Ex As Exception
                    'エラーメッセージの表示
                    'MsgBox(Ex.Message)
                    '有無を言わさず終了
                    Exit Sub
                End Try
            End With
        End If
        '取り込み終了
        CameraCaptureEnd()

        cvReleaseImage(frame_copy)
        cvReleaseCapture(capture1)
        cvDestroyWindow("result")
        '閉じる
        frmVideo.Close()
        Environment.Exit(0)
        Me.Close()
        
    End Sub

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        Me.Top = 10
        Me.Left = 10
        'Control.CheckForIllegalCrossThreadCalls = False

        If chkVideo.Checked Then
            cmbSetup.Items.Add("Set Up")
            cmbSetup.Items.Add("Format")
            cmbSetup.Items.Add("Source")
            cmbSetup.Items.Add("Compress")
            cmbSetup.Items.Add("Audio")
            cmbSetup.SelectedIndex = 0
            cmbSetup.Enabled = True
            txtCap.Enabled = True
            txtCap.Text = My.Settings.Cap
            Me.Width = 234
            Me.Height = 460
        Else
            cmbSetup.Enabled = False
            txtCap.Enabled = False
            Me.Width = 234
            Me.Height = 460
        End If
        frmVideo.ezVidCap1.Preview = True
        frmVideo.ezVidCap1.CaptureAudio = True
        frmVideo.ezVidCap1.AutoSize = True
        frmVideo.ezVidCap1.MakeUserConfirmCapture = False
        frmVideo.ezVidCap1.TimeLimit = 5
        frmVideo.ezVidCap1.CaptureRate = 30
        frmVideo.ezVidCap1.PreviewRate = 30
        cmbSetup.Items.Add("Set Up")
        cmbSetup.Items.Add("Format")
        cmbSetup.Items.Add("Source")
        cmbSetup.Items.Add("Compress")
        cmbSetup.Items.Add("Audio")
        cmbSetup.SelectedIndex = 0
        txtIp.Text = My.Settings.IP
        Speech = New MiraiSpeechLib.MiraiSpeech("SpeechGrammer.xml")
        Speech.Enabled = False
        CheckBox1.Checked = Speech.Enabled
        frmVideo.Close()
        chkVideo.Checked = My.Settings.Video

    End Sub

    Private Sub SKSpeechRecognitionEventHandler(ByVal sender As Object, ByVal e As MiraiSpeechLib.SKSpeechEventArgs) Handles Speech.Recognition
        Dim num As Integer = e.values(0).ToString
        mtr = num.ToString("X")
        If num <= 240 Then
            If chkTcp.Checked = False Then
                Exit Sub
            End If
            Try

                mkpac()

                If num = 11 Then
                    num = 0
                    btnF12.PerformClick()
                    'If chkFace.Checked = False Then
                    chkFace.Checked = True
                    'End If
                ElseIf num = 12 Then
                    num = 0
                    If chkDaruma.Checked = False Then
                        chkDaruma.Checked = True
                    End If
                End If
                Me.Refresh()
                My.Application.DoEvents()
            Catch Ex As Exception
                'エラーメッセージの表示
                MsgBox(Ex.Message)
            End Try
        ElseIf 240 < num <= 255 Then
            If num = 241 Then
                SendKeys.Send("{ENTER}")
            ElseIf num = 242 Then
                SendKeys.Send("{ESC}")
            ElseIf num = 243 Then
                SendKeys.Send("%Q")
            ElseIf num = 244 Then
                SendKeys.Send("%P")
            ElseIf num = 245 Then
                SendKeys.Send("%C")
            ElseIf num = 246 Then
                SendKeys.Send("%Z")
            ElseIf num = 247 Then
                SendKeys.Send("%Y")
            ElseIf num = 248 Then
                If chkVideo.Checked Then
                    Me.chkVideo.Checked = False
                Else
                    Me.chkVideo.Checked = True
                End If
            End If
        Else
            Exit Sub
        End If
        Label3.Text = num
        Label5.Text = e.Words(0)
    End Sub

    Private Sub Label3_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Label3.TextChanged

        Dim num As Integer = Label3.Text
        mtr = num.ToString("X")
        If num <= 240 Then
            If chkTcp.Checked = False Then
                Exit Sub
            End If
            Try

                mkpac()

            Catch Ex As Exception
                'エラーメッセージの表示
                MsgBox(Ex.Message)
            End Try
        Else
            Exit Sub
        End If
    End Sub


    Private Sub CheckBox1_CheckedChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles CheckBox1.CheckedChanged
        If chkTcp.Checked = False Then
            CheckBox1.Checked = False
            MsgBox("Not cnnected")
            Exit Sub
        End If
        Speech.Enabled = CheckBox1.Checked
    End Sub

    Private Sub cmbSetup_SelectedIndexChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs)
        Select Case cmbSetup.SelectedIndex
            Case 1
                frmVideo.ezVidCap1.ShowDlgVideoFormat()
            Case 2
                frmVideo.ezVidCap1.ShowDlgVideoSource()
            Case 3
                frmVideo.ezVidCap1.ShowDlgCompressionOptions()
            Case 4
                frmVideo.ezVidCap1.ShowDlgAudioFormat()
        End Select

        cmbSetup.SelectedIndex = 0

    End Sub

    Private Sub txtCap_TextChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles txtCap.TextChanged
        Dim cap As String

        If txtCap.Text = "" Then
            cap = "1"
        Else
            cap = txtCap.Text
        End If
        frmVideo.ezVidCap1.TimeLimit = cap
        My.Settings.Cap = txtCap.Text
    End Sub

    Private Sub txtCap_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles txtCap.Click
        txtCap.Text = "5"
    End Sub

    Private Sub btnUp_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnUp.Click
        Label3.Text = "0"
        Label3.Text = "1"
    End Sub

    Private Sub btnDown_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDown.Click
        Label3.Text = "0"
        Label3.Text = "2"
    End Sub

    Private Sub btnRight_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRight.Click
        Label3.Text = "0"
        Label3.Text = "3"
    End Sub

    Private Sub btnLeft_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnLeft.Click
        Label3.Text = "0"
        Label3.Text = "4"
    End Sub

    Private Sub btnF01_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnF01.Click
        Label3.Text = "0"
        Label3.Text = "5"
    End Sub

    Private Sub btnF02_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnF02.Click
        Label3.Text = "0"
        Label3.Text = "6"
    End Sub

    Private Sub btnF03_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnF03.Click
        Label3.Text = "0"
        Label3.Text = "7"
    End Sub

    Private Sub btnF04_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnF04.Click
        Label3.Text = "0"
        Label3.Text = "8"
    End Sub

    Private Sub btnF05_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnF05.Click
        Label3.Text = "0"
        Label3.Text = "9"
    End Sub

    Private Sub btnF06_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnF06.Click
        Label3.Text = "0"
        Label3.Text = "10"
    End Sub

    Private Sub btnF07_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnF07.Click
        Label3.Text = "0"
        Label3.Text = "11"
    End Sub

    Private Sub btnF08_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnF08.Click
        Label3.Text = "0"
        Label3.Text = "12"
    End Sub

    Private Sub btnF09_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnF09.Click
        Label3.Text = "0"
        'Label3.Text = "14"
    End Sub

    Private Sub btnF10_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnF10.Click
        Label3.Text = "0"
        'Label3.Text = "15"
    End Sub

    Private Sub btnF11_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnF11.Click
        Label3.Text = "0"
        Label3.Text = "201"
    End Sub

    Private Sub btnF12_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnF12.Click
        Label3.Text = "0"
        If CheckBox1.Checked = True Then
            CheckBox1.Checked = False
        Else
            CheckBox1.Checked = True
        End If
    End Sub

    Private Sub btnPlay_Click(ByVal eventSender As System.Object, ByVal e As System.EventArgs)
        Dim Fullpath As String
        Fullpath = Dir(My.Application.Info.DirectoryPath & "\" & FILENAME)

    End Sub

    Public Function SendString(ByVal cmdString As String) As Long

        SendString = mciSendString(cmdString, CStr(VariantType.Null), 0, 0)

    End Function

    Private Sub chkTcp_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkTcp.CheckedChanged
        Dim intIpAdd As String = txtIp.Text
        If chkTcp.Checked Then
            objTcpClient = New System.Net.Sockets.TcpClient
            With objTcpClient
                Try
                    'リモートホストと接続
                    objTcpClient.Connect(intIpAdd, intPortNo)
                    objNetStream = .GetStream
                Catch Ex As Exception
                    'エラーメッセージの表示
                    MsgBox(Ex.Message)
                    chkTcp.Checked = False
                End Try
            End With
            Speech.Enabled = True
            CheckBox1.Checked = Speech.Enabled
        Else
            Speech.Enabled = False
            CheckBox1.Checked = Speech.Enabled
            chkFace.Checked = False
            With objTcpClient
                'TCP接続を終了
                .Close()
                Exit Sub
            End With
        End If
    End Sub

    Private Sub txtIp_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtIp.Click
        txtIp.Text = "Set IP"
        System.Threading.Thread.Sleep(100)
        txtIp.Text = ""
    End Sub

    Private Sub txtIp_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtIp.TextChanged
        If txtIp.Text = "" Then
            Speech.Enabled = False
            chkTcp.Checked = False
            chkTcp.Enabled = False
            CheckBox1.Checked = Speech.Enabled
            CheckBox1.Enabled = False
            If chkTcp.Checked Then
                With objTcpClient
                    'TCP接続を終了
                    .Close()
                    Exit Sub
                End With
                Exit Sub
            End If
        Else
            If chkTcp.Checked Then
                chkTcp.Checked = False
            End If
            chkTcp.Enabled = True
            CheckBox1.Enabled = True
            My.Settings.IP = txtIp.Text
        End If
    End Sub

    Private Sub chkVideo_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkVideo.CheckedChanged
        If chkDaruma.Checked Or chkFace.Checked Then
            chkDaruma.Checked = False
            chkFace.Checked = False
        End If
        If chkVideo.Checked Then
            cmbSetup.Enabled = True
            txtCap.Enabled = True
            txtCap.Text = My.Settings.Cap
            Me.Width = 234
            Me.Height = 460
            frmVideo.Show()
            Me.Show() 'show form
            Me.Refresh()
        Else
            cmbSetup.Enabled = False
            txtCap.Enabled = False
            Me.Width = 234
            Me.Height = 460
            frmVideo.Close()
        End If
        My.Settings.Video = chkVideo.Checked
    End Sub

    Private Sub detect_and_draw(ByVal img As IntPtr)

        Me.BringToFront()

        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
            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
                    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)
                    x = CInt(Fix((center.x * 256 / sz.width) + 0.5 * System.Math.Sign(center.x * 256 / sz.width)))

                Next

                If facesdata.total <> 0 Then

                    If mvf = 0 Then
                        moove()
                    Else
                        Timer1.Start()
                    End If

                    If face_c = 0 Then              '初回認識時ハートマーク
                        face_c = face_c + 1
                        If face_c > 254 Then
                            face_c = 1
                        End If
                        mtr = "1C"
                        mkpac()
                    End If

                Else
                    If rf = False Then
                        dg = dg + 100       '10deg
                        My.Application.DoEvents()
                        If dg >= 600 Then
                            nct = nct + 1
                            dg = 65536
                            rf = True
                        End If
                    ElseIf rf = True Then
                        dg = dg - 100
                        My.Application.DoEvents()
                        If dg <= 64936 Then
                            nct = nct + 1
                            dg = 0
                            rf = False
                        End If
                    End If

                    neck()
                    face_c = 0

                End If

                If nct > 4 Then        '首を2往復以上したら技フラグをクリアして向き変えへ
                    nct = 0
                    mvf = 0
                End If
            End If

        End If


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

    End Sub

    Private Sub Detect()

        Dim frame As IntPtr = IntPtr.Zero ', frame_copy As IntPtr = IntPtr.Zero
        Dim cascade_name As String
        Dim input_name As String

        'OpenCVインストールパスの取得と、cv100.dllのロード
        '注意：OpenCV付属のパターンデータ(haarcascade_frontalface_alt2.xml)等を使用する場合、
        '　　　cvLoad(cxcore100.dll)を呼び出す前に、cv100.dllをロードしておく必要があります。
        '　　　GetDLLPath()は内部でLoadLibrary()APIを用いてcv100.dllをプロセス内にロードします。

        'リリース用！！！！！！！！！！！！！ 注意
        Dim dllpath As String = CvUtility.GetDLLPath() + "\MIRAI-VCE"
        'Dim dllpath As String = CvUtility.GetDLLPath()

        Dim argc As Integer = My.Application.CommandLineArgs.Count  '煩雑になるため
        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 = "haarcascade_frontalface_alt2.xml"
            cascade_name = dllpath + "\haarcascade_frontalface_alt2.xml"
            'cascade_name = dllpath + "\data\haarcascades\haarcascade_profileface.xml"
            If argc > 0 Then input_name = My.Application.CommandLineArgs(0) Else input_name = ""
        End If

        txtDb.Text = dllpath

        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
            capture1 = cvCaptureFromCAM(camidx)
        Else
            capture1 = cvCaptureFromAVI(input_name)
        End If

        cvNamedWindow("result", 1)

        If capture1 <> IntPtr.Zero Then

            Do
                If cvGrabFrame(capture1) = 0 Then Exit Do
                frame = cvRetrieveFrame(capture1)
                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(capture1)
        End If

    End Sub

    Private Sub neck()
        With objNetStream
            dgs = CStr(dg.ToString("X"))
            dgc = Len(dgs)
            Select Case dgc
                Case 1
                    dg1 = dgs.Substring(0, 1)
                    dg2 = "0"
                Case 2
                    dg1 = dgs.Substring(0, 2)
                    dg2 = "0"
                Case 3
                    dg1 = dgs.Substring(1, 2)
                    dg2 = dgs.Substring(0, 1)
                Case 4
                    dg1 = dgs.Substring(2, 2)
                    dg2 = dgs.Substring(0, 2)
                Case Is < 4
                    Exit Select
            End Select

            'データをリモートホストへ送信
            Dim pac As Byte() = New Byte(22) {}
            pac(0) = &HFA
            pac(1) = &HFA
            pac(2) = &H0
            pac(3) = &H20
            pac(4) = &H0
            pac(5) = &H0
            pac(6) = &H0
            pac(7) = &HC
            pac(8) = &H2        'Sarvo ID:02
            pac(9) = &H0
            pac(10) = &H0
            pac(11) = &H0
            pac(12) = &H0
            pac(13) = &H0
            pac(14) = &H14
            pac(15) = &H4
            pac(16) = "&H" & dg1      '+10deg.
            pac(17) = "&H" & dg2
            pac(18) = &H1E      '1sec.
            pac(19) = &H0
            pac(20) = &HFB
            pac(21) = &HFB
            .Write(pac, 0, 22)
            My.Application.DoEvents()
            System.Threading.Thread.Sleep(100)
        End With
    End Sub
    Private Sub moove()
        If dg > 64936 Then
            If dg <= 65036 Then
                With objNetStream
                    mtr = "1A"

                    mkpac()

                    dg = 0
                    My.Application.DoEvents()
                    mvf = 1
                End With
            End If

        ElseIf dg >= 500 Then
            If dg < 700 Then
                With objNetStream
                    mtr = "1B"

                    mkpac()

                    dg = 65536
                    My.Application.DoEvents()
                    mvf = 1
                    'Timer1.Start()
                End With
            End If
        Else
            hit()
        End If
    End Sub

    '取り込み終了
    Private Sub CameraCaptureEnd()

        'キャプチャの解放
        cvReleaseCapture(mCap)

    End Sub

    Private Sub hit()
        With objNetStream
            If 80 <= x And x < 176 Then
                If radius > 130 Then
                    If hit_c1 = 0 Then
                        hit_c1 = hit_c1 + 1
                        mtr = "12"
                    Else
                        hit_c1 = 0
                        mtr = "13"
                    End If

                    mkpac()

                    My.Application.DoEvents()
                    mvf = 0

                ElseIf radius < 80 Then
                    If radius > 50 Then
                        If hit_c2 = 0 Then
                            hit_c2 = hit_c2 + 1
                            mtr = "17"
                        Else
                            hit_c2 = 0
                            mtr = "16"
                        End If

                        mkpac()

                        My.Application.DoEvents()
                        mvf = 0
                    End If
                Else
                    Exit Sub
                End If
            End If
        End With
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Timer1.Stop()
        hit()
    End Sub

    Private Sub chkFace_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkFace.CheckedChanged
        If chkTcp.Checked Then
            If chkVideo.Checked Or chkDaruma.Checked Then
                chkVideo.Checked = False
                chkDaruma.Checked = False
            End If
            If chkFace.Checked = True Then
                MsgBox("動画画面では終了しないで下さいね！")
                Detect()
            Else
                Me.TopMost = False
                cvReleaseImage(frame_copy)
                cvReleaseCapture(capture1)
                cvDestroyWindow("result")
            End If
        Else
            chkFace.Checked = False
            MsgBox("まず接続を行ってください。")
            Exit Sub
        End If
    End Sub

    Private Sub Form1_Move(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Move
        frmVideo.Left = Me.Left + 235
        frmVideo.Top = Me.Top
    End Sub

    Private Sub chkDaruma_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkDaruma.CheckedChanged
        If chkTcp.Checked Then
            If chkVideo.Checked Or chkFace.Checked Then
                chkVideo.Checked = False
                chkFace.Checked = False
            End If
            If chkDaruma.Checked = True Then
                MsgBox("動画画面では終了しないで下さいね！")
                dg = "0"
                neck()
                Me.TopMost = True
                daruma()
            Else
                Me.TopMost = False
                cvReleaseImage(frame_copy)
                cvReleaseCapture(capture1)
                cvDestroyWindow("Motion")
            End If
        Else
            'chkFace.Checked = False
            chkDaruma.Checked = False
            MsgBox("まず接続を行ってください。")
            Exit Sub
        End If
    End Sub

    Private Sub daruma()

        Dim argc As Integer = My.Application.CommandLineArgs.Count
        Dim idx As Integer
        If (argc = 0) OrElse ((argc > 0) AndAlso (Integer.TryParse(My.Application.CommandLineArgs(0), idx))) Then
            capture1 = cvCaptureFromCAM(idx)
        Else
            capture1 = cvCaptureFromFile(My.Application.CommandLineArgs(0))
        End If

        If capture1 <> IntPtr.Zero Then
            cvNamedWindow("Motion", 1)

            Do
                Dim image As IntPtr
                If cvGrabFrame(capture1) = 0 Then Exit Do
                image = cvRetrieveFrame(capture1)

                If image <> IntPtr.Zero Then
                    If frame_copy = IntPtr.Zero Then
                        frame_copy = cvCreateImage(CvUtility.GetIplImageSize(image), 8, 3)
                        cvZero(frame_copy)
                        CvUtility.SetIplImageOrigin(frame_copy, CvUtility.GetIplImageOrigin(image))
                    End If
                End If

                update_mhi(image, frame_copy, 50)   'コントラスト？ デフォルト30
                cvShowImage("Motion", frame_copy)

                If cvWaitKey(10) >= 0 Then Exit Do
            Loop
            cvReleaseCapture(capture1)
            cvDestroyWindow("Motion")

        End If
    End Sub

    Private Sub update_mhi(ByVal img As IntPtr, ByVal dst As IntPtr, ByVal diff_threshold As Integer)

        Dim timestamp As Double = System.Environment.TickCount / 1000   'get current time in seconds
        Dim size As CvSize = CvUtility.GetIplImageSize(img)             'get current frame size
        Dim i As Integer, idx1 As Integer = last, idx2 As Integer
        Dim silh As IntPtr
        Dim seq As CvSeq
        Dim comp_rect As CvRect
        Dim count As Double
        Dim angle As Double
        Dim center As CvPoint
        Dim magnitude As Double
        Dim color As CvScalar

        Me.BringToFront()

        'allocate images at the beginning or
        'reallocate them if the frame size is changed
        Dim mhisize As CvSize = CvUtility.GetIplImageSize(mhi)
        If (mhi = IntPtr.Zero) Or (mhisize.width <> size.width) Or (mhisize.height <> size.height) Then
            If buf Is Nothing Then
                ReDim buf(N - 1)
            End If
            For i = 0 To N - 1
                cvReleaseImage(buf(i))
                buf(i) = cvCreateImage(size, IPL_DEPTH_8U, 1)
                cvZero(buf(i))
            Next
            cvReleaseImage(mhi)
            cvReleaseImage(orient)
            cvReleaseImage(segmask)
            cvReleaseImage(mask)

            mhi = cvCreateImage(size, IPL_DEPTH_32F, 1)
            cvZero(mhi)     'clear MHI at the beginning
            orient = cvCreateImage(size, IPL_DEPTH_32F, 1)
            segmask = cvCreateImage(size, IPL_DEPTH_32F, 1)
            mask = cvCreateImage(size, IPL_DEPTH_8U, 1)
        End If

        cvCvtColor(img, buf(last), CV_BGR2GRAY) 'convert frame to grayscale

        idx2 = (last + 1) Mod N     'index of (last - (N-1))th frame
        last = idx2

        silh = buf(idx2)
        cvAbsDiff(buf(idx1), buf(idx2), silh)   'get difference between frames

        cvThreshold(silh, silh, diff_threshold, 1, CV_THRESH_BINARY)    'and threshold it
        cvUpdateMotionHistory(silh, mhi, timestamp, MHI_DURATION)       'update MHI

        'convert MHI to blue 8u image
        cvCvtScale(mhi, mask, 255 / MHI_DURATION, _
                (MHI_DURATION - timestamp) * 255 / MHI_DURATION)
        cvZero(dst)
        cvCvtPlaneToPix(mask, IntPtr.Zero, IntPtr.Zero, IntPtr.Zero, dst)

        'calculate motion gradient orientation and valid orientation mask
        cvCalcMotionGradient(mhi, mask, orient, MAX_TIME_DELTA, MIN_TIME_DELTA, 3)

        If storage = IntPtr.Zero Then
            storage = cvCreateMemStorage(0)
        Else
            cvClearMemStorage(storage)
        End If

        'segment motion: get sequence of motion components
        'segmask is marked motion components map. It is not used further
        Dim seqptr As IntPtr = cvSegmentMotion(mhi, segmask, storage, timestamp, MAX_TIME_DELTA)
        seq = CvSeq.CreateFrom(seqptr)

        'iterate through the motion components,
        'One more iteration (i == -1) corresponds to the whole image (global motion)
        For i = -1 To seq.total - 1

            If i < 0 Then   'case of the whole image
                comp_rect = New CvRect(0, 0, size.width, size.height)
                color = CV_RGB(255, 255, 255)
                magnitude = 100                                       '大径円の半径 デフォルト100
                'Exit For
            Else    'i-th motion component
                Dim conn As CvConnectedComp = CvUtility.PtrToStructure(Of CvConnectedComp)(cvGetSeqElem(seqptr, i))
                comp_rect = conn.rect
                If comp_rect.width + comp_rect.height < 250 Then    '微小移動物の排除 デフォルト500
                    Continue For
                End If
                color = CV_RGB(255, 0, 0)
                magnitude = 30                                      '小径円の半径
            End If

            'select component ROI
            cvSetImageROI(silh, comp_rect)
            cvSetImageROI(mhi, comp_rect)
            cvSetImageROI(orient, comp_rect)
            cvSetImageROI(mask, comp_rect)

            'calculate orientation
            angle = cvCalcGlobalOrientation(orient, mask, mhi, timestamp, MHI_DURATION)
            angle = 360.0 - angle   'adjust for images with top-left origin

            count = cvNorm(silh, IntPtr.Zero, CV_L1, IntPtr.Zero)  'calculate number of points within silhouette ROI

            cvResetImageROI(mhi)
            cvResetImageROI(orient)
            cvResetImageROI(mask)
            cvResetImageROI(silh)

            'check for the case of little motion  微小動作のチェック デフォルト0.05
            If count < comp_rect.width * comp_rect.height * 0.185 Then
                Continue For
            End If

            'draw a clock with arrow indicating the direction
            center = New CvPoint((comp_rect.x + comp_rect.width \ 2), _
                              (comp_rect.y + comp_rect.height \ 2))

            'txtDb.Text = CStr(center.x)            '赤丸のx座標
            'txtDb.Text = CStr(i)                   '動き量 * 物体数？ 500上下でどうか？
            'txtDb.Text = CStr(count / 1000)         '動き量？ 50上下でどうか？
            'txtDb.Text = CStr(seq.total.ToString / 1000)
            'txtDb.Text = CStr(center.x)
            If CStr(i) > 500 Then
                mtr = "11"

                mkpac()

                txtDb.BackColor = Drawing.Color.Red
            Else
                If CStr(i) > 100 Then
                    If CStr(center.x) < 210 Then
                        mtr = "E"

                        mkpac()

                        txtDb.BackColor = Drawing.Color.Blue
                    ElseIf CStr(center.x) > 430 Then
                        mtr = "F"

                        mkpac()

                        txtDb.BackColor = Drawing.Color.Green
                    Else
                        mtr = "10"

                        mkpac()

                        txtDb.BackColor = Drawing.Color.Yellow
                    End If
                End If
            End If

            cvCircle(dst, center, cvRound(magnitude * 1.2), color, 3, CV_AA, 0)         '1.2:円と指針のサイズ比
            cvLine(dst, center, New CvPoint(cvRound(center.x + magnitude * Math.Cos(angle * CV_PI / 180)), _
                    cvRound(center.y - magnitude * Math.Sin(angle * CV_PI / 180))), color, 3, CV_AA, 0)
        Next

    End Sub

    Private Sub mkpac()
        Dim pac As Byte() = New Byte(18) {}
        With objNetStream
            'データをリモートホストへ送信
            pac(0) = &HFA
            pac(1) = &HFA
            pac(2) = &H0
            pac(3) = &H11
            pac(4) = &H1
            pac(5) = &H0
            pac(6) = &H0
            pac(7) = &H8
            pac(8) = &H1
            pac(9) = &H10
            pac(10) = &H0
            pac(11) = &H0
            pac(12) = &H0
            pac(13) = "&H" & mtr
            pac(14) = &H0
            pac(15) = &H0
            pac(16) = &HFB
            pac(17) = &HFB
            .Write(pac, 0, 18)
        End With
    End Sub

End Class
