OfficeTips Home || VBA Section || General Section ||  Download Section  ||  Privacy Policy

Game of Concentration

An example using VBA to create the concentration game in PowerPoint.

Version Supported

PowerPoint 97  or later.

Download

Click here (zip)

How to use:

1. Extract the contents of the zip to a folder.
2. Double-click 'Concentrate.ppt'.

3. Enable the macro when prompted.

4. Run the slideshow and play the game.
5. Click on Reset to restart the game

 

Note: If you are unable to run the code check your macro security setting.

 

   

 

 

 

   
Setup The shapes have been setup in a distinct manner to make this work:
  1. The first shape on the slide is the image which will be hidden under all the shapes.
  2. The images are then inserted to create the grid of shapes which cover the main image. Make sure that you insert each image twice to form the pair. Now rename each of the images such that each pair set has the names in ascending value.
    e.g.
    Name the 1st image shape 'Pict 1' and it's corresponding matching shape as 'Pict 2'.
    Name the 2nd image shape 'Pict 3' and it's corresponding matching shape as 'Pict 4. and so on. This naming convention will help us match the pairs during the game.
  3. After all the images have been named, create another layer of shapes which will cover these images.
  4. Assign each of the shapes in this new layer an action setting to run the ButtonClick macro.
  5. Now create 5 additional shapes.
  • Reset shape and assign it an action setting to run the 'Reset' macro.
  • End show shape and assign it an action setting to 'End show'.
  • A shape to display Player 1's score. Name the shape 'Player1'.
  • A shape to display Player 2's score. Name the shape 'Player2'.
  • A shape to display who's turn it is to play. Name the shape 'PlayerTurn'.

 

Code snippet
Option Explicit

'--------------------------------------------------------

' Copyright  Shyam Pillai. All rights reserved.

' http://skp.mvps.org/

'--------------------------------------------------------
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Const IMAGE_BLOCKS = 16          ' Using 8 images so twice that number is the number of images blocks.

Const IMAGE_BLOCKS_OFFSET = 1    ' We have an underlying image hence the offet is 1 else 0.

' Cheat: To see the underlying image, set this to a value between >0 and <= 1 (PPT 2002+ only).

Const LEARNING_MODE_TRANSPARENCY = 0# 
Sub Reset(oShp As Shape)
On Error Resume Next

Dim I As Integer

Dim oShapeA As Shape

Dim oShapeB As Shape

Dim oCol As Variant
' Create a collection of random numbers based on the starting 

' Index position of the image blocks. (See code in the PPT)

oCol = RandomNumbers(IMAGE_BLOCKS + IMAGE_BLOCKS_OFFSET, 1 + _

                                  IMAGE_BLOCKS_OFFSET, IMAGE_BLOCKS, True)
' Clear existing names on the shapes which cover the grid images because we will name them 

' based on the shape below it. 

For I = IMAGE_BLOCKS + 1 + IMAGE_BLOCKS_OFFSET To (IMAGE_BLOCKS * 2) + IMAGE_BLOCKS_OFFSET

    oShp.Parent.Shapes(I).Name = "oShape" & I

Next I
' Place the image blocks at the new positions obtained after randomizing.

For I = LBound(oCol) To UBound(oCol)

    Set oShapeA = oShp.Parent.Shapes(oCol(I))

    Set oShapeB = oShp.Parent.Shapes(I + 17 + IMAGE_BLOCKS_OFFSET)

    With oShapeA

        .Left = oShapeB.Left

        .Top = oShapeB.Top
 
' Name the shape which is covering the image block such that we can ascertain 

' the shape below it when it is clicked upon. 

' If the image shape has the name 'Pict 5' then the shape covering it will get the name 'Pict 5~5'



        oShapeB.Name = .Name & "~" & Val(Mid(.Name, InStr(1, .Name, " ") + 1))

        oShapeB.Fill.Transparency = LEARNING_MODE_TRANSPARENCY

        oShapeB.Visible = True

        .Visible = True

    End With

Next I


'Reset the scorecard

Call ButtonClick

oShp.Parent.Shapes("Player1").TextFrame.TextRange = "0"

oShp.Parent.Shapes("Player2").TextFrame.TextRange = "0"

oShp.Parent.Shapes("PlayerTurn").TextFrame.TextRange = "Turn: Player 1"

End Sub
Sub ButtonClick(Optional oShp As Shape)

