by Sourabh Wathodkar (3 Submissions)
Category: Games
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 5th May 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
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