VB.NET :: Aplikasi Pendeteksi wajah dan gerakan berbasis sms gateway

ini project udah lama banget, udah sekitar 2 tahun yang lalu, yah sekedar share aja, ini tampilan aplikasinya :

dibawah ini saya sertakan code untuk deteksi wajah dan gerakan, untuk sms gatewaynya saya pakai gammu, silahkan cari sendiri ya om.. ini juga perlu diolah lagi bukan code mentah di copy gitu aja,

CODE MONTION DETECTION ::

' ** both PictureBoxes must be 319x239 !!!!!! **

Imports System.Runtime.InteropServices
Public Class Form1
‘ WebCam Defenitions
Const WM_CAP As Short = &H400S

Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30

Const WM_CAP_SET_PREVIEW As Integer = WM_CAP + 50
Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP + 52
Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53
Const WS_CHILD As Integer = &H40000000
Const WS_VISIBLE As Integer = &H10000000
Const SWP_NOMOVE As Short = &H2S
Const SWP_NOSIZE As Short = 1
Const SWP_NOZORDER As Short = &H4S
Const HWND_BOTTOM As Short = 1

Dim iDevice As Integer = 0 ‘ Current device ID
Dim hHwnd As Integer ‘ Handle to preview window

Dim MotionDet As Boolean

Dim RecTop, RecButtom, RecLeft, RecRight As Integer
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

‘iDevice = lstDevices.SelectedIndex
‘ displays a list of Devices
LoadDeviceList()

‘ make the first Device as the default selection
lstDevices.SelectedIndex = 0

‘OpenPreviewWindow()
PB1.Refresh()
End Sub

Private Sub OpenPreviewWindow()
Dim piccapture As PictureBox = PictureBox1
Dim iHeight As Integer = piccapture.Height
Dim iWidth As Integer = piccapture.Width
‘ Open Preview window in picturebox
hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, _
480, piccapture.Handle.ToInt32, 0)


‘ Connect to device

If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then

‘Set the preview scale

SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)


‘Set the preview rate in milliseconds

SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)


‘Start previewing the image from the camera

SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)


‘ Resize window to fit in picturebox

SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, piccapture.Width, piccapture.Height, _
SWP_NOMOVE Or SWP_NOZORDER)
End If

End Sub
Private Sub LoadDeviceList()
Dim strName As String = Space(100)
Dim strVer As String = Space(100)
Dim bReturn As Boolean
Dim x As Integer = 0


‘ Load name of all avialable devices into the lstDevices

Do

‘ Get Driver name and version

bReturn = capGetDriverDescriptionA(x, strName, 100, strVer, 100)


‘ If there was a device add device name to the list

If bReturn Then lstDevices.Items.Add(strName.Trim)
x += 1
Loop Until bReturn = False
End Sub

Private Sub SelCamDev_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SelCamDev.Click

OpenPreviewWindow()

PB1Timer.Enabled = True

GridYes.Enabled = True

End Sub

Private Sub ActMotDet_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ActMotDet.Click

Dim data As IDataObject
Dim bmap As Image

RecYes.Enabled = True

‘ Copy image to clipboard

SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)

‘ Get image from clipboard and convert it to a bitmap

data = Clipboard.GetDataObject()
If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)

PB1.Image = bmap
PB2.Image = PB1.Image

End If

DoTimer.Enabled = True

End Sub

Private Sub BP1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PB1Timer.Tick
Dim data As IDataObject
Dim bmap As Image

‘ this Sub : stream video to PB1 (PictureBox)
‘ Copy image to clipboard
SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)

‘ Get image from clipboard and convert it to a bitmap
data = Clipboard.GetDataObject()
If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)

PB1.Image = bmap

End If

End Sub
Private Sub DoTimer_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles DoTimer.Tick
Compare_Images()
End Sub
Private Sub MotionLabelTimer_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles MotionLabelTimer.Tick
Label1.Visible = False
MotionLabelTimer.Enabled = False

End Sub

Private Sub PB1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PB1.Paint

