fool
05-09-2019, 12:15 AM
Option Explicit
' Variable declaration
Dim num_mines As Integer
Dim num_solved_mines As Integer
Dim map(1 To 8, 1 To 8) As Integer
Dim is_playing As Boolean
' This event handler will be invoked when a double click event is generated
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' Disable the editablity
Cancel = True
' If we double click on cell "New game", two subs, NewGame and DrawMap
' will be executed
If Target.Address = Range("New").Address Then
NewGame
DrawMap
' If we double click on cell "Reset", the game will be reset accordingly
ElseIf Target.Address = Range("Reset").Address Then
num_solved_mines = 0
Range("SolvedMines").Font.Color = vbBlack
Range("SolvedMines") = num_solved_mines
DrawMap
' If we double click on any cell in the battlefield, we will update the
' display accordingly
ElseIf (Target.row >= 4 And Target.row <= 11) And _
(Target.Column >= 3 And Target.Column <= 10) Then
If is_playing = True Then
UpdateDisplay Target.row, Target.Column
End If
End If
End Sub
' Get prepared for a new gameplay
Sub NewGame()
' Local variables
Dim count As Integer
Dim rand_row As Integer, rand_col As Integer
Dim row As Integer, col As Integer
' Since the game is about to start, this Boolean variable is set to true
is_playing = True
' Ask for the number of mines
num_mines = InputBox("Enter the number of mines (1-20):")
' Initialize the 2D integer array map so that all the cells are 0
' Hint: use a 2D array to achieve it
' Your code HERE
' Number of solved mines are definitely 0 :)
num_solved_mines = 0
Range("NumMines") = num_mines
Range("SolvedMines") = num_solved_mines
Range("SolvedMines").Font.Color = vbBlack
' Randomly place the mines
For count = 1 To num_mines
' Pick a random location (i.e., row and col indices) which contains no mines
' Hint: use a do while loops make the most sense out of it
' Your code HERE
Do
' Put the mine into the random location (i.e., assign 1 to map(rand_row, rand_col)
' Your code HERE
Next
End Sub
' Dram the battlefield using grey
Sub DrawMap()
Dim row As Integer, col As Integer
For row = 1 To 8
For col = 1 To 8
Cells(row + 3, col + 2).ClearContents
Cells(row + 3, col + 2).Interior.Color = RGB(170, 170, 170)
Next
Next
End Sub
' Calculate the number of adjacent mines
Function CalcNumMines(row As Integer, col As Integer) As Integer
CalcNumMines = 0
If row = 1 Then
CalcNumMines = CalcNumMines + map(row + 1, col)
If col = 1 Then
CalcNumMines = CalcNumMines + map(row, col + 1)
CalcNumMines = CalcNumMines + map(row + 1, col + 1)
ElseIf col = 8 Then
CalcNumMines = CalcNumMines + map(row, col - 1)
CalcNumMines = CalcNumMines + map(row + 1, col - 1)
Else
CalcNumMines = CalcNumMines + map(row, col - 1)
CalcNumMines = CalcNumMines + map(row, col + 1)
CalcNumMines = CalcNumMines + map(row + 1, col - 1)
CalcNumMines = CalcNumMines + map(row + 1, col + 1)
End If
ElseIf row = 8 Then
CalcNumMines = CalcNumMines + map(row - 1, col)
If col = 1 Then
CalcNumMines = CalcNumMines + map(row, col + 1)
CalcNumMines = CalcNumMines + map(row - 1, col + 1)
ElseIf col = 8 Then
CalcNumMines = CalcNumMines + map(row, col - 1)
CalcNumMines = CalcNumMines + map(row - 1, col - 1)
Else
CalcNumMines = CalcNumMines + map(row, col - 1)
CalcNumMines = CalcNumMines + map(row, col + 1)
CalcNumMines = CalcNumMines + map(row - 1, col - 1)
CalcNumMines = CalcNumMines + map(row - 1, col + 1)
End If
Else
CalcNumMines = CalcNumMines + map(row - 1, col)
CalcNumMines = CalcNumMines + map(row + 1, col)
If col = 1 Then
CalcNumMines = CalcNumMines + map(row - 1, col + 1)
CalcNumMines = CalcNumMines + map(row, col + 1)
CalcNumMines = CalcNumMines + map(row + 1, col + 1)
ElseIf col = 8 Then
CalcNumMines = CalcNumMines + map(row - 1, col - 1)
CalcNumMines = CalcNumMines + map(row, col - 1)
CalcNumMines = CalcNumMines + map(row + 1, col - 1)
Else
CalcNumMines = CalcNumMines + map(row - 1, col + 1)
CalcNumMines = CalcNumMines + map(row, col + 1)
CalcNumMines = CalcNumMines + map(row + 1, col + 1)
CalcNumMines = CalcNumMines + map(row - 1, col - 1)
CalcNumMines = CalcNumMines + map(row, col - 1)
CalcNumMines = CalcNumMines + map(row + 1, col - 1)
End If
End If
End Function
' Update the display when a cell in the battlefield is clicked
Sub UpdateDisplay(row As Integer, col As Integer)
' Note that row and col are the actual row and col indices of a cell
' e.g., row:4, col:3 in Excel refers to the element (1,1) in variable map
' If the cell contains no mines
' If the number of adjacent cells is larger than 0
' Change the color of the cell to white
' Display the number of adjacent cell on that cell
' Else
' "Unfold" all nearby empty cells
' (you can simply call subroutine UnfoldEmpty for that)
' Else
' If the cell is not marked as "?" then
' Display a gameover message (i.e., "Boom!!")
' Highlight the cell by red
' Set variable is_playing as false since the game is over
' Your code HERE
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
' Disable the right-click menu
Cancel = True
' If the cell is not marked
If Target.Interior.Color = RGB(170, 170, 170) Then
' 1. Increase num_solved_mines by 1
' 2. Display num_solved_mines at cell "SolvedMines"
' 3. Change the color of the involved cell to Cyan
' 4. Change its text to "?"
' 5. Call subroutine GameOver to see whether all mines are marked
' Your code HERE
' If the cell has been marked
ElseIf Target.Interior.Color = vbCyan Then
' 1. Change the color of the involved cell to RGB(170, 170, 170)
' 2. Clear its contents
' 3. Update the content at cell "SolvedMines"
End If
' Highlight the number accordingly
If num_solved_mines > num_mines Then
Range("SolvedMines").Font.Color = vbRed
Else
Range("SolvedMines").Font.Color = vbBlack
End If
End Sub
' Recursively unfold cells containing no mines
' Note: this sub makes use of recursion which will NOT be
' taught in class. you are not required to understand this.
Sub UnfoldEmpty(row As Integer, col As Integer)
If row < 1 Or row > 8 Then
Exit Sub
ElseIf col < 1 Or col > 8 Then
Exit Sub
ElseIf map(row, col) <> 0 Then
Exit Sub
Else
If CalcNumMines(row, col) > 0 Then
Cells(row + 3, col + 2) = CalcNumMines(row, col)
Cells(row + 3, col + 2).Interior.Color = vbWhite
ElseIf Cells(row + 3, col + 2).Interior.Color <> vbWhite Then
Cells(row + 3, col + 2).Interior.Color = vbWhite
UnfoldEmpty row - 1, col
UnfoldEmpty row, col - 1
UnfoldEmpty row, col + 1
UnfoldEmpty row + 1, col
End If
End If
End Sub
' Handle Game over situation
Sub GameOver()
Dim row As Integer, col As Integer
Dim num_solved_mines As Integer
num_solved_mines = 0
' Go through the entire variable map. if the corresponding cell is marked as "?"
' and it actually contains a mine, increase num_solved_mines by 1
' Your code HERE
' If num_solved_mines equals num_mines, display a congratuations message
' (e.g., You win!!) and set variable is_playing as False since the game is just over
' Your code HERE
End Sub
' Variable declaration
Dim num_mines As Integer
Dim num_solved_mines As Integer
Dim map(1 To 8, 1 To 8) As Integer
Dim is_playing As Boolean
' This event handler will be invoked when a double click event is generated
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' Disable the editablity
Cancel = True
' If we double click on cell "New game", two subs, NewGame and DrawMap
' will be executed
If Target.Address = Range("New").Address Then
NewGame
DrawMap
' If we double click on cell "Reset", the game will be reset accordingly
ElseIf Target.Address = Range("Reset").Address Then
num_solved_mines = 0
Range("SolvedMines").Font.Color = vbBlack
Range("SolvedMines") = num_solved_mines
DrawMap
' If we double click on any cell in the battlefield, we will update the
' display accordingly
ElseIf (Target.row >= 4 And Target.row <= 11) And _
(Target.Column >= 3 And Target.Column <= 10) Then
If is_playing = True Then
UpdateDisplay Target.row, Target.Column
End If
End If
End Sub
' Get prepared for a new gameplay
Sub NewGame()
' Local variables
Dim count As Integer
Dim rand_row As Integer, rand_col As Integer
Dim row As Integer, col As Integer
' Since the game is about to start, this Boolean variable is set to true
is_playing = True
' Ask for the number of mines
num_mines = InputBox("Enter the number of mines (1-20):")
' Initialize the 2D integer array map so that all the cells are 0
' Hint: use a 2D array to achieve it
' Your code HERE
' Number of solved mines are definitely 0 :)
num_solved_mines = 0
Range("NumMines") = num_mines
Range("SolvedMines") = num_solved_mines
Range("SolvedMines").Font.Color = vbBlack
' Randomly place the mines
For count = 1 To num_mines
' Pick a random location (i.e., row and col indices) which contains no mines
' Hint: use a do while loops make the most sense out of it
' Your code HERE
Do
' Put the mine into the random location (i.e., assign 1 to map(rand_row, rand_col)
' Your code HERE
Next
End Sub
' Dram the battlefield using grey
Sub DrawMap()
Dim row As Integer, col As Integer
For row = 1 To 8
For col = 1 To 8
Cells(row + 3, col + 2).ClearContents
Cells(row + 3, col + 2).Interior.Color = RGB(170, 170, 170)
Next
Next
End Sub
' Calculate the number of adjacent mines
Function CalcNumMines(row As Integer, col As Integer) As Integer
CalcNumMines = 0
If row = 1 Then
CalcNumMines = CalcNumMines + map(row + 1, col)
If col = 1 Then
CalcNumMines = CalcNumMines + map(row, col + 1)
CalcNumMines = CalcNumMines + map(row + 1, col + 1)
ElseIf col = 8 Then
CalcNumMines = CalcNumMines + map(row, col - 1)
CalcNumMines = CalcNumMines + map(row + 1, col - 1)
Else
CalcNumMines = CalcNumMines + map(row, col - 1)
CalcNumMines = CalcNumMines + map(row, col + 1)
CalcNumMines = CalcNumMines + map(row + 1, col - 1)
CalcNumMines = CalcNumMines + map(row + 1, col + 1)
End If
ElseIf row = 8 Then
CalcNumMines = CalcNumMines + map(row - 1, col)
If col = 1 Then
CalcNumMines = CalcNumMines + map(row, col + 1)
CalcNumMines = CalcNumMines + map(row - 1, col + 1)
ElseIf col = 8 Then
CalcNumMines = CalcNumMines + map(row, col - 1)
CalcNumMines = CalcNumMines + map(row - 1, col - 1)
Else
CalcNumMines = CalcNumMines + map(row, col - 1)
CalcNumMines = CalcNumMines + map(row, col + 1)
CalcNumMines = CalcNumMines + map(row - 1, col - 1)
CalcNumMines = CalcNumMines + map(row - 1, col + 1)
End If
Else
CalcNumMines = CalcNumMines + map(row - 1, col)
CalcNumMines = CalcNumMines + map(row + 1, col)
If col = 1 Then
CalcNumMines = CalcNumMines + map(row - 1, col + 1)
CalcNumMines = CalcNumMines + map(row, col + 1)
CalcNumMines = CalcNumMines + map(row + 1, col + 1)
ElseIf col = 8 Then
CalcNumMines = CalcNumMines + map(row - 1, col - 1)
CalcNumMines = CalcNumMines + map(row, col - 1)
CalcNumMines = CalcNumMines + map(row + 1, col - 1)
Else
CalcNumMines = CalcNumMines + map(row - 1, col + 1)
CalcNumMines = CalcNumMines + map(row, col + 1)
CalcNumMines = CalcNumMines + map(row + 1, col + 1)
CalcNumMines = CalcNumMines + map(row - 1, col - 1)
CalcNumMines = CalcNumMines + map(row, col - 1)
CalcNumMines = CalcNumMines + map(row + 1, col - 1)
End If
End If
End Function
' Update the display when a cell in the battlefield is clicked
Sub UpdateDisplay(row As Integer, col As Integer)
' Note that row and col are the actual row and col indices of a cell
' e.g., row:4, col:3 in Excel refers to the element (1,1) in variable map
' If the cell contains no mines
' If the number of adjacent cells is larger than 0
' Change the color of the cell to white
' Display the number of adjacent cell on that cell
' Else
' "Unfold" all nearby empty cells
' (you can simply call subroutine UnfoldEmpty for that)
' Else
' If the cell is not marked as "?" then
' Display a gameover message (i.e., "Boom!!")
' Highlight the cell by red
' Set variable is_playing as false since the game is over
' Your code HERE
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
' Disable the right-click menu
Cancel = True
' If the cell is not marked
If Target.Interior.Color = RGB(170, 170, 170) Then
' 1. Increase num_solved_mines by 1
' 2. Display num_solved_mines at cell "SolvedMines"
' 3. Change the color of the involved cell to Cyan
' 4. Change its text to "?"
' 5. Call subroutine GameOver to see whether all mines are marked
' Your code HERE
' If the cell has been marked
ElseIf Target.Interior.Color = vbCyan Then
' 1. Change the color of the involved cell to RGB(170, 170, 170)
' 2. Clear its contents
' 3. Update the content at cell "SolvedMines"
End If
' Highlight the number accordingly
If num_solved_mines > num_mines Then
Range("SolvedMines").Font.Color = vbRed
Else
Range("SolvedMines").Font.Color = vbBlack
End If
End Sub
' Recursively unfold cells containing no mines
' Note: this sub makes use of recursion which will NOT be
' taught in class. you are not required to understand this.
Sub UnfoldEmpty(row As Integer, col As Integer)
If row < 1 Or row > 8 Then
Exit Sub
ElseIf col < 1 Or col > 8 Then
Exit Sub
ElseIf map(row, col) <> 0 Then
Exit Sub
Else
If CalcNumMines(row, col) > 0 Then
Cells(row + 3, col + 2) = CalcNumMines(row, col)
Cells(row + 3, col + 2).Interior.Color = vbWhite
ElseIf Cells(row + 3, col + 2).Interior.Color <> vbWhite Then
Cells(row + 3, col + 2).Interior.Color = vbWhite
UnfoldEmpty row - 1, col
UnfoldEmpty row, col - 1
UnfoldEmpty row, col + 1
UnfoldEmpty row + 1, col
End If
End If
End Sub
' Handle Game over situation
Sub GameOver()
Dim row As Integer, col As Integer
Dim num_solved_mines As Integer
num_solved_mines = 0
' Go through the entire variable map. if the corresponding cell is marked as "?"
' and it actually contains a mine, increase num_solved_mines by 1
' Your code HERE
' If num_solved_mines equals num_mines, display a congratuations message
' (e.g., You win!!) and set variable is_playing as False since the game is just over
' Your code HERE
End Sub