.细胞存活. 求大大指正.该怎么处理

.细胞存活. 求大大指正.
3 行一行3 个 shape shape(1 to 9)
两个 com
红的为活绿的为死.

VB code


'
' 假设在培养皿里有3X3排列的9个细胞 ，开始的时候细胞的状态是随机给定的
' 每过一天细胞状态变化一次。
' （假设所有细胞在同一时间变化，细胞状态受变化前的环境影响。）
'
'设定：
'    1.一个活细胞，当它周围的活细胞少于2个时，细胞因为缺少能量传递而在下一天死去。
'    2．一个活细胞当它周围的活细胞大于等于3个时，细胞因为没有足够的空间而在下一天死去。
'    3．一个死细胞，如果它周围的死细胞大于等于3个时，细胞在下一天复活。
'        R. 0 0 . 1 0 . 2 1 . 3 0 . 4 0 .....  G. 3 1 . 4 1 .
' 要求：设计一个程序，计算出每个细胞在下一天的存活状态。
'

Option Explicit
Option Base 1

Dim SC(1 To 9) As Boolean
Dim i As Integer, j As Integer, k As Integer
Dim Upi As Integer, Dni As Integer, Lti As Integer, Rti As Integer
Dim CC

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub cmdNext_Click()
  Dim moke(1 To 9) As String
  Dim m As String

  For i = 1 To 9
    SC(i) = IIf(S(i).FillColor = vbRed, True, False)
    If i > 3 Then
      j = j + Abs(up(i))
      k = k + 1 - Abs(up(i))
    End If
    If i Mod 3 <> 1 Then
      j = j + Abs(lt(i))
      k = k + 1 - Abs(lt(i))
    End If
    If i Mod 3 <> 0 Then
      j = j + Abs(rt(i))
      k = k + 1 - Abs(rt(i))
    End If
    If i < 7 Then
      j = j + Abs(dn(i))
      k = k + 1 - Abs(dn(i))
    End If

    m = IIf(SC(i), "1", "0")
    moke(i) = m & "," & j & "," & k
    moke(j) = i & m & "," & j & "," & k
    Debug.Print moke(j)
    j = 0
    k = 0
  Next i

  For i = 1 To 9
    CC = Split(moke(i), ",")
    Select Case CC(0)
    Case 1
      If CC(1) = "0" Or "1" Or "3" Or "4" Then change
    Case 0
      If CC(2) = "3" Or "4" Then change
    End Select
  Next i
End Sub

Function up(Upi As Integer) As Boolean    ' -3
  If S(Upi - 3).FillColor = vbRed Then up = True
End Function

Function dn(Dni As Integer) As Boolean    ' +3
  If S(Dni + 3).FillColor = vbRed Then dn = True
End Function

Function lt(Lti As Integer) As Boolean    ' -1
  If S(Lti - 1).FillColor = vbRed Then lt = True
End Function

Function rt(Rti As Integer) As Boolean   ' +1
  If S(Rti + 1).FillColor = vbRed Then rt = True
End Function

Sub change()
  If S(i).FillColor = vbRed Then
     S(i).FillColor = vbGreen
  ElseIf S(i).FillColor = vbGreen Then
     S(i).FillColor = vbRed
  End If
End Sub

Private Sub Form_Load()
  Randomize
  Dim i As Long
  For i = 1 To 9
    S(i).FillColor = IIf(Rnd * 100 Mod 2 = 0, vbRed, vbGreen)
  Next
  
  For i = 1 To 9
    SC(i) = IIf(S(i).FillColor = vbRed, True, False)
    ' Debug.Print SC(i)
  Next i
End Sub

nextday 需要三个数来确定变不变.
当前是死是活. 附近几个活几个死
现在的 function up dn lt rt 返回后能把后两个得出来了.
怎么改改能一下这三个值都出来呢 -.-

change 过程能不能再简单些?
能不能在前面就定好 shape(i).fillcolor = vbred 就等于 true , vbgreen 就等于 flase

折腾一天算是写出来了... 可怎么看怎么不满意... 来求教...

------解决方案--------------------
简单的来了，验证无误

VB code

Private Sub Command1_Click()
On Error Resume Next
Dim b(1 To 9) As Integer
Dim n(1 To 9) As Integer
For i = 1 To 9
    If Shape1(i).BackColor = vbRed Then b(i) = 1 Else b(i) = 0
Next i
For i = 1 To 9
    n(i) = 0
    n(i) = n(i) + b(i - 3)
    If i Mod 3 <> 1 Then n(i) = n(i) + b(i - 1)
    If i Mod 3 <> 0 Then n(i) = n(i) + b(i + 1)
    n(i) = n(i) + b(i + 3)
    '上面算法每只细胞只算四个方向，如果要算8个方向，把下面代码取消注释
    'If i Mod 3 <> 0 Then n(i) = n(i) + b(i + 4)
    'If i Mod 3 <> 1 Then n(i) = n(i) + b(i + 2)
    'If i Mod 3 <> 1 Then n(i) = n(i) + b(i - 4)
    'If i Mod 3 <> 0 Then n(i) = n(i) + b(i - 2)
Next i
For i = 1 To 9
    If b(i) = 1 Then
        If n(i) >= 3 Or n(i) < 2 Then b(i) = 0: Shape1(i).BackColor = vbGreen
    Else
        If n(i) >= 3 Then b(i) = 1: Shape1(i).BackColor = vbRed
    End If
Next i
End Sub

Private Sub Form_Load()
  Randomize
  Dim i As Long
  For i = 1 To 9
    Shape1(i).BackColor = IIf(Rnd * 100 Mod 2 = 0, vbRed, vbGreen)
  Next
End Sub

.细胞存活. 求大大指正.该怎么处理

相关推荐