Archive

Posts Tagged ‘Forms’

Game of Life mit VB6 Forms

20. Januar 2011 Hinterlasse einen Kommentar

Die Konsolenversion von VB6 war ja jetzt wirklich extrem hässlich, deswegen habe ich mal was schöneres gebastelt.
So sieht das Teil aus. Leider ist nichts ungewöhnliches dran. Keine Pointer, keine HACKS, nichts… Also richtig langweilig.

image

image

 

Und der Source Code

Visual Basic
1
23
45
67
89
1011
1213
1415
1617
1819
2021
2223
2425
2627
2829
3031
3233
3435
3637
3839
4041
4243
4445
4647
4849
5051
5253
5455
5657
5859
6061
6263
6465
6667
6869
7071
7273
7475
7677
7879
8081
8283
8485
8687
8889
9091
9293
9495
9697
9899
100101
102103
104105
106107
108109
110111
112113
114115
116117
118119
120121
122123
124125
126127
128129
130131
132133
134135
136137
138139
140141
142143
144145
146147
148149
150151
152153
154155
156157
Option Explicit
 Private Declare Function WaitForSingleObject Lib "kernel32" ( _
    ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long  Private Const WELT_X As Integer = 16Private Const WELT_Y As Integer = 16
Private Const MAX_ANFANG_LEBEN As Integer = 20Private Const STABILE_MAX As Integer = 10
Private Const LEBEN_ZEICHEN As String = "X"  Private WithEvents BtnGo As CommandButton  Private Sub BtnGo_Click()      Dim x As Integer    Dim y As Integer
    Dim StabileGeneration As Integer: StabileGeneration = 0    Dim cells(0 To WELT_X - 1, 0 To WELT_Y - 1) As Byte
        ' welt nullen
    For y = 0 To WELT_Y - 1        For x = 0 To WELT_X - 1
            cells(x, y) = 0        Next
    Next        'welt mit viechern bevölkern    Randomize DateTime.Second(Time)
    Populate cells            Dim iGenerations As Integer: iGenerations = 0    Dim iOldPopulation As Integer: iOldPopulation = 0
    Dim iNewPopulation As Integer: iNewPopulation = MAX_ANFANG_LEBEN    Dim Neighbors As Integer: Neighbors = 0
        Do While StabileGeneration < STABILE_MAX
                DoEvents
        Me.Cls                                Me.Caption = "Generationen: " & iGenerations & _        " Anzahl: " & iNewPopulation
                Sleep 60
                ' stabilität checken
        If iNewPopulation > iOldPopulation - 3 And _            iNewPopulation < iOldPopulation + 3 Then
            StabileGeneration = StabileGeneration + 1        Else
            StabileGeneration = 0        End If
                iOldPopulation = iNewPopulation
        iNewPopulation = 0                For y = 1 To WELT_Y - 2            For x = 1 To WELT_X - 2
                                'Nachbarn zählen
                Neighbors = Neighbors + cells(x, y - 1)                Neighbors = Neighbors + cells(x, y + 1)
                                Neighbors = Neighbors + cells(x - 1, y)
                Neighbors = Neighbors + cells(x + 1, y)                                Neighbors = Neighbors + cells(x - 1, y - 1)                Neighbors = Neighbors + cells(x + 1, y - 1)
                                Neighbors = Neighbors + cells(x - 1, y + 1)
                Neighbors = Neighbors + cells(x + 1, y + 1)                                ' Regel anwenden                ' nr 1
                If cells(x, y) = 0 And Neighbors = 3 Then                    cells(x, y) = 1
                    Me.FillColor = vbGreen                    Me.Circle (16 * x, 16 * y), 7, vbGreen
                                'nr 2
                ElseIf Neighbors < 2 And cells(x, y) = 1 Then                    cells(x, y) = 0
                    Me.FillColor = &H808080                    Me.Circle (16 * x, 16 * y), 7, &H808080
                                    'nr 3
                ElseIf Neighbors > 1 And Neighbors < 4 And _                    cells(x, y) = 1 Then
                    Me.FillColor = vbBlue                    Me.Circle (16 * x, 16 * y), 7, vbBlue
                                    'nr 4
                ElseIf Neighbors > 3 And cells(x, y) = 1 Then                    cells(x, y) = 0
                    Me.FillColor = &H808080                    Me.Circle (16 * x, 16 * y), 7, &H808080
                                End If
                                iNewPopulation = iNewPopulation + cells(x, y)
                Neighbors = 0            Next
        Next                iGenerations = iGenerations + 1    Loop
        Me.FontTransparent = False
    If iOldPopulation = 0 Then        Me.Print "AUSGESTORBEN!"
    Else        Me.Print "Seit " & STABILE_MAX & " Generationen stabil"
    End IfEnd Sub
 Private Sub Populate(ByRef cells() As Byte)
        Dim lstart As Integer: lstart = MAX_ANFANG_LEBEN
    Dim i As Integer        Do While lstart > 0            For i = 1 To WELT_X - 2            lstart = lstart - RandomCells(cells, i, _
                CInt(Rnd() * (WELT_Y - 2)) + 1)        Next
            Loop
    End Sub
 Private Function RandomCells(ByRef cells() As Byte, _
    x As Integer, y As Integer) As Integer    If CInt(Rnd() * 1000) > 500 And cells(x, y) = 0 Then
        cells(x, y) = 1        RandomCells = 1
    Else        RandomCells = 0
    End IfEnd Function
 Private Function Sleep(ByVal millisec As Long)
  WaitForSingleObject -1, millisecEnd Function
 Private Sub Form_Load()
    Me.AutoRedraw = True    Me.ScaleMode = 3 'pixels
    Me.FillStyle = 0    Set BtnGo = Form1.Controls.Add("VB.Commandbutton", "BtnGo", Form1)
    BtnGo.Visible = True    BtnGo.Top = 10
    BtnGo.Left = Form1.ScaleWidth - BtnGo.Width - 10    BtnGo.Caption = "Los"
End Sub 
GeSHi 1.0.8.8

Ich habe mir schon eine Windows 98 SE VM gezogen für Turbo Pascal. Smiley

Kategorien:VB6, VBA Schlagwörter: , ,