2
\$\begingroup\$

For those who are unfamiliar with the game:

https://en.wikipedia.org/wiki/Mastermind_(board_game)

A link to the workbook:

https://github.com/Evanml2030/Excel-Mastermind

Had trouble getting the form and scroll bar to adjust based on the resolution of the monitor that it is inside. It does not work on screens running with a resolution greater than 1600 x 900. See the resize me function in the form code, labeled front end, to take a look at the code.

APPLICATION:

Option Explicit 'ENUMERATED TYPES Public Enum GamePieceColor rgbRed = 255 rgbGreen = 65280 rgbBlue = 16711680 rgbYellow = 65535 rgbBlack = 0 rgbWhite = 16777215 rgbGrey = 12632256 rgbLightGrey = -2147483633 rgbNone = -1 End Enum 'STRUCTS Public Type GuessArray ColorOne As GamePieceColor ColorTwo As GamePieceColor ColorThree As GamePieceColor ColorFour As GamePieceColor End Type Private Type GameOver TrueFalse As Boolean Reason As String End Type Private Type GuessValid TrueFalse As Boolean Reason As String End Type Public Type ResponsePegs MatchesComplete As Long MatchesColor As Long End Type Public Type RequestNextColor Row As Long CurrentColor As GamePieceColor End Type Public Type RequestCheckGuess GuessArray As GuessArray End Type Public Type ResponseNextColor GuessNumber As Long NextColor As GamePieceColor End Type Public Type ResponseCheckGuess GuessValid As GuessValid GuessNumber As Long ResponsePegs As ResponsePegs GameOver As GameOver End Type 'GLOBAL VARIABLES Private GameOver As Boolean Private CurrentGuessNumber As Long Private MasterGuessArray As GuessArray Private MasterGuessArrayVisible As Boolean Private Const MaxGuesses = 9 'GAME LOOP Public Sub Main() Dim GameSpace As GameSpace Set GameSpace = New GameSpace GameSpace.Show End Sub Public Sub GameLoop(ByRef GameSpace As GameSpace) GameOver = False CurrentGuessNumber = 0 MasterGuessArray = GenerateMasterGuessArray MasterGuessArrayVisible = False Do While GameOver = False DoEvents On Error GoTo UserFormUnloaded: If GameSpace.Visible = False Then Exit Do End If GameSpace.Resize Loop Unload GameSpace UserFormUnloaded: End Sub Private Function GenerateMasterGuessArray() As GuessArray GenerateMasterGuessArray.ColorOne = RandomColor GenerateMasterGuessArray.ColorTwo = RandomColor GenerateMasterGuessArray.ColorThree = RandomColor GenerateMasterGuessArray.ColorFour = RandomColor End Function Private Function RandomColor() As GamePieceColor Dim RandomNumber As Long RandomNumber = Application.WorksheetFunction.RandBetween(0, 5) Select Case RandomNumber Case 0 RandomColor = rgbBlack Case 1 RandomColor = rgbBlue Case 2 RandomColor = rgbGreen Case 3 RandomColor = rgbRed Case 4 RandomColor = rgbWhite Case 5 RandomColor = rgbYellow End Select End Function 'GAME FUNCTIONS Public Function GetCheckGuess(ByRef RequestCheckGuess As RequestCheckGuess) As ResponseCheckGuess If CheckMaxGuessesExceeded = True Then GameOver = True GetCheckGuess.GameOver.TrueFalse = True GetCheckGuess.GameOver.Reason = "YOU LOSE! BETTER LUCK NEXT TIME!" Exit Function End If If CheckGuessValid(RequestCheckGuess.GuessArray) = False Then GetCheckGuess.GuessValid.TrueFalse = False GetCheckGuess.GuessValid.Reason = "PLEASE DO NOT INCLUDE ANY GREY SQUARES IN YOUR GUESS" Exit Function End If GetCheckGuess = GuessValidResponseAssemble(RequestCheckGuess.GuessArray) CurrentGuessNumber = CurrentGuessNumber + 1 If CheckGameWon(GetCheckGuess.ResponsePegs) = True Then GameOver = True GetCheckGuess.GameOver.TrueFalse = True GetCheckGuess.GameOver.Reason = "CONGRAGULATIONS, YOU WIN!" Exit Function End If End Function Private Function CheckMaxGuessesExceeded() As Boolean If CurrentGuessNumber > MaxGuesses Then CheckMaxGuessesExceeded = True Else CheckMaxGuessesExceeded = False End If End Function Private Function CheckGuessValid(ByRef GuessArray As GuessArray) As Boolean If (GuessArray.ColorOne = rgbGrey) Or _ (GuessArray.ColorTwo = rgbGrey) Or _ (GuessArray.ColorThree = rgbGrey) Or _ (GuessArray.ColorFour = rgbGrey) Then CheckGuessValid = False Else CheckGuessValid = True End If End Function Private Function GuessValidResponseAssemble(ByRef GuessArray As GuessArray) As ResponseCheckGuess GuessValidResponseAssemble.GuessValid.TrueFalse = True GuessValidResponseAssemble.GuessNumber = CurrentGuessNumber GuessValidResponseAssemble.ResponsePegs = DetermineMatches(GuessArray) End Function Private Function CheckGameWon(ByRef ResponsePegs As ResponsePegs) As Boolean If ResponsePegs.MatchesComplete = 4 Then CheckGameWon = True Else CheckGameWon = False End If End Function Private Function DetermineMatches(ByRef GuessArray As GuessArray) As ResponsePegs Dim TempMasterGuessArray As GuessArray TempMasterGuessArray = MasterGuessArray If GuessArray.ColorOne = TempMasterGuessArray.ColorOne Then GuessArray.ColorOne = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesComplete = DetermineMatches.MatchesComplete + 1 End If If GuessArray.ColorTwo = TempMasterGuessArray.ColorTwo Then GuessArray.ColorTwo = rgbNone TempMasterGuessArray.ColorTwo = rgbNone DetermineMatches.MatchesComplete = DetermineMatches.MatchesComplete + 1 End If If GuessArray.ColorThree = TempMasterGuessArray.ColorThree Then GuessArray.ColorThree = rgbNone TempMasterGuessArray.ColorThree = rgbNone DetermineMatches.MatchesComplete = DetermineMatches.MatchesComplete + 1 End If If GuessArray.ColorFour = TempMasterGuessArray.ColorFour Then GuessArray.ColorFour = rgbNone TempMasterGuessArray.ColorFour = rgbNone DetermineMatches.MatchesComplete = DetermineMatches.MatchesComplete + 1 End If If TempMasterGuessArray.ColorOne <> rgbNone Then If GuessArray.ColorTwo = TempMasterGuessArray.ColorOne Then GuessArray.ColorTwo = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 ElseIf GuessArray.ColorThree = TempMasterGuessArray.ColorOne Then GuessArray.ColorThree = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 ElseIf GuessArray.ColorFour = TempMasterGuessArray.ColorOne Then GuessArray.ColorFour = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 End If End If If TempMasterGuessArray.ColorTwo <> rgbNone Then If GuessArray.ColorOne = TempMasterGuessArray.ColorTwo Then GuessArray.ColorOne = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 ElseIf GuessArray.ColorThree = TempMasterGuessArray.ColorTwo Then GuessArray.ColorThree = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 ElseIf GuessArray.ColorFour = TempMasterGuessArray.ColorTwo Then GuessArray.ColorFour = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 End If End If If TempMasterGuessArray.ColorThree <> rgbNone Then If GuessArray.ColorOne = TempMasterGuessArray.ColorThree Then GuessArray.ColorOne = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 ElseIf GuessArray.ColorTwo = TempMasterGuessArray.ColorThree Then GuessArray.ColorTwo = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 ElseIf GuessArray.ColorFour = TempMasterGuessArray.ColorThree Then GuessArray.ColorFour = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 End If End If If TempMasterGuessArray.ColorFour <> rgbNone Then If GuessArray.ColorOne = TempMasterGuessArray.ColorFour Then GuessArray.ColorOne = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 ElseIf GuessArray.ColorTwo = TempMasterGuessArray.ColorFour Then GuessArray.ColorTwo = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 ElseIf GuessArray.ColorThree = TempMasterGuessArray.ColorFour Then GuessArray.ColorThree = rgbNone TempMasterGuessArray.ColorOne = rgbNone DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 End If End If End Function Public Function GetNextColor(ByRef RequestNextColor As RequestNextColor) As ResponseNextColor GetNextColor.GuessNumber = CurrentGuessNumber Select Case RequestNextColor.CurrentColor Case rgbGrey GetNextColor.NextColor = rgbBlack Case rgbBlack GetNextColor.NextColor = rgbBlue Case rgbBlue GetNextColor.NextColor = rgbGreen Case rgbGreen GetNextColor.NextColor = rgbRed Case rgbRed GetNextColor.NextColor = rgbWhite Case rgbWhite GetNextColor.NextColor = rgbYellow Case rgbYellow GetNextColor.NextColor = rgbBlack End Select End Function Public Function GetCurrentGuessNumber() As Long GetCurrentGuessNumber = CurrentGuessNumber End Function Public Function GetMasterRow() As GuessArray GetMasterRow.ColorOne = MasterGuessArray.ColorOne GetMasterRow.ColorTwo = MasterGuessArray.ColorTwo GetMasterRow.ColorThree = MasterGuessArray.ColorThree GetMasterRow.ColorFour = MasterGuessArray.ColorFour End Function Public Sub ToggleMasterGuessArrayVisible() MasterGuessArrayVisible = Not MasterGuessArrayVisible End Sub Public Function GetMasterGuessArrayVisible() As Boolean GetMasterGuessArrayVisible = MasterGuessArrayVisible End Function

