• Home
 · 
• Games
 · 
• Memory Game -- This is a test of your memory power.

Memory Game -- This is a test of your memory power.

Memory Game -- This is a test of your memory power.

API Declarations


'First put an array of Label1(36) Remember your index should start 'from 1 i.e. 1 to 36 set the default caption to "X" of all the 36 controls
'mail me if u have any problem
'Then put 4 more labels change its name Poperty to 'P1,P2,lblScore1,lblScore2
'Put 2 Shape Controls Shape1,Shape2
Dim Cap1(18) As String 'For Storing The Caption Values Of Labels
Dim Cap2(18) As String 'For Storing The Caption Values Of Labels
Dim CapVal, CapName As String
Dim PS As Boolean
Dim SA, UR, ABH, P, N, M As Integer
Dim Cnt, IndVal1, IndVal2, Score1, Score2 As Integer
Dim Player1, Player2 As String




Rate Memory Game -- This is a test of your memory power.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    FormatNewGame
End Sub

Private Sub Form_Load()
On Error GoTo errhandle
    Me.Top = 600
    Me.Left = 1860
    'SetTopMostWindow Me.hwnd, True
    'FormatNewGame       'Used to start a new game
    Exit Sub
errhandle:
    MsgBox Err.Description, vbOKOnly, "MEMORY"
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim I, Down, Across
    'WindowState = 2     'Maximize the Form
    DrawWidth = 4       'Increase the Draw Point Size
    For I = 1 To 16000  'Length of Function
        Down = Down + 1     'Speed of downwards increase
        Across = Across + 1 'Speed of sideways increase
        PSet (Rnd * Across, Rnd * Down), QBColor(Rnd * 15) 'Draw the Points
    Next I              'Do it all again

End Sub

Private Sub Label1_Click(Index As Integer)
    If Label1(Index).Caption = CapName Then
    
        Select Case Index
        
        Case 1
                Check (Index)
        Case 2
                Check (Index)
        Case 3
                Check (Index)
        Case 4
                Check (Index)
        Case 5
                Check (Index)
        Case 6
                Check (Index)
        Case 7
                Check (Index)
        Case 8
                Check (Index)
        Case 9
                Check (Index)
        Case 10
                Check (Index)
        Case 11
                Check (Index)
        Case 12
                Check (Index)
        Case 13
                Check (Index)
        Case 14
                Check (Index)
        Case 15
                Check (Index)
        Case 16
                Check (Index)
        Case 17
                Check (Index)
        Case 18
                Check (Index)
        Case 19
                Check1 (Index)
        Case 20
                Check1 (Index)
        Case 21
                Check1 (Index)
        Case 22
                Check1 (Index)
        Case 23
                Check1 (Index)
        Case 24
                Check1 (Index)
        Case 25
                Check1 (Index)
        Case 26
                Check1 (Index)
        Case 27
                Check1 (Index)
        Case 28
                Check1 (Index)
        Case 29
                Check1 (Index)
        Case 30
                Check1 (Index)
        Case 31
                Check1 (Index)
        Case 32
                Check1 (Index)
        Case 33
                Check1 (Index)
        Case 34
                Check1 (Index)
        Case 35
                Check1 (Index)
        Case 36
                Check1 (Index)
        End Select
    End If
End Sub
Private Sub Check(indexX As Integer)
On Error GoTo errhandle
        Cnt = Cnt + 1
        If Cnt = 1 Then
                Label1(IndVal1).Caption = CapName
                Label1(IndVal2).Caption = CapName
                Label1(indexX).Caption = Cap1(indexX)
                CapVal = Label1(indexX).Caption
                IndVal1 = indexX
                If Shape1.Visible = True Then
                    Shape2.Visible = False
                ElseIf Shape2.Visible = True Then
                    Shape1.Visible = False
                End If
        ElseIf Cnt = 2 Then
            
                Label1(indexX).Caption = Cap1(indexX)
                If CapVal = Label1(indexX).Caption Then
                    If Shape1.Visible = True Then
                        Shape2.Visible = False
                        Score1 = Score1 + 1
                        lblScore1.Caption = Score1
                    ElseIf Shape2.Visible = True Then
                        Shape1.Visible = False
                        Score2 = Score2 + 1
                        lblScore2.Caption = Score2
                    End If
                    MsgBox "SUCESS", vbOKOnly, "MEMORY"
                    Label1(indexX).Visible = False
                    Label1(IndVal1).Visible = False
                    If (Score2 + Score1) >= 18 Then
                        If Score1 > Score2 Then
                            If MsgBox("Congrats Player 1 ! Do You Wish To Continue ?", vbYesNo + vbExclamation, "MEMORY") = vbYes Then
                                FormatNewGame
                                Exit Sub
                            Else
                                End
                            End If
                        ElseIf Score2 > Score1 Then
                            If MsgBox("Congrats Player 2 ! Do You Wish To Continue ?", vbYesNo + vbExclamation, "MEMORY") = vbYes Then
                                FormatNewGame
                                Exit Sub
                            Else
                                End
                            End If
                        ElseIf Score1 = Score2 Then
                            If MsgBox("Draw ! Do You Wish To Continue ?", vbYesNo + vbExclamation, "MEMORY") = vbYes Then
                                FormatNewGame
                                Exit Sub
                            Else
                                End
                            End If
                        End If
                    End If
                Else
                    If Shape1.Visible = True Then
                        Shape2.Visible = True
                        Shape1.Visible = False
                    ElseIf Shape2.Visible = True Then
                        Shape1.Visible = True
                        Shape2.Visible = False
                    End If
                    IndVal2 = indexX
                
                End If
            Cnt = 0
        End If
        Exit Sub
