The   game of Pig   is a multiplayer game played with a single six-sided die.   The
object of the game is to reach   100   points or more.  
Play is taken in turns.   On each person's turn that person has the option of either:

 Rolling the dice:   where a roll of two to six is added to their score for that turn and the player's turn continues as the player is given the same choice again;   or a roll of   1   loses the player's total points   for that turn   and their turn finishes with play passing to the next player.
 Holding:   the player's score for that round is added to their total and becomes safe from the effects of throwing a   1   (one).   The player's turn finishes with play passing to the next player.


Task

Create a program to score for, and simulate dice throws for, a two-person game.



Related task

   Pig the dice game/Player


 
Option Explicit
 
Sub Main_Pig()
Dim Scs() As Byte, Ask As Integer, Np As Boolean, Go As Boolean
Dim Cp As Byte, Rd As Byte, NbP As Byte, ScBT As Byte
    'You can adapt these Const, but don't touch the "¤¤¤¤"
    Const INPTXT As String = "Enter number of players : "
    Const INPTITL As String = "Numeric only"
    Const ROL As String = "Player ¤¤¤¤ rolls the die."
    Const MSG As String = "Do you want to ""hold"" : "
    Const TITL As String = "Total if you keep : "
    Const RES As String = "The die give you : ¤¤¤¤ points."
    Const ONE As String = "The die give you : 1 point. Sorry!" & vbCrLf & "Next player."
    Const WIN As String = "Player ¤¤¤¤ win the Pig Dice Game!"
    Const STW As Byte = 100
 
    Randomize Timer
    NbP = Application.InputBox(INPTXT, INPTITL, 2, Type:=1)
    ReDim Scs(1 To NbP)
    Cp = 1
    Do
        ScBT = 0
        Do
            MsgBox Replace(ROL, "¤¤¤¤", Cp)
            Rd = Int((Rnd * 6) + 1)
            If Rd > 1 Then
                MsgBox Replace(RES, "¤¤¤¤", Rd)
                ScBT = ScBT + Rd
                If Scs(Cp) + ScBT >= STW Then
                    Go = True
                    Exit Do
                End If
                Ask = MsgBox(MSG & ScBT, vbYesNo, TITL & Scs(Cp) + ScBT)
                If Ask = vbYes Then
                    Scs(Cp) = Scs(Cp) + ScBT
                    Np = True
                End If
            Else
                MsgBox ONE
                Np = True
            End If
        Loop Until Np
        If Not Go Then
            Np = False
            Cp = Cp + 1
            If Cp > NbP Then Cp = 1
        End If
    Loop Until Go
    MsgBox Replace(WIN, "¤¤¤¤", Cp)
End Sub
 