浏览 2037 次
锁定老帖子 主题:"生命游戏",VB
精华帖 (0) :: 良好帖 (0) :: 新手帖 (0) :: 隐藏帖 (0)
|
|
---|---|
作者 | 正文 |
发表时间:2008-01-15
最后修改:2009-10-14
出差tmd累死,还用VB 做,还tmd这点米,无聊,写个小东西:
本世纪70年代,人们曾疯魔一种被称作“生命游戏”的小游戏,这种游戏相当简单。假设有一个像棋盘一样的方格网,每个方格中放置一个生命细胞,生命细胞只有两种状态:“生”或“死”。游戏规则如下: 依此规则进行迭代变化,使细胞生生死死,会得到一些有趣的结果。该游戏之所以被称为“生命游戏”,是因为其简单的游戏规则,反映了自然界中的生存规律:如果一个生命,其周围的同类生命太少的话,会因为得不到帮助而死亡;如果太多,则会因为得不到足够的资源而死亡。
'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
声明:ITeye文章版权属于作者,受法律保护。没有作者书面许可不得转载。
推荐链接
|
|
返回顶楼 | |