Imports Luxand
Public Class MainForm
    Dim cameraName As String
    Dim cameraHandle As Integer
    Dim needClose As Boolean

    ' Store the current frame for drawing
    Private currentFrame As Image = Nothing

    Dim tracker As Luxand.Tracker = Nothing

    ' WinAPI procedure to release HBITMAP handles returned by FSDKCam.GrabFrame
    Declare Auto Function DeleteObject Lib "gdi32.dll" (ByVal hObject As IntPtr) As Boolean

    Public Sub New()
        InitializeComponent()
        ' Subscribe to Paint event
        AddHandler PictureBox1.Paint, AddressOf PictureBox1_Paint
        ' Stretch pictureBox1 to fill the entire window
        PictureBox1.Dock = DockStyle.Fill
        ' Allow the window to be freely resizable
        Me.MinimumSize = New Size(640, 480)
    End Sub

    Private Sub MainForm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        If FSDK.FSDKE_OK <> FSDK.ActivateLibrary("INSERT THE LICENSE KEY HERE") Then
            MessageBox.Show("Please insert the license key in the FSDK.ActivateLibrary()", "Error activating FaceSDK", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Application.Exit()
            Return
        End If

        FSDK.InitializeLibrary()
        Luxand.Camera.InitializeCapturing()

        Dim cameraList() As String = FSDK.GetCameraList()

        If cameraList.Length = 0 Then
            MessageBox.Show("Please attach a camera", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Application.Exit()
            Return
        End If
        cameraName = cameraList(0)

        Dim formatList() As FSDK.VideoFormatInfo = Luxand.Camera.GetVideoFormatList(cameraName)

        ' Choose the best camera from the list
        Dim index As Integer = 0
        Dim formatIndex As Integer = 0
        Dim max_height As Integer = 0
        Dim max_width As Integer = 0
        For Each f In formatList
            If f.Width > max_width AndAlso f.Height > max_height Then
                max_width = f.Width
                max_height = f.Height
                formatIndex = index
            End If
            index += 1
        Next

        Luxand.Camera.SetVideoFormat(cameraName, formatList(formatIndex))

        StartBtn.Enabled = True
    End Sub
    Private Sub MainForm_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
        needClose = True
    End Sub

    Private Sub StartBtn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles StartBtn.Click
        StartBtn.Hide()

        ' Initialize camera
        Dim camera As Luxand.Camera = Nothing
        Try
            camera = New Luxand.Camera(cameraName)
        Catch ex As Exception
            MessageBox.Show(ex.Message, "Error opening camera")
            Application.Exit()
        End Try

        ' Creating tracker
        tracker = New Luxand.Tracker()
        If tracker Is Nothing Then
            MessageBox.Show("Error creating tracker", "Error")
            Application.Exit()
        End If

        ' set realtime face detection parameters
        Dim errorPosition As Integer = 0
        tracker.SetMultipleParameters("RecognizeFaces=false; DetectFacialFeatures=true; HandleArbitraryRotations=false;DetermineFaceRotationAngle=false; InternalResizeWidth=100; FaceDetectionThreshold=5;", errorPosition)

        While Not needClose
            Dim frame As CImage = camera.GrabFrame()
            If frame Is Nothing Then
                Application.DoEvents()
                Continue While
            End If

            Dim frameImage As Image = frame.ToCLRImage()

            ' Process the frame with the tracker
            Dim faceIds() As Long = Nothing
            tracker.FeedFrame(frame, faceIds)

            ' Make UI controls accessible (to find if the user clicked on a face)
            Application.DoEvents()

            If faceIds IsNot Nothing Then
                Dim gr As Graphics = Graphics.FromImage(frameImage)

                For Each faceId In faceIds
                    ' Get the face position and create an ellipse for it
                    Dim facePos As FSDK.TFacePosition
                    Dim facialFeatures(FSDK.FSDK_FACIAL_FEATURE_COUNT) As FSDK.TPoint
                    Try
                        facePos = tracker.GetFacePosition(0, faceId)
                        facialFeatures = tracker.GetFacialFeatures(0, faceId)
                    Catch
                        Continue For
                    End Try

                    Dim w As Single = facePos.w
                    Dim h As Single = facePos.w * 1.4F

                    Dim left As Integer = CInt(facePos.xc - w * 0.5)
                    Dim top As Integer = CInt(facePos.yc - w * 0.7F)
                    Dim right As Integer = CInt(facePos.xc + w * 0.5)
                    Dim bottom As Integer = CInt(facePos.yc + w * 0.7F)

                    Dim pen As Pen = Pens.LightGreen

                    gr.DrawEllipse(pen, left, top, w, h)

                    Dim j As Integer
                    For j = 0 To FSDK.FSDK_FACIAL_FEATURE_COUNT - 1
                        gr.FillEllipse(Brushes.DarkBlue, facialFeatures(j).x, facialFeatures(j).y, 5, 5)
                    Next

                Next
            End If

            ' Save the current frame and redraw pictureBox1
            If currentFrame IsNot Nothing Then
                Dim old As Image = currentFrame
                currentFrame = Nothing
                old.Dispose()
            End If

            currentFrame = frameImage
            PictureBox1.Invalidate()
            frame.Dispose()
            GC.Collect()
        End While

        camera.Close()

        tracker.Dispose()
        tracker = Nothing

        FSDK.FinalizeCapturing()
        FSDK.FinalizeLibrary()
    End Sub

    ' Draw the frame with aspect ratio preserved
    Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs)
        If currentFrame Is Nothing Then
            Return
        End If

        Dim pb As PictureBox = PictureBox1
        Dim g As Graphics = e.Graphics
        g.Clear(pb.BackColor)

        Dim imgW As Integer = currentFrame.Width
        Dim imgH As Integer = currentFrame.Height
        Dim boxW As Integer = pb.Width
        Dim boxH As Integer = pb.Height

        Dim ratio As Single = Math.Min(CSng(boxW) / imgW, CSng(boxH) / imgH)
        Dim drawW As Integer = CInt(imgW * ratio)
        Dim drawH As Integer = CInt(imgH * ratio)
        Dim offsetX As Integer = (boxW - drawW) \ 2
        Dim offsetY As Integer = (boxH - drawH) \ 2

        g.DrawImage(currentFrame, New Rectangle(offsetX, offsetY, drawW, drawH))
    End Sub
End Class
