MineSweeper in VBA - Aufdeckmechanismus


#1
Moin, liebe Leute.

Willkommen auf meinem ersten Thread in diesem Forum. Ich hab hier schon den einen oder anderen Thread zum Thema VBA-MineSweeper gesehen, aber leider beschreibt keiner von diesen mein Problem.

Also: Ich mache gerade ein Praktikum im IT-Bereich, um herauszufinden, ob mir die Branche liegt. Im Rahmen eben dieses Praktikums habe ich die Aufgabe bekommen, Minesweeper mit VBA zu proggen. Bin da auch schon relativ weit, mir fehlt eigentlich nur noch eine Idee, wie ich leere Felder im Umfeld einer aktiven Zelle automatisch aufdecke, damit ich nicht wie blöde im Spielfeld herumstochern muss.

Hatte da an eine Schleife gedacht, die im Umfeld der aktiven Zelle nach einem x (x ist hier die Mine, die ich nicht anklicken darf) sucht, und falls weder die aktive Zelle noch die Zellen im 1er Umfeld ein solches x enthalten, soll er jeweils in alle Richtungen weitergehen, bis er ein x da stehen hat.

Nun zu meiner Frage: Wie kann ich das machen, ohne da ne Endlosschleife zu erschaffen und so weiter?

Danke schonmal im Voraus.

Have a nice day,

Yours, Quanaarin!

P.S.: Ich würde gerne die aktuelle Version dranhängen, damit ihr seht, wo ich stehe, aber die Seite sagt mir, die hochgeladene Datei habe keine erlaubte Erweiterung.


Tante Edit: Code siehe unten
 
Zuletzt bearbeitet:
#4
Visual Basic:
Public iPlus As Integer
Public iZüge As Integer
Public iTreffer As Integer



Public Function Check()

iPlus = 4
For y = 0 To 10
    For i = 0 To 10
    If Cells(y + iPlus, i + iPlus) = "x" Then
        Cells(y + iPlus, i + iPlus) = "y"
        Cells(y + iPlus, i + iPlus).Interior.ColorIndex = 3
    End If
    Next
Next

End Function




Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rowindex
Dim Columnindex
Dim upperbound
Dim lowerbound
Dim iWert As Integer
upperbound = 14
lowerbound = 1
rowindex = ActiveCell.Row
Columnindex = ActiveCell.Column
    If ActiveCell.Value = "x" Then                                          ' "wenn aktive Zelle "x" enthält, dann"
        'iWert = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)      '
        'Cells(rowindex, Columnindex) = "y"                                 '
        Cells(rowindex, Columnindex).Interior.ColorIndex = 3                ' "ändere Füllfarbe der aktiven Zelle in 3 (rot)"
        Cells(rowindex, Columnindex).Font.ColorIndex = 3                    ' "ändere Schriftfarbe der aktiven Zelle in 3 (rot)"
        
        MsgBox ":c BOOM! Game Over! Try again. c:"                                        ' "öffne ein Textfeld, mit den Worten 'BOOM! Game Over! :c'"
    Else
        If rowindex >= 5 And rowindex <= 14 And Columnindex >= 5 And Columnindex <= 14 Then 'Feldbegrenzung ("wenn Zeilenindex der aktiven Zelle größer gleich 5 und kleiner gleich 14 und Spaltenindex größer gleich 5 und kleiner gleich 14, dann")
        
            iWert = Umfeldcheck(rowindex, Columnindex)                                      ' "Führe Funktion "Umfeldcheck" aus"
            Cells(rowindex, Columnindex).Interior.ColorIndex = 14                           ' "ändere Füllfarbe der aktiven Zelle in 14 (türkis)"
            
            iZüge = iZüge + 1                                                               ' Counter "addiere der Variable "iZüge" einen Zähler hinzu"
            Cells(rowindex, Columnindex) = iWert
        End If
    End If
    Cells(9, 22) = iZüge                                                 ' "(zeile 9, Spalte 22) betrifft Variable "iTreffer"."
                                              
    
End Sub

Sub Schaltfläche1_Klicken()
Range("Spielflaeche").Interior.ColorIndex = 0

Dim rowindex
Dim Columnindex
Dim upperbound
Dim lowerbound
Dim iWertRow As Integer
Dim iWertCol As Integer
upperbound = 14
lowerbound = 5
iPlus = 4
For y = 1 To 10
    For i = 1 To 10
        Cells(y + iPlus, i + iPlus) = " "
        Cells(y + iPlus, i + iPlus).Interior.ColorIndex = 0
        Cells(y + iPlus, i + iPlus).Font.ColorIndex = 1
        
        
        '0 = ohne Farbe; 1 = schwarz; 2 = weiß; 3 = rot; 4 = grün; 5 = blau; 6 = gelb; 7 = Magenta, 8 = Cyan
        
    Next
