Cellular Automata Algorithm Demonstration (33K)
23 Aug 2003
First Posted
vbAccelerator - Contents of code file: frmCellularAutomata.frm
VERSION 5.00
Begin VB.Form frmCellularAutomata
Caption = "vbAccelerator Cellular Automata Demo"
ClientHeight = 4065
ClientLeft = 5865
ClientTop = 4455
ClientWidth = 5370
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmCellularAutomata.frx":0000
LinkTopic = "Form1"
ScaleHeight = 271
ScaleMode = 3 'Pixel
ScaleWidth = 358
Begin VB.CommandButton cmdReset
Caption = "&Reset"
Height = 495
Left = 4020
TabIndex = 14
Top = 1260
Width = 1275
End
Begin VB.HScrollBar hscStates
Height = 255
LargeChange = 8
Left = 4080
Max = 32
Min = 8
SmallChange = 2
TabIndex = 3
Top = 2220
Value = 16
Width = 1095
End
Begin VB.CommandButton cmdDust
Caption = "&Dust"
Enabled = 0 'False
Height = 495
Left = 4020
TabIndex = 2
Top = 720
Width = 1275
End
Begin VB.CommandButton cmdRun
Caption = "&Run"
Height = 495
Left = 4020
TabIndex = 1
Top = 120
Width = 1275
End
Begin VB.PictureBox picCell
AutoRedraw = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3840
Left = 120
ScaleHeight = 3780
ScaleWidth = 3780
TabIndex = 0
Top = 120
Width = 3840
End
Begin VB.Label lblStates
Caption = "States: 16"
Height = 195
Left = 4080
TabIndex = 13
Top = 1980
Width = 1035
End
Begin VB.Label lblNeighbours
Caption = "Neighbours:"
Height = 195
Left = 4080
TabIndex = 12
Top = 2580
Width = 1035
End
Begin VB.Label lblNeighbour
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 315
Index = 8
Left = 4800
TabIndex = 11
Tag = "1,1"
Top = 3540
Width = 315
End
Begin VB.Label lblNeighbour
Appearance = 0 'Flat
BackColor = &H8000000D&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 315
Index = 7
Left = 4440
TabIndex = 10
Tag = "0,1"
Top = 3540
Width = 315
End
Begin VB.Label lblNeighbour
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 315
Index = 6
Left = 4080
TabIndex = 9
Tag = "-1,1"
Top = 3540
Width = 315
End
Begin VB.Label lblNeighbour
Appearance = 0 'Flat
BackColor = &H8000000D&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 315
Index = 5
Left = 4800
TabIndex = 8
Tag = "1,0"
Top = 3180
Width = 315
End
Begin VB.Label lblNeighbour
Appearance = 0 'Flat
BackColor = &H8000000D&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 315
Index = 3
Left = 4080
TabIndex = 7
Tag = "-1,0"
Top = 3180
Width = 315
End
Begin VB.Label lblNeighbour
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 315
Index = 2
Left = 4800
TabIndex = 6
Tag = "1,-1"
Top = 2820
Width = 315
End
Begin VB.Label lblNeighbour
Appearance = 0 'Flat
BackColor = &H8000000D&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 315
Index = 1
Left = 4440
TabIndex = 5
Tag = "0,-1"
Top = 2820
Width = 315
End
Begin VB.Label lblNeighbour
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 315
Index = 0
Left = 4080
TabIndex = 4
Tag = "-1,-1"
Top = 2820
Width = 315
End
End
Attribute VB_Name = "frmCellularAutomata"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_cCell As cCellularAutomata
Private Sub cmdReset_Click()
m_cCell.Init
End Sub
Private Sub cmdRun_Click()
If (cmdRun.Tag = "") Then
cmdRun.Tag = "RUN"
cmdRun.Caption = "&Stop"
cmdDust.Enabled = True
Do While cmdRun.Tag = "RUN"
m_cCell.Step
m_cCell.Paint picCell.hdc
picCell.Refresh
DoEvents
Loop
cmdRun.Caption = "&Run"
Else
cmdRun.Tag = ""
cmdDust.Enabled = False
End If
End Sub
Private Sub cmdDust_Click()
m_cCell.AddRandom 95
m_cCell.Paint picCell.hdc
picCell.Refresh
End Sub
Private Sub Form_Load()
Set m_cCell = New cCellularAutomata
m_cCell.Paint picCell.hdc
picCell.Refresh
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Len(cmdRun.Tag) > 0 Then
cmdRun_Click
End If
End Sub
Private Sub hscStates_Change()
m_cCell.States = hscStates.Value
lblStates.Caption = "States: " & hscStates.Value
End Sub
Private Sub hscStates_Scroll()
hscStates_Change
End Sub
Private Sub lblNeighbour_Click(Index As Integer)
Dim xOffset As Long
Dim yOffset As Long
Dim iPos As Long
Dim bState As Boolean
bState = Not (lblNeighbour(Index).BackColor = vbHighlight)
iPos = InStr(lblNeighbour(Index).Tag, ",")
xOffset = CLng(Left(lblNeighbour(Index).Tag, iPos - 1))
yOffset = CLng(Mid(lblNeighbour(Index).Tag, iPos + 1))
m_cCell.ConsiderNeighbour(xOffset, yOffset) = bState
lblNeighbour(Index).BackColor = IIf(bState, vbHighlight, vbWindowBackground)
End Sub