Schiebepuzzle (8-puzzle)
Diese Fallstudie zeigt, was in Excel-VBA selten zu sehen ist, objektorientierte Programmierung in Reinform. Sie ist einfach im Aufbau und im Code und eignet sich deshalb gut als Anschauungsmaterial für Anfänger der OOP.
Es handelt sich um ein Schiebepuzzle mit 8 Schiebefeldern in den insgesamt 9 Zellen des Spielfelds. Eine Zelle ist leer, so dass über diese Zelle die jeweils angrenzenden Schiebeflächen verschoben werden können. Es gibt zwei Lösungen. Die erste besteht darin, die Schiebefelder in aufsteigender Reihenfolge hintereinander zu platzieren, Zeile für Zeile und Spalte für Spalte, so dass die Zelle in der rechten unteren Ecke leer ist. Bei der zweiten Lösung werden die Schiebefelder in aufsteigender Reihenfolge um die leere Mittelzelle herum platziert.
In der digitalen Form enthält das Spielfeld neun Schaltflächen, von denen zu jedem Zeitpunkt des Spiels acht mit einer Zahl beschriftet sind. Die neunte Schaltfläche repräsentiert die leere Zelle und ist daher unbeschriftet. Das Schieben wird durch ein Anklicken des zu verschiebenden Elements ersetzt. Klickt der Spieler in der unten abgebildeten Situation z.B. auf die 2, so tauscht diese ihren Platz mit dem des leeren Elements.

Neben den Schiebeflächen gibt es zwei weitere Elemente auf dem Formular. Ein Textfeld in der rechten unteren Ecke gibt an, wie viele Züge (Schiebungen) der Spieler schon vollzogen hat. Die Schaltfläche links unten erlaubt, zufallsgesteuert ein neues Spiel zu kreieren. Der Zähler wird in diesem Fall auf 0 zurückgestellt.
Die Architektur der Anwendung
Sie ist überaus simpel. Sie umfasst zwei Schichten mit jeweils einer Klasse. Die obere Schicht besteht aus dem Formular puzzleForm und der dazu gehörigen Formularklasse. Die Klasse puzzle bildet die untere Schicht (folgendes Bild)