Next
For y = 0 To 10 'du
    'For i = 0 To 10
    iWertRow = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    iWertCol = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    Cells(iWertRow, iWertCol) = "x"


    'Next
Next
    Cells(9, 22) = 0
    iZüge = 0
    
End Sub


Public Function Umfeldcheck(r, c)
    Dim iZahl
    Dim iFarbe
        
    

        If Cells(r, c + 1) = "x" Then       ' "Wenn Zelle (Zeile + 0, Spalte + 1) "x" enthält, dann
        iZahl = iZahl + 1                   ' "addiere der Variable 'iZahl' einen Zähler hinzu"
        Cells(r, c).Font.ColorIndex = 1     ' "ändere Schriftfarbe der Zelle in 1 (schwarz)
      
    
        
    End If
        If Cells(r + 1, c + 1) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
        
        
    End If
        If Cells(r + 1, c) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
        
        
    End If
        If Cells(r + 1, c - 1) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
      
    End If
        If Cells(r, c - 1) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
        
    End If
        If Cells(r - 1, c) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
        
    End If
        If Cells(r - 1, c - 1) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
        
    End If
        If Cells(r - 1, c + 1) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
      
    End If
    
        
        
    
    Umfeldcheck = iZahl
End Function
 
#9
Uii, sry falls ich unverständlich schreibe. Bin wie gesagt noch gänzlich neu auf dem Gebiet. Ich will sagen, dass er automatisch eine 0 setzt, wenn er weder ein x direkt in der aktiven Zelle noch im 1er Radius stehen hat.

siehe:

If Cells(r + 1, c - 1) = "x" Then
iZahl = iZahl + 1
Cells(r, c).Font.ColorIndex = 1

End If
 
#10
Uii, sry falls ich unverständlich schreibe. Bin wie gesagt noch gänzlich neu auf dem Gebiet. Ich will sagen, dass er automatisch eine 0 setzt, wenn er weder ein x direkt in der aktiven Zelle noch im 1er Radius stehen hat.

siehe:

If Cells(r + 1, c - 1) = "x" Then
iZahl = iZahl + 1
Cells(r, c).Font.ColorIndex = 1

End If
P.S.: Die 0 setzt er dann folglich in die aktive (angeklickte) Zelle.
 
#13
Genau, dann ist das Feld bereits aufgdeckt.
Das ist ja der Plan, dass er das für alle umliegenden Felder ebenfalls macht. bisher fügt er - wie gesagt - bei Klicken eines leeren Feldes, wo auch kein x in der unmittelbaren Nähe ist, direkt eine 0 hinzu, da er andernfalls eine 1 (bei einem x im 1er Radius) bzw. eine 2 (bei 2 x im 1er Radius) usw. schreibt. Das ist ja die beschriebene Function "Umfeldcheck". So hab ich es zumindest verstanden, und das funktioniert soweit ja auch.

Ich hoffe, wir reden hier gerade nicht aneinander vorbei. :D
 
#14
Das ist ja der Plan, dass er das für alle umliegenden Felder ebenfalls macht. bisher fügt er - wie gesagt - bei Klicken eines leeren Feldes, wo auch kein x in der unmittelbaren Nähe ist, direkt eine 0 hinzu, da er andernfalls eine 1 (bei einem x im 1er Radius) bzw. eine 2 (bei 2 x im 1er Radius) usw. schreibt. Das ist ja die beschriebene Function "Umfeldcheck". So hab ich es zumindest verstanden, und das funktioniert soweit ja auch.

Ich hoffe, wir reden hier gerade nicht aneinander vorbei. :D
Mir fällt gerade auf, dass ich das Wort "ja" ziemlich inflationär benutze. Muss ich ändern, sieht komisch aus. :LOL::censored:
 
#16
Du gehst sehr Statisch ans Werk. Rekursiv ist einfacher.

1) Also, du prüfst das aktive Feld. Wenn es eine Mine ist - Boom, fertig.
2) Ermittle die Minen rundherum und trag die Zahl ein.
3) Wenn 0, rufe für alle acht benachbarten Felder Punkt 2 auf.

Damit finden sich die anderen leeren Felder von alleine.
 

Neue Beiträge