FRONT END:

Option Explicit 'API DECLARATIONS Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare PtrSafe Function MonitorFromWindow Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal DWORD As LongPtr) As LongPtr Private Declare PtrSafe Function GetMonitorInfoA Lib "user32.dll" (ByVal hMonitor As LongPtr, ByRef lpmi As MONITORINFOEX) As Boolean 'STRUCTS Private Type RECT X1 As Long Y1 As Long X2 As Long Y2 As Long End Type Private Type MONITORINFOEX cbSize As Long rcMonitor As RECT rcWork As RECT dwFlags As Long End Type Private Type MONITORRESOLUTION x As Long Y As Long End Type 'GLOBALS Private Const MONITOR_DEFAULTTONEAREST = 2 'GAME LOOP INITIATE Private Sub UserForm_Activate() MasterMind.GameLoop Me End Sub 'RESIZE Public Sub Resize() Dim hwnd As LongPtr Dim monitorHwnd As LongPtr Dim returnValue As Boolean Dim monitorInfo As MONITORINFOEX Dim rcMonitorRec As RECT Dim monitorRes As MONITORRESOLUTION hwnd = FindWindow("ThunderDFrame", Me.Caption) monitorHwnd = MonitorFromWindow(hwnd, MONITOR_DEFAULTTONEAREST) monitorInfo.cbSize = LenB(monitorInfo) returnValue = GetMonitorInfoA(monitorHwnd, monitorInfo) rcMonitorRec = monitorInfo.rcMonitor monitorRes.x = rcMonitorRec.X2 - rcMonitorRec.X1 monitorRes.Y = rcMonitorRec.Y2 - rcMonitorRec.Y1 Me.Height = (monitorRes.Y - (monitorRes.Y * 0.3955)) End Sub 'GUESS Private Sub GuessButton_Click() Guess End Sub Private Sub Guess() Dim Request As RequestCheckGuess Dim Response As ResponseCheckGuess Request = AssembleRequest Response = MasterMind.GetCheckGuess(Request) MatchControlsFill Response.GuessNumber, Response.ResponsePegs.MatchesComplete, Response.ResponsePegs.MatchesColor HandleResponseGameOver Response End Sub Private Function AssembleRequest() As RequestCheckGuess AssembleRequest.GuessArray.ColorOne = Me.Controls.Item("A" & MasterMind.GetCurrentGuessNumber).BackColor AssembleRequest.GuessArray.ColorTwo = Me.Controls.Item("B" & MasterMind.GetCurrentGuessNumber).BackColor AssembleRequest.GuessArray.ColorThree = Me.Controls.Item("C" & MasterMind.GetCurrentGuessNumber).BackColor AssembleRequest.GuessArray.ColorFour = Me.Controls.Item("D" & MasterMind.GetCurrentGuessNumber).BackColor End Function Private Sub MatchControlsFill(ByRef Row As Long, ByRef MatchesComplete As Long, ByRef MatchesColor As Long) If MatchesComplete > 0 Then MatchesComplete = MatchesComplete - 1 Me.Controls("Match_A" & Row).BackColor = 0 ElseIf MatchesColor > 0 Then MatchesColor = MatchesColor - 1 Me.Controls("Match_A" & Row).BackColor = 16777215 End If If MatchesComplete > 0 Then MatchesComplete = MatchesComplete - 1 Me.Controls("Match_B" & Row).BackColor = 0 ElseIf MatchesColor > 0 Then MatchesColor = MatchesColor - 1 Me.Controls("Match_B" & Row).BackColor = 16777215 End If If MatchesComplete > 0 Then MatchesComplete = MatchesComplete - 1 Me.Controls("Match_C" & Row).BackColor = 0 ElseIf MatchesColor > 0 Then MatchesColor = MatchesColor - 1 Me.Controls("Match_C" & Row).BackColor = 16777215 End If If MatchesComplete > 0 Then MatchesComplete = MatchesComplete - 1 Me.Controls("Match_D" & Row).BackColor = 0 ElseIf MatchesColor > 0 Then MatchesColor = MatchesColor - 1 Me.Controls("Match_D" & Row).BackColor = 16777215 End If End Sub Private Sub HandleResponseGameOver(ByRef Response As ResponseCheckGuess) If Response.GameOver.TrueFalse = True Then UnhideMasterGuessArray MsgBox Response.GameOver.Reason Me.Hide Exit Sub ElseIf Response.GuessValid.TrueFalse = False Then MsgBox Response.GuessValid.Reason Exit Sub End If End Sub 'BUTTON COLOR ROTATION Private Sub A0_Click() RotateColor "A", 0, Me.A0.BackColor End Sub Private Sub B0_Click() RotateColor "B", 0, Me.B0.BackColor End Sub Private Sub C0_Click() RotateColor "C", 0, Me.C0.BackColor End Sub Private Sub D0_Click() RotateColor "D", 0, Me.D0.BackColor End Sub Private Sub A1_Click() RotateColor "A", 1, Me.A1.BackColor End Sub Private Sub B1_Click() RotateColor "B", 1, Me.B1.BackColor End Sub Private Sub C1_Click() RotateColor "C", 1, Me.C1.BackColor End Sub Private Sub D1_Click() RotateColor "D", 1, Me.D1.BackColor End Sub Private Sub A2_Click() RotateColor "A", 2, Me.A2.BackColor End Sub Private Sub B2_Click() RotateColor "B", 2, Me.B2.BackColor End Sub Private Sub C2_Click() RotateColor "C", 2, Me.C2.BackColor End Sub Private Sub D2_Click() RotateColor "D", 2, Me.D2.BackColor End Sub Private Sub A3_Click() RotateColor "A", 3, Me.A3.BackColor End Sub Private Sub B3_Click() RotateColor "B", 3, Me.B3.BackColor End Sub Private Sub C3_Click() RotateColor "C", 3, Me.C3.BackColor End Sub Private Sub D3_Click() RotateColor "D", 3, Me.D3.BackColor End Sub Private Sub A4_Click() RotateColor "A", 4, Me.A4.BackColor End Sub Private Sub B4_Click() RotateColor "B", 4, Me.B4.BackColor End Sub Private Sub C4_Click() RotateColor "C", 4, Me.C4.BackColor End Sub Private Sub D4_Click() RotateColor "D", 4, Me.D4.BackColor End Sub Private Sub A5_Click() RotateColor "A", 5, Me.A5.BackColor End Sub Private Sub B5_Click() RotateColor "B", 5, Me.B5.BackColor End Sub Private Sub C5_Click() RotateColor "C", 5, Me.C5.BackColor End Sub Private Sub D5_Click() RotateColor "D", 5, Me.D5.BackColor End Sub Private Sub A6_Click() RotateColor "A", 6, Me.A6.BackColor End Sub Private Sub B6_Click() RotateColor "B", 6, Me.B6.BackColor End Sub Private Sub C6_Click() RotateColor "C", 6, Me.C6.BackColor End Sub Private Sub D6_Click() RotateColor "D", 6, Me.D6.BackColor End Sub Private Sub A7_Click() RotateColor "A", 7, Me.A7.BackColor End Sub Private Sub B7_Click() RotateColor "B", 7, Me.B7.BackColor End Sub Private Sub C7_Click() RotateColor "C", 7, Me.C7.BackColor End Sub Private Sub D7_Click() RotateColor "D", 7, Me.D7.BackColor End Sub Private Sub A8_Click() RotateColor "A", 8, Me.A8.BackColor End Sub Private Sub B8_Click() RotateColor "B", 8, Me.B8.BackColor End Sub Private Sub C8_Click() RotateColor "C", 8, Me.C8.BackColor End Sub Private Sub D8_Click() RotateColor "D", 8, Me.D8.BackColor End Sub Private Sub A9_Click() RotateColor "A", 9, Me.A9.BackColor End Sub Private Sub B9_Click() RotateColor "B", 9, Me.B9.BackColor End Sub Private Sub C9_Click() RotateColor "C", 9, Me.C9.BackColor End Sub Private Sub D9_Click() RotateColor "D", 9, Me.D9.BackColor End Sub Private Sub RotateColor(ByRef Letter As String, ByRef Row As Long, ByRef color As GamePieceColor) Dim Request As RequestNextColor Dim Response As ResponseNextColor Request.CurrentColor = color Response = MasterMind.GetNextColor(Request) If Response.GuessNumber = Row Then Me.Controls(Letter & Row).BackColor = Response.NextColor Me.Controls(Letter & Row).Caption = ButtonCaption(Response.NextColor) Me.Controls(Letter & Row).ForeColor = ButtonFontColor(Response.NextColor) End If End Sub Private Function ButtonCaption(ByRef color As GamePieceColor) As String Select Case color Case rgbBlack ButtonCaption = "Black" Case rgbBlue ButtonCaption = "Blue" Case rgbGreen ButtonCaption = "Green" Case rgbRed ButtonCaption = "Red" Case rgbWhite ButtonCaption = "White" Case rgbYellow ButtonCaption = "Yellow" End Select End Function Private Function ButtonFontColor(ByRef color As GamePieceColor) As GamePieceColor Select Case color Case rgbBlack ButtonFontColor = rgbWhite Case rgbBlue ButtonFontColor = rgbWhite Case rgbGreen ButtonFontColor = rgbBlack Case rgbRed ButtonFontColor = rgbBlack Case rgbWhite ButtonFontColor = rgbBlack Case rgbYellow ButtonFontColor = rgbBlack End Select End Function 'SHOW ANSWER Private Sub UnhideButton_Click() If MasterMind.GetMasterGuessArrayVisible = True Then HideMasterGuessArray Me.UnhideButton.Caption = "UNHIDE" MasterMind.ToggleMasterGuessArrayVisible Else UnhideMasterGuessArray Me.UnhideButton.Caption = "HIDE" MasterMind.ToggleMasterGuessArrayVisible End If End Sub Private Sub UnhideMasterGuessArray() Dim MasterGuessArray As GuessArray MasterGuessArray = MasterMind.GetMasterRow Me.Master1.BackColor = MasterGuessArray.ColorOne Me.Master1.Caption = MasterButtonCaption(MasterGuessArray.ColorOne) Me.Master1.ForeColor = MasterButtonFontColor(MasterGuessArray.ColorOne) Me.Master2.BackColor = MasterGuessArray.ColorTwo Me.Master2.Caption = MasterButtonCaption(MasterGuessArray.ColorTwo) Me.Master2.ForeColor = MasterButtonFontColor(MasterGuessArray.ColorTwo) Me.Master3.BackColor = MasterGuessArray.ColorThree Me.Master3.Caption = MasterButtonCaption(MasterGuessArray.ColorThree) Me.Master3.ForeColor = MasterButtonFontColor(MasterGuessArray.ColorThree) Me.Master4.BackColor = MasterGuessArray.ColorFour Me.Master4.Caption = MasterButtonCaption(MasterGuessArray.ColorFour) Me.Master4.ForeColor = MasterButtonFontColor(MasterGuessArray.ColorFour) End Sub Private Function MasterButtonCaption(ByRef color As GamePieceColor) As String Select Case color Case rgbBlack MasterButtonCaption = "Black" Case rgbBlue MasterButtonCaption = "Blue" Case rgbGreen MasterButtonCaption = "Green" Case rgbRed MasterButtonCaption = "Red" Case rgbWhite MasterButtonCaption = "White" Case rgbYellow MasterButtonCaption = "Yellow" End Select End Function Private Function MasterButtonFontColor(ByRef color As GamePieceColor) As GamePieceColor Select Case color Case rgbBlack MasterButtonFontColor = rgbWhite Case rgbBlue MasterButtonFontColor = rgbWhite Case rgbGreen MasterButtonFontColor = rgbBlack Case rgbRed MasterButtonFontColor = rgbBlack Case rgbWhite MasterButtonFontColor = rgbBlack Case rgbYellow MasterButtonFontColor = rgbBlack End Select End Function Private Sub HideMasterGuessArray() Dim MasterGuessArray As GuessArray MasterGuessArray = MasterMind.GetMasterRow Me.Master1.BackColor = GamePieceColor.rgbLightGrey Me.Master2.BackColor = GamePieceColor.rgbLightGrey Me.Master3.BackColor = GamePieceColor.rgbLightGrey Me.Master4.BackColor = GamePieceColor.rgbLightGrey Me.Master1.ForeColor = rgbBlack Me.Master2.ForeColor = rgbBlack Me.Master3.ForeColor = rgbBlack Me.Master4.ForeColor = rgbBlack Me.Master1.Caption = "??" Me.Master2.Caption = "??" Me.Master3.Caption = "??" Me.Master4.Caption = "??" End Sub

