Startseite > VB6, VBA > Game of Life mit VB6

Game of Life mit VB6


Game of Life mit VB6 über die Konsole. Das ist der absoluter s…. sag ich euch.

 

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
158159
160161
162163
164165
166167
168169
170171
172173
174175
176177
178179
180181
182183
184185
186187
188189
190191
192193
194195
196197
Option Explicit
 Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function GetStdHandle Lib "kernel32" ( _    ByVal nStdHandle As Long) As Long
Private Declare Function FreeConsole Lib "kernel32" () As LongPrivate Declare Function SetConsoleCtrlHandler Lib "kernel32" ( _
    ByVal HandlerRoutine As Long, ByVal Add As Long) As LongPrivate Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long) As LongPrivate Declare Function WriteConsole Lib "kernel32" Alias _
    "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, _    ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, _
    lpReserved As Any) As LongPrivate Declare Function WaitForSingleObject Lib "kernel32" ( _
    ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long  Private hConsole As Long  Private Const WELT_X As Integer = 16Private Const WELT_Y As Integer = 16
Private Const MAX_ANFANG_LEBEN As Integer = 100Private Const STABILE_MAX As Integer = 10
Private Const LEBEN_ZEICHEN As String = "X"  Public Sub Main()        If AllocConsole Then            ' Konsole zeugs        ' =========================
        hConsole = GetStdHandle(-11&) ' Konsolenhandler holen             If hConsole = 0 Then            FreeConsole ' wenn handler null dann beenden
            Exit Sub        Else
            SetConsoleCtrlHandler AddressOf ConsoleCtrlHandler, True        End If
        ' bis hier hin        '==========================
                Dim x As Integer
        Dim y As Integer        Dim StabileGeneration As Integer: StabileGeneration = 0
        Dim CellAppearance(0 To 1) As String        CellAppearance(0) = " ": CellAppearance(1) = LEBEN_ZEICHEN
        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 sLine(1 To WELT_X - 2) As String
        Dim sBlock As String        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                        'Anzeigen            For y = 1 To WELT_Y - 2
                For x = 1 To WELT_X - 2                    sLine(x) = CellAppearance(cells(x, y))
                Next                sBlock = sBlock & Join(sLine, "") & "\n"
            Next            Printf sBlock, "\n\n", "Generationen: ", iGenerations, _
                " Anzahl: ", iNewPopulation, "\n\n\n\n\n\n\n\n"            Sleep 60
            sBlock = ""                        ' stabilität checken            If iNewPopulation > iOldPopulation - 2 And _
                iNewPopulation < iOldPopulation + 2 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                                        'nr 2                    ElseIf Neighbors < 2 Then
                        cells(x, y) = 0                                            'nr 3                    ElseIf Neighbors > 1 And Neighbors < 4 Then
                        'lebe weiter ^^                                             'nr 4                    ElseIf Neighbors > 3 Then
                        cells(x, y) = 0                                        End If                                        iNewPopulation = iNewPopulation + cells(x, y)                    Neighbors = 0
                Next                sBlock = sBlock & Join(sLine) & "\n"
            Next                        iGenerations = iGenerations + 1        Loop
                Printf "\nSeit ", STABILE_MAX, " Generationen stabil\n"
        Sleep 2000                ' KOnsole killen        If Not (hConsole = 0) Then
            FreeConsole            CloseHandle hConsole
        End If                End If
    End 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 Printf(ParamArray strx() As Variant)
        Dim str As Variant
    Dim line As String        For Each str In strx        line = line & Replace$(CStr(str), "\n", vbNewLine)
    Next        WriteConsole hConsole, ByVal line, Len(line), vbNull, ByVal 0&  End Sub  Private Function ConsoleCtrlHandler(ByVal lng As Long) As Long    ConsoleCtrlHandler = 1
End Function 
GeSHi 1.0.8.8
Advertisements
Kategorien:VB6, VBA Schlagwörter:
  1. Es gibt noch keine Kommentare.
  1. No trackbacks yet.

Kommentar verfassen

Trage deine Daten unten ein oder klicke ein Icon um dich einzuloggen:

WordPress.com-Logo

Du kommentierst mit Deinem WordPress.com-Konto. Abmelden / Ändern )

Twitter-Bild

Du kommentierst mit Deinem Twitter-Konto. Abmelden / Ändern )

Facebook-Foto

Du kommentierst mit Deinem Facebook-Konto. Abmelden / Ändern )

Google+ Foto

Du kommentierst mit Deinem Google+-Konto. Abmelden / Ändern )

Verbinde mit %s

%d Bloggern gefällt das: