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-2014 (c) Shyam Pillai. All rights reserved.