‘draw rectangle of Detected Motion area
If Label1.Visible = True And RecYes.CheckState = CheckState.Checked Then
e.Graphics.DrawRectangle(Pens.White, RecLeft, RecTop, RecRight – RecLeft, RecButtom – RecTop)
e.Graphics.DrawRectangle(Pens.White, RecLeft + 1, RecTop + 1, RecRight – RecLeft + 1, RecButtom – RecTop + 1)
e.Graphics.DrawRectangle(Pens.White, RecLeft – 1, RecTop – 1, RecRight – RecLeft – 1, RecButtom – RecTop – 1)
End If

If GridYes.CheckState = CheckState.Unchecked Then
Exit Sub
End If

‘ draw grid on PB1

Dim x, y As Integer
Dim stepX, stepY As Integer

‘calculate density (by %)
stepX = PB1.Width * (Density.Value / 100)
stepY = PB1.Height * (Density.Value / 100)

For x = stepX / 2 To PB1.Width – 1 Step stepX
For y = stepY / 2 To PB1.Height – 1 Step stepY

e.Graphics.DrawEllipse(Pens.Red, x, y, 1, 1)

Next y
Next x
End Sub

Private Sub Compare_Images()
Dim c1, c2 As System.Drawing.Color
Dim x, y As Integer
Dim dG, dB, dR, c1G, c1B, c1R, c2G, c2B, c2R As Integer
Dim stepX, stepY As Integer
MotionDet = False

RecButtom = 0
RecRight = 0
RecTop = PB1.Height
RecLeft = PB1.Width

stepX = PB1.Width * (Density.Value / 100)
stepY = PB1.Height * (Density.Value / 100)

For x = stepX / 2 To PB1.Width – 1 Step stepX
For y = stepY / 2 To PB1.Height – 1 Step stepY

‘ getting pixel color (R,G,B) from both PictureBoxes at the same X,Y
‘ ** both PictureBoxes must be 319×239 !!!!!! **
c1 = CType(PB1.Image, Bitmap).GetPixel(x, y)
c2 = CType(PB2.Image, Bitmap).GetPixel(x, y)
‘ seperating R B G colors into varibles inorder not to repeat using the functions
‘ such as c1.R to save time instead to reusing those functions in the following code
c1R = c1.R
c1G = c1.G
c1B = c1.B
c2R = c2.R
c2G = c2.G
c2B = c2.B

‘ calculating colors Delta between two PictureBoxes (at the same X,Y)
‘ immitating ABS function. for some odd reason using ABS causes overflow

‘Delta R
If c1.R >= c2.R Then
dR = c1.R – c2.R
Else
dR = c2.R – c1.R
End If
‘Delta G
If c1.G >= c2.G Then
dG = c1.G – c2.G
Else
dG = c2.G – c1.G
End If
‘ Delta B
If c1.B >= c2.B Then
dB = c1.B – c2.B
Else
dB = c2.B – c1.B
End If

‘check if color Delta between two PictureBoxes (at the same X,Y) crossed the “threshold”
If dR > SenDeltaR.Value Or dG > SenDeltaG.Value Or dB > SenDeltaB.Value Then

If x < RecLeft Then
RecLeft = x
End If

If x > RecRight Then
RecRight = x
End If

If y < RecTop Then
RecTop = y
End If

If y > RecButtom Then
RecButtom = y
End If

‘ MOTION DETECTED

Label1.Visible = True

‘ this timer is only to show the Label “Motion” for few milliseconds otherwise it will not show
MotionLabelTimer.Enabled = True

MotionDet = True
Else
‘ MOTION NOT DETECTED
End If

Next y
Next x

If MotionDet = True Then
‘if MOTION DETECTED then match PB2 to PB1
PB2.Image = PB1.Image
‘MsgBox(RecLeft & “x ” & RecTop & ” ” & RecRight & ” ” & RecButtom)
End If
End Sub
Private Sub SenDellAll_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SenDellAll.Scroll
SenDeltaR.Value = SenDellAll.Value
SenDeltaG.Value = SenDellAll.Value
SenDeltaB.Value = SenDellAll.Value
End Sub
End Class

