Multiwingspan Home Page |
Multiwingspan Games |
Gnasher @ Multiwingspan |
Multiwingspan Calendar |
Multiwingspan Clock |
About Multiwingspan |
Visual Basic 6.0 Guide |
Visual Basic 6.0 Examples |
Turbo Pascal Guide |
SWI Prolog Guide |
Visual Basic 2005 Guide |
Structured Query Language |
HTML Design Tasks |
Introduction To HTML |
Introduction To CSS |
Introduction To Javascript |
AS/A2 Level Computing |
This little project idea came from something that I read about in the New Scientist (No. 2488). The program produces the following pattern.
The pattern begins with one red dot in the centre of the first row of the picture box. To draw the next row of the pattern, the program looks at the row above and decides what colour each pixel should be based on a set of fairly simple rules.
In order to decide the colour of each pixel, the program examines the colour of the pixel immediately above it as well as those to the left and right of the pixel directly above. The various combinations of red and black pixels determine whether the pixel is to be black or red. These rules are followed until a predetermined number of rows has been processed. With each row processed, a pattern starts to develop.
Start a new project and add a form with a timer and a picture box on it. Set the backcolor property of the picture box to black and the timer interval to anything that you want other than zero. You will need the following code to complete the program.
Sub doStuff()
'seed the process with one coloured cell
picCells.PSet ((picCells.ScaleWidth / 2), 0), vbRed
For i = 1 To picCells.ScaleHeight - 10
For j = 10 To picCells.ScaleWidth - 10
'check 3 locations on previous row
Dim a As Integer, b As Integer, c As Integer
If picCells.Point(j - 1, i - 1) = vbRed Then
a = 1
Else
a = 0
End If
If picCells.Point(j, i - 1) = vbRed Then
b = 1
Else
b = 0
End If
If picCells.Point(j + 1, i - 1) = vbRed Then
c = 1
Else
c = 0
End If
'work out rule for next row
Dim d As Integer
If a = 1 Then
If b = 1 And c = 1 Then d = 0
If b = 1 And c = 0 Then d = 1
If b = 0 And c = 1 Then d = 0
If b = 0 And c = 0 Then d = 1
End If
If a = 0 Then
If b = 1 And c = 1 Then d = 1
If b = 1 And c = 0 Then d = 0
If b = 0 And c = 1 Then d = 1
If b = 0 And c = 0 Then d = 0
End If
If d = 1 Then picCells.PSet (j, i), vbRed
Next j
Next i
MsgBox "Done It"
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
doStuff
End Sub
Obvious, you can change the rules by monkeying around with the way that the value for the variable d is set. Your pattern will change accordingly. You could also adapt the process to deal with a range of colours. The more decisions that have to be examined, the slower the process will be, but you may get a more interesting patterm.
Return To Visual Basic 6.0 Examples || Return To Homepage