Der Code der Klasse puzzle
Die Instanzenvariable p ist ein zweidimensionales Array (eine Matrix) welche die Belegung der neun Zellen des Spielfeldes speichert. Die beiden Variablen rowE und ColE halten Information bereit, die in p auch enthalten ist, nämlich die Position des leeren Felds bzw. der 9. Sie erlauben einen schnellen Zugriff auf diese Information.
Von den Methoden sind besonders zwei erwähnenswert. Die Funktion getPositions ist eine reine Informationsmethode; sie liefert die aktuelle Belegung der Felder. Die Benutzersteuerung kann sie verwenden, um die Buttons der Oberfläche dem Spielstand entsprechend zu besetzen.
Die Methode move vollzieht einen Zug, der von den Koordinaten (drow, dcol) ausgeht, aber nur, wenn dieser möglich ist. Ist der Zug in der betreffenden Situation nicht zulässig, so wird er einfach ignoriert und die Spielfeldbelegung bleibt unverändert.
'class puzzle
Private p(1 To 3, 1 To 3) As Integer 'contents of the playing field; 9 for empty
Private rowE As Integer 'row of the empty field (9)
Private colE As Integer 'column of the empty field
'tells the present contents of the buttons
Public Function getPositions() As Integer()
getPositions = p
End Function
'creates a new game using random moves
Public Sub newGame()
p(1, 1) = 1
p(1, 2) = 2
p(1, 3) = 3
p(2, 1) = 4
p(2, 2) = 9
p(2, 3) = 5
p(3, 1) = 6
p(3, 2) = 7
p(3, 3) = 8
rowE = 2
colE = 2
randomMoves 1000
End Sub
'executes move from (drow, dcol) if correct
Public Function move(ByVal drow As Integer, ByVal dcol As Integer) As Boolean
move = True
If correct(drow, dcol) Then
p(rowE, colE) = p(drow, dcol)
p(drow, dcol) = 9
rowE = drow
colE = dcol
Else
move = False
End If
End Function
'checks if move from (drow, dcol) is correct
Private Function correct(ByVal drow As Integer, ByVal dcol As Integer) As Boolean
correct = _
CInt(Abs(drow - rowE)) = 1 And dcol = colE Or _
CInt(Abs(dcol - colE)) = 1 And drow = rowE
End Function
'does num random moves
Private Sub randomMoves(ByVal num As Integer)
Dim i As Integer, row As Integer, col As Integer
For i = 1 To num
row = Int(1 + 3 * Rnd)
col = Int(1 + 3 * Rnd)
move row, col
Next i
End Sub
Der Code der Formularklasse puzzleForm
Beachten Sie, dass jede der Schaltflächen im Spielfeld eine eigene Ereignisprozedur benötigt. Diese wird allerdings dadurch kurz halten, dass eine Prozedur movingFrom aufgerufen wird, welche alle gewünschten Züge abarbeitet. Diese Prozedur beauftragt zunächst das puzzle-Objekt, den Zug durchzuführen. Ist die Rückmeldung positiv, so wird die aktuelle Besetzung der Spielfeldzellen abgerufen und diese werden über einen Aufruf von setValues aktualisiert. Beim Aktualisieren werden die Schaltflächen nicht etwa verschoben (was sehr aufwändig wäre), sondern nur neu beschriftet.
Option Explicit
Private pu As puzzle
Private b() As Integer 'present captions of the buttons
Private Sub UserForm_Initialize()
Set pu = New puzzle
pu.newGame
setValues
Me.countTBx.Text = "0"
End Sub
Private Sub setValues()
b = pu.getPositions
b11.Caption = IIf(b(1, 1) <> 9, CStr(b(1, 1)), "")
b12.Caption = IIf(b(1, 2) <> 9, CStr(b(1, 2)), "")
b13.Caption = IIf(b(1, 3) <> 9, CStr(b(1, 3)), "")
b21.Caption = IIf(b(2, 1) <> 9, CStr(b(2, 1)), "")
b22.Caption = IIf(b(2, 2) <> 9, CStr(b(2, 2)), "")
b23.Caption = IIf(b(2, 3) <> 9, CStr(b(2, 3)), "")
b31.Caption = IIf(b(3, 1) <> 9, CStr(b(3, 1)), "")
b32.Caption = IIf(b(3, 2) <> 9, CStr(b(3, 2)), "")
b33.Caption = IIf(b(3, 3) <> 9, CStr(b(3, 3)), "")
End Sub
Private Sub b11_Click()
If b11.Caption <> "" Then movingFrom 1, 1
End Sub
Private Sub b12_Click()
If b12.Caption <> "" Then movingFrom 1, 2
End Sub
Private Sub b13_Click()
If b13.Caption <> "" Then movingFrom 1, 3
End Sub
Private Sub b21_Click()
If b21.Caption <> "" Then movingFrom 2, 1
End Sub
Private Sub b22_Click()
If b22.Caption <> "" Then movingFrom 2, 2
End Sub
Private Sub b23_Click()
If b23.Caption <> "" Then movingFrom 2, 3
End Sub
Private Sub b31_Click()
If b31.Caption <> "" Then movingFrom 3, 1
End Sub
Private Sub b32_Click()
If b32.Caption <> "" Then movingFrom 3, 2
End Sub
Private Sub b33_Click()
If b33.Caption <> "" Then movingFrom 3, 3
End Sub
Private Sub movingFrom(ByVal row As Integer, ByVal col As Integer)
If pu.move(row, col) Then
pu.getPositions
setValues
Me.countTBx.Text = CStr(CInt(Me.countTBx.Text) + 1)
End If
End Sub
Private Sub newGameBtn_Click()
pu.newGame
b = pu.getPositions
setValues
Me.countTBx.Text = "0"
End Sub