Option Explicit
Private Const 横 = 78                       '横竖格子数
Private Const 竖 = 45
Private Const 灰 = 8421504                  '线框颜色
Private Const 死 = 16777215                 '死颜色
Private Const 生 = 65280                    '生颜色
Dim z(横 + 1, 竖 + 1) As Byte               '目标数组
Dim l(横 + 1, 竖 + 1) As Byte               '中间数组
Dim hd As Long                              '格子大小，横竖
Dim ld As Long
Dim js As Long                              '演变回合
Private Sub Form_Click()
Timer1.Enabled = Not Timer1.Enabled         '单击开始或暂停演变
End Sub
Private Sub Form_Load()
Randomize                                   '初始化随机数
Dim i As Long, j As Long
For i = 1 To 横
    For j = 1 To 竖
        If Rnd() > 0.5 Then                 '随机情况
            z(i, j) = 1
        Else
            z(i, j) = 0
        End If
    Next j
Next i
Me.WindowState = 2                          '最大化窗口
DoEvents
End Sub
Public Sub view()
'显示每个格子
If hd < Screen.TwipsPerPixelX * 3 Or ld < Screen.TwipsPerPixelY * 3 Then Exit Sub
'如果不够绘图，则直接退出
Dim i As Long, j As Long
For i = 0 To 横 - 1
    For j = 0 To 竖 - 1
        If z(i + 1, j + 1) = 1 Then         '生，就用生画格
            Me.Line (i * hd + Screen.TwipsPerPixelX, j * ld + Screen.TwipsPerPixelY)-(i * hd + hd - Screen.TwipsPerPixelX, j * ld + ld - Screen.TwipsPerPixelY), 生, BF
        Else                                '死，就用死画格
            Me.Line (i * hd + Screen.TwipsPerPixelX, j * ld + Screen.TwipsPerPixelY)-(i * hd + hd - Screen.TwipsPerPixelX, j * ld + ld - Screen.TwipsPerPixelY), 死, BF
        End If
    Next j
Next i
End Sub
Private Sub Form_Paint()
'当窗口需要重绘时，绘制网络
Dim i As Long, j As Long
Me.Cls              '清屏
For i = 0 To 横 - 1
    For j = 0 To 竖 - 1
        Me.Line (i * hd, j * ld)-(i * hd + hd, j * ld + ld), 灰, B          '副格子线，按每个格子均画线，也可以按横和竖分别画线
    Next j
Next i
Call view           '重绘格子
End Sub
Private Sub Form_Resize()
'窗体大小改变时，计算格子大小
Dim i As Long
i = Me.ScaleWidth
hd = i \ 横
i = Me.ScaleHeight
ld = i \ 竖
Call Form_Paint         '缩小时，不会产生重绘事件，需要手动调用

End Sub
Public Sub r()              '运算函数
Dim i As Long, j As Long
Dim o As Long
For i = 1 To 横
    For j = 1 To 竖
        o = 0                       '统计8个格子，这里分了8行写，也可以使用一个二次循环来写，循环需要6行代码
        o = o + z(i - 1, j - 1)
        o = o + z(i, j - 1)
        o = o + z(i + 1, j - 1)
        o = o + z(i - 1, j)
        o = o + z(i + 1, j)
        o = o + z(i - 1, j + 1)
        o = o + z(i, j + 1)
        o = o + z(i + 1, j + 1)
        
        Select Case o
            Case 3
        '规则1:如果一个细胞周围有3个细胞为生（一个细胞周围共有8个细胞），
        '则该细胞为生（即该细胞若原先为死，则转为生，若原先为生，则保持不变） 。
                l(i, j) = 1
            Case 2
        '规则2． 如果一个细胞周围有2个细胞为生，则该细胞的生死状态保持不变；
                l(i, j) = z(i, j)
            Case Else
        '规则3． 在其它情况下，该细胞为死（即该细胞若原先为生，则转为死，若原先为死，则保持不变）
                l(i, j) = 0
        End Select
    Next j
Next i
'把中间结果写入目标
For i = 1 To 横
    For j = 1 To 竖
        z(i, j) = l(i, j)
    Next j
Next i
Call view
End Sub
Private Sub Timer1_Timer()
'定时器调用演变
js = js + 1
Call r
Me.Caption = "生命游戏（Game of Life） -- " & js
End Sub