DETERMINE MATCHES FIXED UP:

Private Function DetermineMatches(ByRef GuessArray As GuessArray) As ResponsePegs Dim TempMasterGuessArray As GuessArray Dim StartGuessArray As LongPtr Dim ColorGuessArray As GamePieceColor Dim StartTempMasterGuessArray As LongPtr Dim ColorTempMasterGuessArray As GamePieceColor Dim NullGamePieceColor As GamePieceColor Dim OffSetI As Long Dim OffsetII As Long NullGamePieceColor = rgbNone StartGuessArray = VarPtr(GuessArray) StartTempMasterGuessArray = VarPtr(TempMasterGuessArray) TempMasterGuessArray = MasterGuessArray For OffSetI = 0 To 12 Step 4 CopyMemoryI VarPtr(ColorGuessArray), StartGuessArray + OffSetI, 4 CopyMemoryI VarPtr(ColorTempMasterGuessArray), StartTempMasterGuessArray + OffSetI, 4 If ColorGuessArray = ColorTempMasterGuessArray Then CopyMemoryI StartGuessArray + OffSetI, VarPtr(NullGamePieceColor), 4 CopyMemoryI StartTempMasterGuessArray + OffSetI, VarPtr(NullGamePieceColor), 4 DetermineMatches.MatchesComplete = DetermineMatches.MatchesComplete + 1 End If Next OffSetI For OffSetI = 0 To 12 Step 4 CopyMemoryI VarPtr(ColorGuessArray), StartGuessArray + OffSetI, 4 If ColorGuessArray <> rgbNone Then For OffsetII = 0 To 12 Step 4 CopyMemoryI VarPtr(ColorTempMasterGuessArray), StartTempMasterGuessArray + OffsetII, 4 If ColorGuessArray = ColorTempMasterGuessArray Then CopyMemoryI StartGuessArray + OffSetI, VarPtr(NullGamePieceColor), 4 CopyMemoryI StartTempMasterGuessArray + OffsetII, VarPtr(NullGamePieceColor), 4 DetermineMatches.MatchesColor = DetermineMatches.MatchesColor + 1 Exit For End If Next OffsetII End If Next OffSetI End Function