errhandle:
    MsgBox Err.Description, vbOKOnly, "MEMORY"
End Sub
Private Sub Check1(indexX As Integer)
On Error GoTo errhandle
        Cnt = Cnt + 1
        If Cnt = 1 Then
                Label1(IndVal1).Caption = CapName
                Label1(IndVal2).Caption = CapName
                Label1(indexX).Caption = Cap2(indexX - 18)
                CapVal = Label1(indexX).Caption
                IndVal1 = indexX
                If Shape1.Visible = True Then
                    Shape2.Visible = False
                ElseIf Shape2.Visible = True Then
                    Shape1.Visible = False
                End If
        ElseIf Cnt = 2 Then
                Label1(indexX).Caption = Cap2(indexX - 18)
                If CapVal = Label1(indexX).Caption Then
                    If Shape1.Visible = True Then
                        Shape2.Visible = False
                        Score1 = Score1 + 1
                        lblScore1.Caption = Score1
                    ElseIf Shape2.Visible = True Then
                        Shape1.Visible = False
                        Score2 = Score2 + 1
                        lblScore2.Caption = Score2
                    End If
                    MsgBox "SUCESS", vbOKOnly, "MEMORY"
                    Label1(indexX).Visible = False
                    Label1(IndVal1).Visible = False
                    If (Score2 + Score1) >= 18 Then
                        If Score1 > Score2 Then
                            If MsgBox("Congrats Player 1 ! Do You Wish To Continue ?", vbYesNo + vbExclamation, "MEMORY") = vbYes Then
                                FormatNewGame
                                Exit Sub
                            Else
                                End
                            End If
                        ElseIf Score2 > Score1 Then
                            If MsgBox("Congrats Player 2 ! Do You Wish To Continue ?", vbYesNo + vbExclamation, "MEMORY") = vbYes Then
                                FormatNewGame
                                Exit Sub
                            Else
                                End
                            End If
                        ElseIf Score1 = Score2 Then
                            If MsgBox("Draw ! Do You Wish To Continue ?", vbYesNo + vbExclamation, "MEMORY") = vbYes Then
                                FormatNewGame
                                Exit Sub
                            Else
                                End
                            End If
                        End If
                    End If
                Else
                    If Shape1.Visible = True Then
                        Shape2.Visible = True
                        Shape1.Visible = False
                    ElseIf Shape2.Visible = True Then
                        Shape1.Visible = True
                        Shape2.Visible = False
                    End If
                    IndVal2 = indexX
                End If
                Cnt = 0
        End If
        Exit Sub
errhandle:
    MsgBox Err.Description, vbOKOnly, "MEMORY"
End Sub
Private Sub NewGame(UpperBound As Integer, LowerBound As Integer)
    
    For N = 1 To 18
        P = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound)
        For UR = 0 To N - 1
            If Cap1(UR) = P Then
                N = N - 1
                Exit For
            Else
                Cap1(N) = P
            End If
        Next UR
    Next N
    
    For M = 1 To 18
        SA = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound)
        For ABH = 0 To M - 1
            If Cap2(ABH) = SA Then
                M = M - 1
                Exit For
            Else
                Cap2(M) = SA
            End If
        Next ABH
    Next M
    Cnt = 0
    IndVal1 = 1
    IndVal2 = 1
    Score1 = 0
    Score2 = 0
    Shape2.Visible = False
    Shape1.Visible = True
    PlayerName
    lblScore1.Caption = Score1
    lblScore2.Caption = Score2
End Sub
Private Sub mnuNewGame_Click()
    FormatNewGame
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub FormatNewGame()
    Dim L, K As Integer
    Randomize
    L = Int((5 * Rnd) + 1)
    Select Case L
    Case 1
        CapName = "*"
        Call NewGame(19, 38)
    Case 2
        CapName = "#"
        Call NewGame(1, 20)
    Case 3
        CapName = "!"
        Call NewGame(65, 84)
    Case 4
        CapName = "X"
        Call NewGame(50, 69)
    Case 5
        CapName = "$"
        Call NewGame(35, 54)
    End Select
    For K = 1 To 36
        Label1(K).Visible = True
        Label1(K).Caption = CapName
    Next K
End Sub

Private Sub PlayerName()
    Player1 = "Player1"
    Player2 = "Player2"
    Player1 = InputBox("Please Enter The Name Of First Player", "MEMORY", "Player1")
    Player2 = InputBox("Please Enter The Name Of Second Player", "MEMORY", "Player2")
    If Trim(Player1) <> "" Then
        P1.Caption = Player1
    Else
        P1.Caption = "Player1"
    End If
    If Trim(Player2) <> "" Then
        P2.Caption = Player2
    Else
        P2.Caption = "Player2"
    End If
End Sub