PDA

View Full Version : Minsweeper VBA code Problem



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

Paul_Hossler
05-09-2019, 05:46 AM
Sounds like a fun project

I added CODE tags
... ... ... around your macro

You can use the [#] icon and and paste your macro between to set it off and to format it a little

fool
05-09-2019, 07:42 AM
It's fun but difficult:crying::banghead:

Paul_Hossler
05-09-2019, 09:38 AM
Probably would be easier to for others to offer suggestions if you attached a XLSM with the worksheet setup and the macro that you have in it

See #2 in my sig

fool
05-09-2019, 10:48 AM
24200
Here You are

Paul_Hossler
05-09-2019, 11:08 AM
From our FAQ


Can I ask about my homework here?
Please don't ask us questions directly out of your coursework materials. We are happy to provide direction and guidance for those studying VBA and other software. Be open about the fact that it is coursework, and you'll likely find yourself with more resources than you could possible need.


Looking at the comments in the macro, it appears that this is a homework / class assignment, for which only suggestions are allowed

But there's "YOUR CODE HERE" in the comments, so what is your specific question(s)?

Bob Phillips
05-09-2019, 11:22 AM
A few suggestions from me.

- I would remove all of the non-event code from the worksheet code module into separate code module or two, I always think that makes for tidier, more readable code - it does mean the module level variables would have to become public, but I would move them as well
- I would add a defined name for the map so that you can just check if the target is intersecting a named range rather than checking row bounds and column bounds
- I would have Reset and New as forms buttons on the sheet rather than double-clicked cells

I haven't studied it in enough detail to make more comments on the code, for instance CalcNumMines looks far too convoluted to me but I cannot make suggestions as I have not gotten deeply enough into it.

My other suggestion, others will disagree I know, but I think you have over-commented the code. Too many comments gets in the way of code-readability IMO.
You use too many words IMO, I feel you should use as few as possible to get the meaning across, no subjectivity, just objectivity.
You embed comments that describe the procedure within the code of the procedure, if you need these comments I always feel they are best after the procedure signature, before any declaratives.
You have superfluous comments. For instance at one point you have the comment ' Ask for the number of mines', followed by the code line 'num_mines = InputBox("Enter the number of mines (1-20):")'. The code says it all, the comment is just stating the obvious, and is cluttering up.

Bob Phillips
05-09-2019, 11:23 AM
From our FAQ

Looking at the comments in the macro, it appears that this is a homework / class assignment, for which only suggestions are allowed

But there's "YOUR CODE HERE" in the comments, so what is your specific question(s)?

I read it as a project that he is building to give to a class of (tyro?) coders, asking them to add that code. I may be wrong ...