NEW SELECT RANDOM COLOR FUNCTION:

Private Function RandomColor() As GamePieceColor Dim RandomNumber As Long RandomNumber = Int(Rnd * 5) Select Case RandomNumber Case 0 RandomColor = rgbBlack Case 1 RandomColor = rgbBlue Case 2 RandomColor = rgbGreen Case 3 RandomColor = rgbRed Case 4 RandomColor = rgbWhite Case 5 RandomColor = rgbYellow End Select End Function
\$\endgroup\$
2
  • 1
    \$\begingroup\$ Very nice! I love the game. I can see that you have been working hard at improving your coding skills and it is definitely paying off!! \$\endgroup\$ Commented Jun 20, 2019 at 21:05
  • \$\begingroup\$ @TinMan appreciate the support, this has been very fun! see the new determine matches functions in OP. I am putting up a website - bird photos, job stuff and excel posts. I will link to you when set up!!! It looks SICK :-p \$\endgroup\$ Commented Jun 28, 2019 at 17:17

1 Answer 1

Reset to default
2
\$\begingroup\$

The most obvious thing to me is the repetition in the code. I think that addressing the repetition, you can make this game scalable (change the number of guesses, change the number of pegs, change the number of colours).

Public Type GuessArray ColorOne As GamePieceColor ColorTwo As GamePieceColor ColorThree As GamePieceColor ColorFour As GamePieceColor End Type

