The Nametag Game
When I took my 3 year old son for the first day of preschool, there was a table with several nametags for the students. I asked him if he knew which one was his, and he correctly pointed out the right one.
Below is sample code in Fox and VB.net that is a game that I wrote for him.
It shows “Tyler” and other random words on the form, and the user has to try to click on his own name. Each successful hit is counted, the words are reshuffled, and a timer counts down to see how many can be done in a given interval.
The program uses buttons to show the words and IntersectRect to determine if a word is on top of another.
Simple enhancement ideas (some from my daughter):
Increase the number of buttons or decrease their size as time runs out
Use phrases rather than random words as a memorization aid
To get the dictionary, see: A Discounter Introduces Reductions: Multiple Anagrams
See also Create your own typing tutor!
#define nObjs 5
#define cNAME "TYLER"
#define NWIDTH 150
#define NHEIGHT 70
#define NSECONDS 30
#define MAXWORDLENGTH 10
PUBLIC oForm
oForm=CREATEOBJECT("MyForm")
DEFINE CLASS MyForm AS Form
AllowOutput=.f.
ShowWindow=2 && Desktop
Windowstate=2
Left=60
Width=1000
Height=800
DIMENSION aObjs[nObjs]
DIMENSION aWords[nObjs]
oDict=0
nScore=0
nSecondsLeft=NSECONDS
nIterations = 0
ADD OBJECT txt as textbox WITH top=-50
ADD OBJECT tmr as timer WITH interval=1000
PROCEDURE Init
DECLARE integer IntersectRect IN WIN32API string @, string, string
LOCAL oDict as dictionary.dict
* RAND(1)
this.oDict=CREATEOBJECT("dictionary.dict")
this.oDict.DictNum=2
this.oDict.RandWord(1)
this.aWords[1]=cName
FOR i = 1 TO nObjs
this.AddObject("this.aObjs["+TRANSFORM(i)+"]","MyBtn")
* this.aObjs[i]=CREATEOBJECT("MyBtn")
WITH this.aObjs[i] as CommandButton
* .Caption=this.aWords[i]
.Visible=1
ENDWITH
ENDFOR
this.Shuffle
this.Show
PROCEDURE Shuffle
FOR i = 2 TO nObjs
cWord=UPPER(this.oDict.RandWord(0))
DO WHILE LEN(cWord) > MAXWORDLENGTH
cWord=UPPER(this.oDict.RandWord(0))
ENDDO
this.aWords[i] = cWord
ENDFOR
FOR i = 1 TO nObjs
WITH this.aObjs[i] as CommandButton
.caption= UPPER(this.aWords[i]) && +" "+TRANSFORM(i)
*!* .FontSize= MAX(.fontsize - 1,10)
*!* .Width = MAX(.Width-2,20)
*!* .Height = MAX(.Height-2,10)
ENDWITH
ENDFOR
cRectResult=REPLICATE(CHR(0),4 * 4)
FOR i = 1 TO nObjs
fGood=.f.
DO WHILE !fGood
this.aObjs[i].Reposition
fGood=.t.
FOR j = 1 TO i-1
cRect1 = this.aObjs[i].GetRect()
cRect2 = this.aObjs[j].GetRect()
IF IntersectRect(@cRectResult, cRect1,cRect2)>0
* ?i,j,this.aObjs[i].Rs()," ",this.aObjs[j].Rs()
fGood = .f.
EXIT
ENDIF
ENDFOR
ENDDO
ENDFOR
thisform.SetCaption
PROCEDURE SetCaption
thisform.Caption="Score is "+TRANSFORM(thisform.nScore) +;
" # seconds left = "+TRANSFORM(thisform.nSecondsLeft)
PROCEDURE tmr.Timer
thisform.nSecondsLeft=thisform.nSecondsLeft-1
thisform.SetCaption
RETURN
IF thisform.nSecondsLeft = 0
MESSAGEBOX("End")
thisform.nSecondsLeft=NSECONDS
thisform.nScore=0
thisform.nIterations=thisform.nIterations+1
Thisform.shuffle()
ENDIF
ENDDEFINE
DEFINE CLASS MyBtn AS commandbutton
nIndex=0
Height=90
FontSize=14
Width=NWIDTH
Height = NHEIGHT
ForeColor=0xff0000
SpecialEffect=2 && plain
PROCEDURE GetRect && Left, Top, Right, Bottom
RETURN BINTOC(this.Left,"4rs")+BINTOC(this.Top,"4rs")+;
BINTOC(this.Left+this.Width,"4rs")+BINTOC(this.Top+this.Height,"4rs")
PROCEDURE Reposition
this.Left=RAND()*(thisform.Width - this.Width)
this.Top = RAND()*(thisform.Height - this.Height)
PROCEDURE rs
RETURN TRANSFORM(this.Left)+","+TRANSFORM(this.Top)+","+;
TRANSFORM(this.Left+this.Width) + ","+TRANSFORM(this.Top + this.Height)
PROCEDURE click
IF this.Caption= cName
thisform.nScore=thisform.nScore+1
thisform.Shuffle
ENDIF
thisform.txt.setfocus() && Keep focus off all buttons
ENDDEFINE
This is the VB.net version:
Public Class Form1
Shared MyRand As New Random
Dim nObjs As Integer = 10
Dim aObjs() As MyBtn
Dim aWords() As String
Dim cTarget As String = "TYLER"
Dim oDict As Object
Dim WithEvents oTimer As New Timer
Dim nScore As Integer = 0
Const nSecsPerGame = 30
Dim nSecondsLeft As Integer = nSecsPerGame
Dim oText As New TextBox ' set focus here so spacebar doesn't select any button
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
'Me.WindowState = FormWindowState.Maximized
Me.Width = 800
Me.Height = 600
Me.Controls.Add(oText)
Me.oText.Top = -20
oDict = CreateObject("dictionary.dict")
oDict.DictNum = 2
oDict.randword(1)
ReDim Preserve aObjs(nObjs)
ReDim Preserve aWords(nObjs)
aWords(0) = cTarget
For i As Integer = 0 To nObjs - 1
aObjs(i) = New MyBtn
With aObjs(i)
.Visible = 1
End With
Me.Controls.Add(aObjs(i))
Next
Shuffle()
End Sub
Sub Shuffle()
For i As Integer = 1 To nObjs - 1
Me.aWords(i) = oDict.RandWord(0).toupper
Next
For i As Integer = 0 To nObjs - 1
aObjs(i).Text = Me.aWords(i)
Next
For i As Integer = 0 To nObjs - 1
Dim fGood As Boolean = False
Do While Not fGood
aObjs(i).RePosiion()
fGood = True
For j As Integer = 0 To i - 1
If aObjs(i).GetRect.IntersectsWith(aObjs(j).GetRect) Then
fGood = False
Exit For
End If
Next
Loop
Next
Me.oTimer.Interval = 1000
Me.oTimer.Enabled = True
Me.SetCaption()
End Sub
Class MyBtn
Inherits Button
Sub New()
Height = 40
Width = 150
Font = New Font("Arial", 16)
Me.ForeColor = Color.Blue
End Sub
Function GetRect() As Rectangle
Return New Rectangle(Me.Left, Me.Top, Me.Width, Me.Height)
End Function
Sub RePosiion()
Me.Left = MyRand.NextDouble * (Me.FindForm.Width - Me.Width)
Me.Top = MyRand.NextDouble * (Me.FindForm.Height - Me.Height * 2)
End Sub
Private Sub MyBtn_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Click
If Me.Text = Form1.cTarget Then
Form1.Shuffle()
Form1.nScore += 1
Form1.SetCaption()
End If
Form1.oText.Focus()
End Sub
End Class
Private Sub oTimer_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles oTimer.Tick
Me.nSecondsLeft -= 1
Me.SetCaption()
If Me.nSecondsLeft = 0 Then
Me.oTimer.Enabled = False
MsgBox("End")
Me.nScore = 0
Me.nSecondsLeft = nSecsPerGame
Me.Shuffle()
End If
End Sub
Sub SetCaption()
Me.Text = String.Format("Score = {0} # seconds left = {1}", Me.nScore, Me.nSecondsLeft)
End Sub
End Class
Comments
Anonymous
September 19, 2006
Hi Calvin,
I'm a big and old fan of your blog. All your entries always bring new ideas, motivation, and teach a lot.
Nothing else special, just to let you know that this blog has been one of my main sources since I started visiting it.
Thanks for everything!
Best regards
Cesar ChalomAnonymous
September 19, 2006
Cesar: Thanks for your positive comments. I can show this to my boss to justify the time I take to feed this blog!Anonymous
October 09, 2006
Many years ago (1985) I wrote a C program to play Hangman. I had decoded a word processor spelling dictionaryAnonymous
June 06, 2008
I was using a program that was yet another TLA and I wanted to create a mnemonic to help me rememberAnonymous
March 01, 2009
Several years ago, my wife and I were walking through a local shopping mall. At the time, there was someAnonymous
June 01, 2009
PingBack from http://uniformstores.info/story.php?id=18729