Results 1 to 7 of 7

Thread: Detect Movement, Cam [RESOLVED]

  1. #1

    Thread Starter
    Hyperactive Member alacritous's Avatar
    Join Date
    Aug 2003
    Posts
    464

    Resolved Detect Movement, Cam [RESOLVED]

    Hello,
    I want to create a program that "looks" through my web cam and determines if there is any movement. If there is, I want it to do something.

    I have the following code from PSCode.com:

    http://www.pscode.com/vb/scripts/Sho...20041848591370

    I don't know like anything that has to do with graphics : / so any help is greatly appreciated!

    Thanks,
    alacritous
    Last edited by alacritous; Sep 22nd, 2004 at 08:56 PM.

  2. #2
    The picture isn't missing BuggyProgrammer's Avatar
    Join Date
    Oct 2000
    Location
    Vancouver, Canada
    Posts
    5,217
    Remember, if someone's post was not helpful, you can always rate their post negatively .

  3. #3

    Thread Starter
    Hyperactive Member alacritous's Avatar
    Join Date
    Aug 2003
    Posts
    464
    How would I make it so if there are any red boxes (motion) it does a sub or something?

  4. #4
    The picture isn't missing BuggyProgrammer's Avatar
    Join Date
    Oct 2000
    Location
    Vancouver, Canada
    Posts
    5,217
    I have no idea. I didn't even download the code.
    Remember, if someone's post was not helpful, you can always rate their post negatively .

  5. #5

    Thread Starter
    Hyperactive Member alacritous's Avatar
    Join Date
    Aug 2003
    Posts
    464
    Well, you just did.

    (I think this is the right part)
    BTW, preveri proženje motion-a is "preveri pro?enje motion it".
    I couldn't translate it all because the translater is dumb...hehe

    VB Code:
    1. Sub GetMotion()
    2.     Dim ColorSumStr As String           'sum of pixel color
    3.     Dim ColorRedStr As String           'red
    4.     Dim ColorGreenStr As String         'green
    5.     Dim ColorBlueStr As String          'blue
    6.     Dim ColorRedDec As Single           'red
    7.     Dim ColorGreenDec As Single         'green
    8.     Dim ColorBlueDec As Single          'blue
    9.     Dim PixX As Single                  'curent pixel X
    10.     Dim PixY As Single                  'curent pixel Y
    11.     Dim AveragePixel(5) As Single       'Average color from 6 pixels
    12.     Static Counter As Single            'counter
    13.     Dim AverageSum As Single            'Average sum of all colors
    14.    
    15.     Dim BoxesX As Single                'how many 'detection boxes - x axis
    16.     Dim BoxesY As Single                'how many 'detection boxes - y axis
    17.     Dim AveragePixelLoop As Single      'defines how many frames does this sub compare
    18.    
    19.     BoxesX = 16                         'from 1 to 50
    20.     BoxesY = 16                         'from 1 to 50
    21.     AveragePixelLoop = 30               'from 1 to 250
    22.    
    23.     Dim Repeat As Single
    24.     Dim Px As Single, Py As Single
    25.    
    26.     For Px = 0 To (MotionPic.Width) Step Int(MotionPic.Width / BoxesX)
    27.     For Py = 0 To (MotionPic.Height) Step Int(MotionPic.Height / BoxesY)
    28.            
    29.             PixX = Fix(Px / (MotionPic.Width / BoxesX))
    30.             PixY = Fix(Py / (MotionPic.Height / BoxesY))
    31.             For Repeat = 0 To 5
    32.                 ColorSumStr = Right$("000000" + Hex(GetPixel(MotionPic.hdc, Px + Repeat, Py + Repeat)), 6)
    33.                 ColorRedStr = Mid$(ColorSumStr, 5, 2)
    34.                 ColorGreenStr = Mid$(ColorSumStr, 3, 2)
    35.                 ColorBlueStr = Mid$(ColorSumStr, 1, 2)
    36.                 ColorRedDec = Val("&H" + ColorRedStr)
    37.                 ColorGreenDec = Val("&H" + ColorGreenStr)
    38.                 ColorBlueDec = Val("&H" + ColorBlueStr)
    39.                 AveragePixel(Repeat) = ColorRedDec + ColorGreenDec + ColorBlueDec
    40.             Next
    41.            
    42.             Counter = Counter + 1
    43.             If Counter = AveragePixelLoop Then Counter = 1
    44.            
    45.             mdSample(PixX, PixY, 0) = 0
    46.             mdSample(PixX, PixY, Counter) = 0
    47.             For Repeat = 0 To 5
    48.                 mdSample(PixX, PixY, 0) = mdSample(PixX, PixY, 0) + AveragePixel(Repeat)
    49.                 mdSample(PixX, PixY, Counter) = mdSample(PixX, PixY, 0) + AveragePixel(Repeat)
    50.             Next
    51.            
    52.             AverageSum = 0
    53.             For Repeat = 1 To AveragePixelLoop
    54.                 AverageSum = AverageSum + mdSample(PixX, PixY, Repeat)
    55.             Next
    56.             AverageSum = AverageSum / AveragePixelLoop
    57.            
    58.            
    59.             'preveri proženje motion-a
    60.             If Abs(mdSample(PixX, PixY, 0) - AverageSum) > mdTriger Then
    61.                 MotionPic.Line (Px - 4, Py - 4)-Step((MotionPic.Width / BoxesX) - 4, (MotionPic.Height / BoxesY) - 4), , B
    62.             End If
    63.     Next
    64.     Next
    65. End Sub

    I tried to look and put little counter things but it won't work out!

    Thanks,
    alacritous

  6. #6
    The picture isn't missing BuggyProgrammer's Avatar
    Join Date
    Oct 2000
    Location
    Vancouver, Canada
    Posts
    5,217
    Well it looks like that it draws the boxes here (I think you know this):
    VB Code:
    1. If Abs(mdSample(PixX, PixY, 0) - AverageSum) > mdTriger Then
    2.                 MotionPic.Line (Px - 4, Py - 4)-Step((MotionPic.Width / BoxesX) - 4, (MotionPic.Height / BoxesY) - 4), , B
    3.             End If

    Therefore:
    VB Code:
    1. If Abs(mdSample(PixX, PixY, 0) - AverageSum) > mdTriger Then
    2.                 'There is movement.  Do something about it
    3.                 'And since you just need to KNOW there is movement, you can do an exit sub:
    4.                 Exit Sub
    5.             End If
    Remember, if someone's post was not helpful, you can always rate their post negatively .

  7. #7

    Thread Starter
    Hyperactive Member alacritous's Avatar
    Join Date
    Aug 2003
    Posts
    464
    Hello,
    I can't believe I missed that. I've just been fooling around with it, finally got it to how I like it.

    Thanks,
    alacritous

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width