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