becomes

Public Type GuessArray Color(MaxPegs-1) As GamePieceColor End Type

Private Function DetermineMatches(ByRef GuessArray As GuessArray) As ResponsePegs is screaming out to be made not repetitive!

At this stage, I would consider the use of Classes instead of Types because of inherent flexibility within VBA. This requires an understanding of the objects in the game. The game consists of a Board, which holds both the MasterAnswer, and the Moves; where each move consists of a Guess [GuessArrays which are individually coloured Pegs], and the Result. Looking at the code, you already have some good bones to work with.

In removing repetition and improving both scability and maintainability, you would have to learn how to create arrays of controls in VBA Forms. For example Private Sub D9_Click() would be replaced by a function that looks a little more complicated, but only once instead of 36 times. Two websites (working as of today, cannot guarantee that they will not break in the future) that describe how to create a control array are http://www.siddharthrout.com/index.php/2018/01/15/vba-control-arrays/ or https://bettersolutions.com/excel/macros/vba-control-arrays.htm - Just search "VBA Control Array" in your favourite search engine.

HideMasterGuessArray and UnhideMasterGuessArray could be collapsed into a single sub:

Sub RevealMasterGuessArray(MasterGuessArrayVisible As Boolean)

I am not sure why ButtonColour and ButtonCaption codes are not aligned - one set of Select gives the corresponding assignment, the other gives a black/white assignment with no comment on how this apparently arbitrary assignment has been created.

