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
Improve this question
\$\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\$
    – TinMan
    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\$
    – learnAsWeGo
    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!

Improve this answer
\$\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\$
    – learnAsWeGo
    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\$
    – learnAsWeGo
    Jun 28, 2019 at 17:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.