出差累死,还用VB做,还这点米,无聊,写个小东西:

“生命游戏”

本世纪70年代,人们曾疯魔一种被称作“生命游戏”的小游戏,这种游戏相当简单。假设有一个像棋盘一样的方格网,每个方格中放置一个生命细胞,生命细胞只有两种状态:“生”或“死”。游戏规则如下: 1、如果一个细胞周围有3个细胞为生(一个细胞周围共有8个细胞),则该细胞为生,即该细胞若原先为死,则转为生,若原先为生,则保持不变; 2、如果一个细胞周围有2个细胞为生,则该细胞的生死状态保持不变; 3、在其它情况下,该细胞为死,即该细胞若原先为生,则转为死,若原先为死,则保持不变。

依此规则进行迭代变化,使细胞生生死死,会得到一些有趣的结果。该游戏之所以被称为“生命游戏”,是因为其简单的游戏规则,反映了自然界中的生存规律:如果一个生命,其周围的同类生命太少的话,会因为得不到帮助而死亡;如果太多,则会因为得不到足够的资源而死亡。

VB project “生命游戏” 1.界面很简单,一个Start button,一个label 2.代码:

'by metaphy   
'2006-2-24  
Option Explicit  
  
Private AWIDTH As Integer  
Private AHEIGHT As Integer  
Private AX As Integer  
Private AY As Integer  
Private SIDELEN As Integer  
Private orgStat As Variant      '细胞初始态  
Private endStat As Variant      '结束态  
  
'初始常量  
Private Sub Form_Load()  
'    mainfrm.BackColor = RGB(180, 180, 180)  
    AX = 50  
    AY = 50  
    SIDELEN = 105  
    AWIDTH = 100  
    AHEIGHT = 70  
    ReDim orgStat(100, 70) As Integer  
    ReDim endStat(100, 70) As Integer  
End Sub  
  
'画布初始  
Private Sub initCanvas()  
    Dim i, j As Integer  
    For i = 0 To AWIDTH  
         Line (AX + i * SIDELEN, AY)-(AX + i * SIDELEN, AY + AHEIGHT * SIDELEN)  
    Next  
      
    For j = 0 To AHEIGHT  
        Line (AX, AY + j * SIDELEN)-(AX + AWIDTH * SIDELEN, AY + j * SIDELEN)  
    Next  
End Sub  
  
'画布重画  
Private Sub reCanvas()  
    Dim i, j As Integer  
      
    For i = 0 To AWIDTH - 1  
        For j = 0 To AHEIGHT - 1  
            If endStat(i, j) = 1 Then  
                'Line (AX + i * SIDELEN, AY + j * SIDELEN)-(AX + (i + 1) * SIDELEN, AY + (j + 1) * SIDELEN), RGB(255, 255, 0), BF  
                Line (AX + i * SIDELEN + 1, AY + j * SIDELEN - 1)-(AX + (i + 1) * SIDELEN + 1, AY + (j + 1) * SIDELEN - 1), RGB(0, 0, 0), BF  
            Else  
                Line (AX + i * SIDELEN + 1, AY + j * SIDELEN - 1)-(AX + (i + 1) * SIDELEN + 1, AY + (j + 1) * SIDELEN - 1), RGB(255, 255, 255), BF  
            End If  
              
            If i = AWIDTH - 1 Then Line (AX, AY + j * SIDELEN)-(AX + AWIDTH * SIDELEN, AY + j * SIDELEN)  
        Next  
                  
        Line (AX + i * SIDELEN, AY)-(AX + i * SIDELEN, AY + AHEIGHT * SIDELEN)  
  
    Next  
      
    i = AWIDTH  
    j = AHEIGHT  
    Line (AX + i * SIDELEN, AY)-(AX + i * SIDELEN, AY + AHEIGHT * SIDELEN)  
    Line (AX, AY + j * SIDELEN)-(AX + AWIDTH * SIDELEN, AY + j * SIDELEN)  
End Sub  
  
'迭代,得到细胞状态  
Private Sub changeState(times As Integer)  
    Dim i, j, tim As Integer  
    Dim lives As Integer  
      
    For i = 0 To AWIDTH - 1  
        For j = 0 To AHEIGHT - 1  
            Randomize  
            orgStat(i, j) = Int(2 * Rnd)  
            endStat(i, j) = 0  
        Next  
    Next  
      
    For tim = 0 To times - 1  
        For i = 1 To AWIDTH - 2     '最外面一层不参与  
            For j = 1 To AHEIGHT - 2  
                lives = 0  
                lives = orgStat(i - 1, j - 1) + orgStat(i, j - 1) + orgStat(i + 1, j - 1) _  
                    + orgStat(i - 1, j) + orgStat(i + 1, j) _  
                    + orgStat(i - 1, j + 1) + orgStat(i, j + 1) + orgStat(i + 1, j + 1)  
                If lives = 2 Then  
                    endStat(i, j) = orgStat(i, j)  
                ElseIf lives = 3 Then  
                    endStat(i, j) = 1  
                Else  
                    endStat(i, j) = 0  
                End If  
                  
            Next  
        Next  
          
        For i = 0 To AWIDTH  
            For j = 0 To AHEIGHT  
                orgStat(i, j) = endStat(i, j)  
            Next  
        Next  
    Next  
      
End Sub  
  
'显示部分信息  
Private Sub someInfo(times As String)  
    Label1.Caption = "迭代次数:" + times  
  
  
End Sub  
Private Sub Start_Click()  
    Dim times As Integer  
    Randomize  
    times = Int(200 * Rnd + 1)  
    Call someInfo(Str(times))  
      
    Call changeState(times)  
    Call reCanvas  
      
End Sub