Excelでライフゲーム

　前回、Excelでタイマー処理をするサンプルを作ったので、今回はそれを利用して、ライフゲームを作ってみました。
　Excelのセルを見続けていると、こんな感じで遊びたくなるのが普通です。たぶん。。。

　例によって、動作保証はしませんが、ソースコードはご自由にお使いください。



Option Explicit

'--------------------------------------------------
'                   APIの宣言
'--------------------------------------------------
'DWORD timeGetTime( VOID);
Public Declare PtrSafe Function timeGetTime Lib "WINMM.DLL" () As Long

'SHORT GetAsyncKeyState( int vKey);
Public Declare PtrSafe Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Long
Public Const VK_ENTER As Integer = 13
Public Const VK_ESC As Integer = 27
Public Const VK_SPACE As Integer = 32
Public Const VK_LEFT As Integer = 37
Public Const VK_UP As Integer = 38
Public Const VK_RIGHT As Integer = 39
Public Const VK_DOWN As Integer = 40

'VOID Sleep( DWORD dwMilliseconds);
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'BOOL sndPlaySound( LPCSTR lpszSound, UINT fuSound);
Public Declare PtrSafe Function sndPlaySound Lib "WINMM.DLL" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Const SND_SYNC = &H0
Public Const SND_ASYNC = &H1
Public Const SND_NODEFAULT = &H2
Public Const SND_LOOP = &H8
Public Const SND_NOSTOP = &H10
'--------------------------------------------------

Private Const width As Long = 10
Private Const height As Long = 10
Private block(width * height - 1) As Byte '0 or 1

Public Sub lifeGame()
    Dim timeNext As Long
    Dim loopFlag As Boolean
 
    timeNext = timeGetTime
    loopFlag = True
 
    Call init
 
    '----- メインループ -----
    Do While loopFlag = True
        If timeNext < timeGetTime Then
            Call run
             
            '----- ESC Keyで終了 -----
            If GetAsyncKeyState(VK_ESC) <> 0 Then
                loopFlag = False
            End If
     
            '-------------------------
            timeNext = timeNext + 500
        End If
 
        '-------------------------
        Sheet1.Cells(1, 1).Select
        DoEvents
    Loop
    '------------------------
End Sub

'初期化
Private Sub init()
    Dim i As Long
    Dim j As Long
 
    '------------------------
    '行の高さ、列の幅を調整
    For i = 0 To width - 1
        Sheet1.Columns(i + 1).ColumnWidth = 2.095
    Next i
 
    For i = 0 To height - 1
        Sheet1.Rows(i + 1).RowHeight = 13.5
    Next i
 
    '------------------------
    '適当なサンプル
    Sheet1.Cells(4, 5) = "a"
    Sheet1.Cells(5, 5) = "a"
    Sheet1.Cells(6, 5) = "a"
    Sheet1.Cells(7, 5) = "a"
    Sheet1.Cells(8, 5) = "a"
 
    '------------------------
    For i = 0 To height - 1
        For j = 0 To width - 1
            block(i * width + j) = 0
         
            If Sheet1.Cells(i + 1, j + 1) = "a" Then
                block(i * width + j) = 1
            End If
        Next j
    Next i
End Sub

'メインループの処理
Private Sub run()
    Dim i As Long
    Dim j As Long
    Dim pos As Long
    Dim temp() As Byte
 
    ReDim temp(width * height - 1) As Byte
 
    '------------------------
    For i = 0 To height - 1
        For j = 0 To width - 1
            temp(i * width + j) = 0
        Next j
    Next i
 
    For i = 0 To height - 1
        For j = 0 To width - 1
            pos = ((i + height - 1) Mod height) * width + ((j + width - 1) Mod width)
            If block(pos) <> 0 Then temp(i * width + j) = temp(i * width + j) + 1
         
            pos = ((i + height - 1) Mod height) * width + j
            If block(pos) <> 0 Then temp(i * width + j) = temp(i * width + j) + 1
         
            pos = ((i + height - 1) Mod height) * width + ((j + 1) Mod width)
            If block(pos) <> 0 Then temp(i * width + j) = temp(i * width + j) + 1
         
            pos = i * width + ((j + width - 1) Mod width)
            If block(pos) <> 0 Then temp(i * width + j) = temp(i * width + j) + 1
         
            pos = i * width + ((j + 1) Mod width)
            If block(pos) <> 0 Then temp(i * width + j) = temp(i * width + j) + 1
         
            pos = ((i + 1) Mod height) * width + ((j + width - 1) Mod width)
            If block(pos) <> 0 Then temp(i * width + j) = temp(i * width + j) + 1
         
            pos = ((i + 1) Mod height) * width + j
            If block(pos) <> 0 Then temp(i * width + j) = temp(i * width + j) + 1
         
            pos = ((i + 1) Mod height) * width + ((j + 1) Mod width)
            If block(pos) <> 0 Then temp(i * width + j) = temp(i * width + j) + 1
        Next j
    Next i
 
    For i = 0 To height - 1
        For j = 0 To width - 1
            If block(i * width + j) = 0 Then
                If temp(i * width + j) = 3 Then
                    block(i * width + j) = 1
                End If
            ElseIf block(i * width + j) = 1 Then
                If temp(i * width + j) < 2 Or 3 < temp(i * width + j) Then
                    block(i * width + j) = 0
                End If
            End If
        Next j
    Next i
 
    '------------------------
    '描画
    For i = 0 To height - 1
        For j = 0 To width - 1
            If block(i * width + j) = 1 Then
                Sheet1.Cells(i + 1, j + 1) = "a"
            Else
                'なぜか知らないけど、空文字列""だと動作が遅くなるみたい
                Sheet1.Cells(i + 1, j + 1) = " "
            End If
        Next j
    Next i
End Sub