CODE FACE DETECTION ::

Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging
Imports HaarCascadeClassifer
Imports HaarCascadeClassifer.HaarDetector
Public Class Form1

Const WM_CAP_START = &H400S
Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000

Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
Const WM_CAP_EDIT_COPY = WM_CAP_START + 30
Const WM_CAP_SEQUENCE = WM_CAP_START + 62
Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23

Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50

Const SWP_NOMOVE = &H2S
Const SWP_NOSIZE = 1
Const SWP_NOZORDER = &H4S
Const HWND_BOTTOM = 1

Declare Function capGetDriverDescriptionA Lib “avicap32.dll” _
(ByVal wDriverIndex As Short, _
ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, _
ByVal cbVer As Integer) As Boolean

Declare Function capCreateCaptureWindowA Lib “avicap32.dll” _
(ByVal lpszWindowName As String, ByVal dwStyle As Integer, _
ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, _
ByVal nHeight As Short, ByVal hWnd As Integer, _
ByVal nID As Integer) As Integer

Declare Function SendMessage Lib “user32” Alias “SendMessageA” _
(ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, _
<MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer

Declare Function SetWindowPos Lib “user32” Alias “SetWindowPos” _
(ByVal hwnd As Integer, _
ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, _
ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer

Declare Function DestroyWindow Lib “user32” (ByVal hndw As Integer) As Boolean

Dim VideoSource As Integer
Dim hWnd As Integer
‘========================================================================

Private SelectedBitmap As Bitmap
Private Detector As HaarDetector

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim DriverName As String = Space(80)
Dim DriverVersion As String = Space(80)
For i As Integer = 0 To 9
If capGetDriverDescriptionA(i, DriverName, 80, DriverVersion, 80) Then
ListBox1.Items.Add(DriverName.Trim)
End If
Next

‘=======================================================================
Dim Start As DateTime = Now
Dim XMLDoc As New Xml.XmlDocument
XMLDoc.LoadXml(HaarCascadeClassifer.My.Resources.haarcascade_frontalface_alt)
Detector = New HaarDetector(XMLDoc)
lblInfo.Text = “XML cascade parsed in ” & Math.Round((Now – Start).TotalMilliseconds, 3).ToString & ” milliseconds.”
End Sub

Private Sub btnDetect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDetect.Click
Dim MaxDetCount As Integer = Integer.MaxValue
Dim MinNRectCount As Integer = nudMinNRectCount.Value
Dim FirstScale As Single = Detector.Size2Scale(nudMinSize.Value)
Dim MaxScale As Single = Detector.Size2Scale(nudMaxSize.Value)
Dim ScaleMult As Single = nudScaleMult.Value
Dim SizeMultForNesRectCon As Single = nudSizeMultForNesRectCon.Value
Dim SlidingRatio As Single = nudSlidingRatio.Value
Dim Pen As New Pen(Brushes.Red, nudLineWidth.Value)
Dim DetectorParameters As New DetectionParams(MaxDetCount, MinNRectCount, FirstScale, MaxScale, ScaleMult, SizeMultForNesRectCon, SlidingRatio, Pen)

Dim Bmp As Bitmap = SelectedBitmap.Clone

Dim Start As DateTime = Now
Dim Results As DResults = Detector.Detect(Bmp, DetectorParameters)
Dim Elapsed As TimeSpan = Now – Start

PictureBox1.Image = Bmp
lblInfo.Text = Results.SearchedSubRegionCount & ” subregions were searched and ” & Results.NOfObjects & ” object(s) were detected in ” & Math.Round(Elapsed.TotalMilliseconds, 3).ToString & ” milliseconds.”
End Sub
Private Sub btnBrowse_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBrowse.Click
Dim OFDialog As New OpenFileDialog()
Try
OFDialog.Filter = “Images|*.tiff;*.jpg;*.jpeg;*.png;*.gif;*.bmp”
OFDialog.FilterIndex = 0
OFDialog.FileName = “”
If Not OFDialog.ShowDialog() = DialogResult.OK Then
Return
End If
Catch
Return
End Try

SelectedBitmap = New Bitmap(OFDialog.FileName)
PictureBox1.Image = SelectedBitmap.Clone

btnDetect.Enabled = True
End Sub

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

On Error Resume Next
hWnd = capCreateCaptureWindowA(VideoSource, WS_VISIBLE Or WS_CHILD, 0, 0, 0, _
0, PictureBox1.Handle.ToInt32, 0)

DestroyWindow(hWnd)

Dim MaxDetCount As Integer = Integer.MaxValue
Dim MinNRectCount As Integer = nudMinNRectCount.Value
Dim FirstScale As Single = Detector.Size2Scale(nudMinSize.Value)
Dim MaxScale As Single = Detector.Size2Scale(nudMaxSize.Value)
Dim ScaleMult As Single = nudScaleMult.Value
Dim SizeMultForNesRectCon As Single = nudSizeMultForNesRectCon.Value
Dim SlidingRatio As Single = nudSlidingRatio.Value
Dim Pen As New Pen(Brushes.Red, nudLineWidth.Value)
Dim DetectorParameters As New DetectionParams(MaxDetCount, MinNRectCount, FirstScale, MaxScale, ScaleMult, SizeMultForNesRectCon, SlidingRatio, Pen)

Dim Bmp As Bitmap = SelectedBitmap.Clone

Dim Start As DateTime = Now
Dim Results As DResults = Detector.Detect(Bmp, DetectorParameters)
Dim Elapsed As TimeSpan = Now – Start

PictureBox2.Image = Bmp
lblInfo.Text = Results.SearchedSubRegionCount & ” subregions were searched and ” & Results.NOfObjects & ” object(s) were detected in ” & Math.Round(Elapsed.TotalMilliseconds, 3).ToString & ” milliseconds.”
End Sub

Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListBox1.SelectedIndexChanged
SendMessage(hWnd, WM_CAP_DRIVER_DISCONNECT, VideoSource, 0)
DestroyWindow(hWnd)
VideoSource = ListBox1.SelectedIndex
hWnd = capCreateCaptureWindowA(VideoSource, WS_VISIBLE Or WS_CHILD, 0, 0, 0, _
0, PictureBox1.Handle.ToInt32, 0)
If SendMessage(hWnd, WM_CAP_DRIVER_CONNECT, VideoSource, 0) Then
SendMessage(hWnd, WM_CAP_SET_SCALE, True, 0)
SendMessage(hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0)
SendMessage(hWnd, WM_CAP_SET_PREVIEW, True, 0)
SetWindowPos(hWnd, HWND_BOTTOM, 0, 0, _
PictureBox1.Width, PictureBox1.Height, _
SWP_NOMOVE Or SWP_NOZORDER)
Else
DestroyWindow(hWnd)
End If
End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
ListBox1.Enabled = True
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Timer1.Stop()
End Sub

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

Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
Dim data As IDataObject
Dim bmap As Image

SendMessage(hWnd, WM_CAP_EDIT_COPY, 0, 0)

data = Clipboard.GetDataObject()
If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
bmap = _
CType(data.GetData(GetType(System.Drawing.Bitmap)), _
Image)
PictureBox1.Image = bmap
SendMessage(hWnd, WM_CAP_DRIVER_DISCONNECT, VideoSource, 0)
DestroyWindow(hWnd)
‘MsgBox(“Sukses”)
End If

End Sub

Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
PictureBox1.Image.Save(SaveFileDialog1.FileName)
End If
End Sub

Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
Dim m_i As Integer
PictureBoxClear1(Me.PictureBox1)
PictureBoxClear2(Me.PictureBox2)
m_i = m_i + 1
Dim nPT As New Point(0, 0)

End Sub

Public Sub PictureBoxClear1(ByRef pb As PictureBox)
PictureBox1.Image = Nothing
End Sub
Public Sub PictureBoxClear2(ByRef pb As PictureBox)
PictureBox2.Image = Nothing
End Sub

End Class

Please follow and like us:
10
One Response
  1. Aignoxinniliep

Leave a Reply

Your email address will not be published. Required fields are marked *