Detect Motion Using Web Cam (From VB HowTos)

[Ali Rizwan]

Hello all,
This is a code using which you can detect motion using a web cam.

Controls>>

1. Picture Control
2. Label Control
3. Timer Control

Properties for Picture Control

• Name : Picture1
• Auto size : True (Optional)
• Border Style : 0-None (Optional)

Properties for Label Contro;

• Name : Label1
• Auto size : True

Properties for Timer Control

• Name : Timer1
• Enabled : True
• Interval : 50

Now add followin code >>>

[CODE=vb]'FOR WEBCAM DECLARATIONS
Private Declare Function SendMessage Lib "USER32" Alias "SendMessag eA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function capCreateCaptur eWindow Lib "avicap32.d ll" Alias "capCreateCaptu reWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long

Private mCapHwnd As Long

Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private Const GET_FRAME As Long = 1084
Private Const COPY As Long = 1054

'declarations
Dim P() As Long
Dim POn() As Boolean

Dim inten As Integer

Dim i As Integer, j As Integer

Dim Ri As Long, Wo As Long
Dim RealRi As Long

Dim c As Long, c2 As Long

Dim R As Integer, G As Integer, B As Integer
Dim R2 As Integer, G2 As Integer, B2 As Integer

Dim Tppx As Single, Tppy As Single
Dim Tolerance As Integer

Dim RealMov As Integer

Dim Counter As Integer

Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim LastTime As Long

Option Explicit

Private Sub Form_Load()
'set up the visual stuff
Picture1.Width = 640 * Screen.TwipsPer PixelX
Picture1.Height = 480 * Screen.TwipsPer PixelY

'Inten is the measure of how many pixels are going to be recognized. I highly dont recommend
'setting it lower than this, i have a 3.0 GHz PC and it starts to lag a little. On this setting,
'every 15th pixel is checked
inten = 15
'The tolerance of recognizing the pixel change
Tolerance = 20

Tppx = Screen.TwipsPer PixelX
Tppy = Screen.TwipsPer PixelY

ReDim POn(640 / inten, 480 / inten)
ReDim P(640 / inten, 480 / inten)

STARTCAM
End Sub



Private Sub Timer1_Timer()
'Get the picture from camera.. the main part
SendMessage mCapHwnd, GET_FRAME, 0, 0
SendMessage mCapHwnd, COPY, 0, 0
Picture1.Pictur e = Clipboard.GetDa ta
Clipboard.Clear

Ri = 0 'right
Wo = 0 'wrong

LastTime = GetTickCount

For i = 0 To 640 / inten - 1
For j = 0 To 480 / inten - 1
'get a point
c = Picture1.Point( i * inten * Tppx, j * inten * Tppy)
'analyze it, Red, Green, Blue
R = c Mod 256
G = (c \ 256) Mod 256
B = (c \ 256 \ 256) Mod 256

'recall what the point was one step before this
c2 = P(i, j)
'analyze it
R2 = c2 Mod 256
G2 = (c2 \ 256) Mod 256
B2 = (c2 \ 256 \ 256) Mod 256

'main comparison part... if each R, G and B are somewhat same, then it pixel is same still
'in a perfect camera and software tolerance should theoretically be 1 but this isnt true...
If Abs(R - R2) < Tolerance And Abs(G - G2) < Tolerance And Abs(B - B2) < Tolerance Then
'pixel remained same
Ri = Ri + 1
'Pon stores a boolean if the pixel changed or didnt, to be used to detect REAL movement
POn(i, j) = True

Else
'Pixel changed
Wo = Wo + 1
'make a red dor
P(i, j) = Picture1.Point( i * inten * Tppx, j * inten * Tppy)
Picture1.PSet (i * inten * Tppx, j * inten * Tppy), vbRed
POn(i, j) = False
End If

Next j

Next i

RealRi = 0

For i = 1 To 640 / inten - 2
For j = 1 To 480 / inten - 2
If POn(i, j) = False Then
'Real movement is simply occuring when all 4 pixels around one pixel changed
'Simply put, If this pixel is changed and all around it changed too, then this is a real
'movement
If POn(i, j + 1) = False Then
If POn(i, j - 1) = False Then
If POn(i + 1, j) = False Then
If POn(i - 1, j) = False Then
RealRi = RealRi + 1
Picture1.PSet (i * inten * Tppx, j * inten * Tppy), vbGreen
End If
End If
End If
End If

End If


Next j
Next i

'state all statistics
Label1.Caption = Int(Wo / (Ri + Wo) * 100) & " % movement" & vbCrLf & "Real Movement: " & RealRi & vbCrLf _
& "Completed in: " & GetTickCount - LastTime

Picture1.Top = 0
Picture1.Left = 0

Label1.Top = Picture1.Height + 5

Me.Width = Picture1.Width + 5
Me.Height = Picture1.Height + Label1.Height + 500


End Sub

Sub STOPCAM()
DoEvents: SendMessage mCapHwnd, DISCONNECT, 0, 0
Timer1.Enabled = False
End Sub

Sub STARTCAM()
mCapHwnd = capCreateCaptur eWindow("Webcam Capture", 0, 0, 0, 640, 480, Me.hwnd, 0)
DoEvents
SendMessage mCapHwnd, CONNECT, 0, 0
Timer1.Enabled = True
End Sub[/CODE]

Note : Stop cam function is used to stop the timer and disconnecting the cam. In above example i have not used Stopcam function so if you want to use you can.

Regards
>> ALI <<