On Error Resume Next

    Static LastShape As Shape

    Static PlayerTwo As Boolean

    Static SecondCard As Boolean
    Dim iVal1 As Integer, iVal2 As Integer
    If oShp Is Nothing Then GoTo Reset

    If oShp.Fill.Transparency = 1 Then Exit Sub

    If Not SecondCard Then

        SecondCard = True

        Set LastShape = oShp

        oShp.Fill.Transparency = 0.9 'Make the shape that is clicked upon transparent.

        Exit Sub

    End If

    oShp.Fill.Transparency = 0.9 'Make the shape that is clicked upon transparent.

    DoEvents
'From the names of the shapes ascertain if it is a matched pair.
    iVal1 = Val(Mid(LastShape.Name, InStr(1, LastShape.Name, "~") + 1))

    iVal2 = Val(Mid(oShp.Name, InStr(1, oShp.Name, "~") + 1))
    Call Sleep(300) 'Hold the transparent state for a few moments. 
 
' e.g. iVal1 = 4 and iVal2 = 3 will mean that it is a matched pair. since iVal1 - 1 = 3 = iVal2

' Since they match; hide that pair else cover them up again and pass the turn to the next player.
    If iVal1 Mod 2 = 0 Then

        If iVal1 - 1 = iVal2 Then

            oShp.Visible = False

            LastShape.Visible = False

            oShp.Parent.Shapes(Mid(oShp.Name, 1, InStr(1, oShp.Name, "~") - 1)).Visible = False

            oShp.Parent.Shapes(Mid(LastShape.Name, 1, InStr(1, LastShape.Name, "~") - 1)).Visible = False

            If PlayerTwo Then

                With oShp.Parent.Shapes("Player2").TextFrame

                    .TextRange = Val(.TextRange) + 1

                End With

            Else

                With oShp.Parent.Shapes("Player1").TextFrame

                    .TextRange = Val(.TextRange) + 1

                End With

            End If

        Else

            PlayerTwo = Not PlayerTwo

        End If

    Else

        If iVal1 + 1 = iVal2 Then

            oShp.Visible = False

            LastShape.Visible = False

            oShp.Parent.Shapes(Mid(oShp.Name, 1, InStr(1, oShp.Name, "~") - 1)).Visible = False

            oShp.Parent.Shapes(Mid(LastShape.Name, 1, InStr(1, LastShape.Name, "~") - 1)).Visible = False

            If PlayerTwo Then

                With oShp.Parent.Shapes("Player2").TextFrame

                    .TextRange = Val(.TextRange) + 1

                End With

            Else

                With oShp.Parent.Shapes("Player1").TextFrame

                    .TextRange = Val(.TextRange) + 1

                End With

            End If

        Else

            PlayerTwo = Not PlayerTwo

        End If

    End If
    oShp.Fill.Transparency = LEARNING_MODE_TRANSPARENCY

    LastShape.Fill.Transparency = LEARNING_MODE_TRANSPARENCY
 
' Put up the message to indicate whose turn it is.
    If PlayerTwo Then

        oShp.Parent.Shapes("PlayerTurn").TextFrame.TextRange.Text = "Turn: Player 2"

    Else

        oShp.Parent.Shapes("PlayerTurn").TextFrame.TextRange.Text = "Turn: Player 1"

    End If
' Keep a track of the score to ascertain if all cards are exposed.
    With oShp.Parent



        If Val(.Shapes("Player1").TextFrame.TextRange) _

			+ Val(.Shapes("Player2").TextFrame.TextRange) > 0 Then



            If IMAGE_BLOCKS / (Val(.Shapes("Player1").TextFrame.TextRange) _

                         + Val(.Shapes("Player2").TextFrame.TextRange)) = 2 Then



                Select Case Val(.Shapes("Player1").TextFrame.TextRange)

                Case Is = Val(.Shapes("Player2").TextFrame.TextRange)

                    MsgBox "Game over. The scores are tied.", vbInformation, "Concentration"

                Case Is < Val(.Shapes("Player2").TextFrame.TextRange)

                    MsgBox "Game over. Player 2 is the winner!", vbInformation, "Concentration"

                Case Is > Val(.Shapes("Player2").TextFrame.TextRange)

                    MsgBox "Game over. Player 1 is the winner!", vbInformation, "Concentration"

                End Select



            End If

        End If



    End With
Reset:

    Set LastShape = Nothing

    SecondCard = False

End Sub
 
 

Copyright 1999-2022 (c) Shyam Pillai. All rights reserved.