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