Why use Excel?

As a final note: The only Excel function I could see in your code was RandomNumber = Application.WorksheetFunction.RandBetween(0, 5), which could be replaced with VBA's Rnd() function (see: https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/rnd-function).

As such, Excel is not essential to your game, it is just a convenient coding platform. If possible, I would recommend you move to Visual Studio (even the free Community version) which will allow you to use VB.NET.

VB.Net is a different language than VBA, but is also similar in so many ways, so your current logic doesn't require much work to change over. Some of the advantages:

  • Better handling of custom controls and assigning handlers to arrays of controls meaning less repetition and better scalability.
  • The ability to create a stand-alone program
  • Better functionality and handling of Types, but I still prefer Classes!
  • Better range of Collection-like classes that give more flexibility on creating a collection of general items (like Moves or controls that present Moves).
  • Better alignment with Object-Oriented-Programming, so inheritance and implementation are more flexible.
  • You will still practice the same coding principles, so your current learning path will continue with greater flexibility.

There are times when using Excel (or Word or MS-Access) are great foundations for creating programs. I think, in this case, you have out-grown Excel. I originally did a MasterMind-type program (analysis, not a Game) in Visual Studio so I could learn about saving information in XML files!

\$\endgroup\$
2
  • \$\begingroup\$ Realized that determining matches can be done with use of pointers and copymemory - whole reason I did this procedurally was to get a c++ like experience. Time to really do the heavy lifting ! \$\endgroup\$ Commented Jun 27, 2019 at 21:46
  • \$\begingroup\$ Fixed up determine matches function and swapped application.worksheetfunction.rndbetween for RND (see additions to OP) Next up - creating the array of controls. Thanks again. \$\endgroup\$ Commented Jun 28, 2019 at 17:14

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.