Simulate a flock of objects in your game


Have you ever wished that you could get a group of objects to move as though they had a collective mind, like a school of fish or a herd of buffalo? You've probably realized that it's a flocking problem! I'll show you the flocking solution to the whole flocking thing! This source code sample shows you how. If you would like step by step instructions check out: Simulate a flock of objects in VB6 - Tutorial.


Visual Basic Source Screen Shot


If you enjoyed this post, subscribe for updates (it's free)

VB.NET conversion

' Just create a new forms project, double click on the blank form, then copy everything below onto it. arrow keys work.

Option Explicit On

Public Class Form1
'Need to declare the timer so we can control the frame rate
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Structure SHEEPTYPE
Public sngX As Single 'Where is this sheep?
Public sngY As Single
Public sngXSpeed As Single 'How fast did it last move?
Public sngYSpeed As Single
End Structure
Dim mudtSheep() As SHEEPTYPE

Dim mintFollowX As Integer 'Where is the flock moving?
Dim mintFollowY As Integer

Dim mlngTimer As Long 'Timer for FPS maintenance
Dim mblnRunning As Boolean 'Render loop control variable

Const MS_PER_FRAME = 25 'How many milliseconds per frame of animation?
Const NUM_SHEEP = 19 'How many sheep will we use?
Const MAX_SPEED_VARIANCE = 0.001 'How fast can a sheep 'accelerate' w.r.t. his neighbour?
Const MIN_SPEED = 0.005 'Min sheep velocity!
Const MAX_SPEED = 0.01 'Max sheep velocity!
Const MIN_SEPERATION = 15 'Minimum distance between neighbouring sheep
Const MAX_NOISE = 250 'Adds a little "jiggle" for realism
Const FOLLOW_AMOUNT = 100 'Speed with which flock will move when arrow keys are pressed

Const CIRCLE_RADIUS = 5 'Size of the circle that represents our sheep

Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
'Move the flock around!
If e.KeyCode = Keys.Down Then mintFollowY = mintFollowY + FOLLOW_AMOUNT
If e.KeyCode = Keys.Up Then mintFollowY = mintFollowY - FOLLOW_AMOUNT
If e.KeyCode = Keys.Left Then mintFollowX = mintFollowX - FOLLOW_AMOUNT
If e.KeyCode = Keys.Right Then mintFollowX = mintFollowX + FOLLOW_AMOUNT
End Sub

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

Dim i As Integer
Dim j As Integer
Dim blnSeperation As Boolean

'Initialize the array
ReDim mudtSheep(NUM_SHEEP - 1)

'Randomize the locations
For i = 0 To UBound(mudtSheep)
blnSeperation = False
Do While Not (blnSeperation)
'Try a spot
mudtSheep(i).sngX = Rnd() * Me.Width
mudtSheep(i).sngY = Rnd() * Me.Height
'Ensure that it's not too close to a pre-existing sheep
blnSeperation = True
For j = 0 To i - 1
If CalcDist(i, j) <= MIN_SEPERATION Then
blnSeperation = False
Exit For
End If
Next j
Next i

'Show the form

'Start the main loop
mblnRunning = True
Do While mblnRunning
'Maintain the FPS
If mlngTimer + MS_PER_FRAME <= GetTickCount() Then
'Reset the timer
mlngTimer = GetTickCount()
'Run the flocking AI
'Display the sheep
End If
'Let windows have a go

End Sub

Private Sub Flocking_AI()

Dim i As Integer
Dim j As Integer
Dim sngDist As Single
Dim sngXSpeed As Single
Dim sngYSpeed As Single
Dim sngXSum As Single
Dim sngYSum As Single
Dim sngXAvg As Single
Dim sngYAvg As Single
Dim sngXDist As Single
Dim sngYDist As Single
Dim sngTmpX As Single
Dim sngTmpY As Single

'Step through each sheep...
For i = 0 To UBound(mudtSheep)

'Find speed of nearest neighbour
sngDist = 0
For j = 0 To UBound(mudtSheep)
'Skip the current sheep!
If j <> i Then
'Compare this sheep's distance to the closest one so far
If (sngDist = 0) Or CalcDist(i, j) < sngDist Then
'If this sheep is closer, store the distance
sngDist = CalcDist(i, j)
'And store the speed
sngXSpeed = mudtSheep(j).sngXSpeed
sngYSpeed = mudtSheep(j).sngYSpeed
End If
End If
Next j

'Let our sheep move as fast as possible
mudtSheep(i).sngXSpeed = sngXSpeed + MAX_SPEED_VARIANCE
mudtSheep(i).sngYSpeed = sngYSpeed + MAX_SPEED_VARIANCE
If mudtSheep(i).sngXSpeed < MIN_SPEED Then mudtSheep(i).sngXSpeed = MIN_SPEED
If mudtSheep(i).sngYSpeed < MIN_SPEED Then mudtSheep(i).sngYSpeed = MIN_SPEED
If mudtSheep(i).sngXSpeed > MAX_SPEED Then mudtSheep(i).sngXSpeed = MAX_SPEED
If mudtSheep(i).sngYSpeed > MAX_SPEED Then mudtSheep(i).sngYSpeed = MAX_SPEED

'Find the center of the flock
sngXSum = 0
sngYSum = 0
For j = 0 To UBound(mudtSheep)
'Add up all of the values
sngXSum = sngXSum + mudtSheep(j).sngX
sngYSum = sngYSum + mudtSheep(j).sngY
Next j
'Average the values (and add some positive or negative noise and the "follow" amount)
sngXAvg = (sngXSum / NUM_SHEEP) + (Rnd() * MAX_NOISE) - (MAX_NOISE / 2) + mintFollowX
sngYAvg = (sngYSum / NUM_SHEEP) + (Rnd() * MAX_NOISE) - (MAX_NOISE / 2) + mintFollowY

'Move towards the center! (as fast as allowable)
sngTmpX = mudtSheep(i).sngX
sngTmpY = mudtSheep(i).sngY
'Determine the X and Y movement amounts
sngXDist = sngXAvg - mudtSheep(i).sngX
sngYDist = sngYAvg - mudtSheep(i).sngY
'Move the X and Y coords
mudtSheep(i).sngX = mudtSheep(i).sngX + sngXDist * mudtSheep(i).sngXSpeed
mudtSheep(i).sngY = mudtSheep(i).sngY + sngYDist * mudtSheep(i).sngYSpeed
'Test for seperation
For j = 0 To UBound(mudtSheep)
If (i <> j) And (CalcDist(i, j) <= MIN_SEPERATION) Then
'There's another sheep too close, don't move
mudtSheep(i).sngX = sngTmpX
mudtSheep(i).sngY = sngTmpY
Exit For
End If
Next j

'Wrap the sheep at the edges of the window
If mudtSheep(i).sngX > Me.Width Then mudtSheep(i).sngX = mudtSheep(i).sngX - Me.Width
If mudtSheep(i).sngX < 0 Then mudtSheep(i).sngX = mudtSheep(i).sngX + Me.Width
If mudtSheep(i).sngY > Me.Height Then mudtSheep(i).sngY = mudtSheep(i).sngY - Me.Height
If mudtSheep(i).sngY < 0 Then mudtSheep(i).sngY = mudtSheep(i).sngY + Me.Height

Next i

End Sub

Private Function CalcDist(ByVal intIndex1 As Integer, ByVal intIndex2 As Integer) As Single
'How far appart are the two sheep that have been indicated?
CalcDist = Math.Sqrt((mudtSheep(intIndex1).sngX - mudtSheep(intIndex2).sngX) ^ 2 + (mudtSheep(intIndex1).sngY - mudtSheep(intIndex2).sngY) ^ 2)
End Function

Private Sub Display_Sheep()
Dim i As Integer
'Draw our beautiful flock!
Dim G As Graphics = Me.CreateGraphics
For i = 0 To UBound(mudtSheep)
G.DrawEllipse(Pens.White, mudtSheep(i).sngX, mudtSheep(i).sngY, CIRCLE_RADIUS, CIRCLE_RADIUS)
Next i
End Sub

Private Sub Form_Unload(ByVal Cancel As Integer)
'Stop the render loop
mblnRunning = False
End Sub
End Class


I thought that was excellent!! And instead of it moving slowly by repeatedly tapping the arrow keys a simple 1/2 pushes of an arrow key and it will rapidly soar through the form.