Beim Brettspiel Reversi Züge mit VBA ausschließen
07.08.2018 19:11:55
KlausF
Ich habe mal vor fast 20 Jahren angefangen, ein einfaches Strategie-Brettspiel für mich zu programmieren: Reversi.
Damals habe ich das dann wegen eines Zugproblems, das ich nicht lösen konnte, weggelegt. Wer es nicht kennt in Kurzform:
Ein 8 x 8 Felder großes Spielfeld und 64 Steine, die auf der einen Seite schwarz und auf der anderen Seite weiß sind.
Jeder bekommt 32 Steine. Je 2 weiße und 2 schwarze Steine liegen in der Grundstellung in der Brettmitte aneinander.
Es wird nun abwechselnd gesetzt und dabei Steine des Gegners horizontal, vertikal oder diagonal in zusammenhängender
Reihe eingeschlossen und zu Steinen seiner eigenen Farbe gedreht. Falls mit einem Stein mehrere Reihen gedreht werden
könnten, muss man sich für eine Reihe entscheiden.
Ich habe jetzt den Zugmechanismus soweit, dass ich per Doppelklick auf meine Farbe und erneutem Doppelklick
auf ein leeres Feld die eingeschlossenen gegnerischen Steine zu meiner Farbe drehen kann:
https://www.herber.de/bbs/user/123192.xls
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Intersect(Target, Range("Spielbrett")) Is Nothing Then Exit Sub
Cancel = True
Dim rngWert As Range
Set rngWert = Worksheets("Helpers").Range("WerIstDran")
Dim ZugWert As Integer
Dim strFarbe As String
ZugWert = rngWert.Value '100 oder -1
strFarbe = IIf(ZugWert = 100, "blau", "orange")
Dim xRow As Integer, xCol As Integer, yRow As Integer, yCol As Integer
Static rng As Range
If rng Is Nothing Then
Set rng = Target
Exit Sub
End If
xRow = rng.Row
xCol = rng.Column
yRow = ActiveCell.Row
yCol = ActiveCell.Column
If Cells(xRow, xCol) = "" Then MsgBox "Zuerst die Farbe " & strFarbe & " doppelklicken und dann _
das leere Feld !": GoTo ABBRUCH
If Cells(xRow, xCol) ZugWert Then MsgBox strFarbe & " ist am Zug !": GoTo ABBRUCH
'Wenn weiter gespielt werden soll als nur Zug 9, dann folgende Zeile auskommentieren:
If Target.Offset(0, 30) 1 Then MsgBox "Ungültiges Feld !": GoTo ABBRUCH
While xRow yRow Or xCol yCol
If xRow yRow Then
xRow = xRow - 1
End If
If xCol yCol Then
xCol = xCol - 1
End If
Cells(xRow, xCol).Value = ZugWert
Wend
'If Worksheets("Setzfelder").Range("Aussetzen") 1 Then
If rngWert = 100 Then
rngWert = -1
Else
rngWert = 100
End If
'End If
ABBRUCH:
Range("Spielbrett").Cells(0, 0).Select
Set rng = Nothing
Set rngWert = Nothing
End Sub
sondern auch um die Ecke (also z.B. wie das Pferd im Schach). Ich komme da auf keine Lösung. Genaueres in der
(stark abgespeckten) Datei. Und ... mein Excel ist uralt (Excel 2000 bzw. Excel X).
Ist das überhaupt realisierbar?
Gruß
Klaus