Create custom Word Search Puzzles using American Sign Language and Word Automation
My brother and future sister in law wanted special word search puzzles created as wedding favors. The puzzle was to be not in the normal ABC alphabet, but using American Sign Language alphabet.
Gallaudet fingerspelling font
They sent me a sample word search puzzle in an Excel spreadsheet using the ASL font. They wanted the puzzles to be similar to the sample, but to have a different puzzle per guest, including the guest’s name.
In this post Create your own Word Search puzzles I wrote about how to create your own word search puzzles, and in this post Sending Christmas cards: Creating mailng labels automatically I wrote about how to automate Word and Excel.
In this post: Enable people to run your programs without installing anything I showed how I can send just a text file of the program, and they can modify the program as they like. They don’t have to own VFP or run a Setup program.
Changing things like the word list, the header, footer, font size, etc. are as easy as editing a text file.
You can run the code below even if you don’t have the ASL font installed: it will default to showing just big letters.
The code presents a form with an Editbox on it, where the user can enter some words. For each word after the separator word “GUESTS”, a word search puzzle is created including that guest’s name.
The code uses word automation to create the puzzle. The puzzle consists of 2 tables: the puzzle itself and the word list.
Each page in the Word doc has a Header and footer.
The program creates a Word document (works with Word 2007 and Word 2003) with 1 page per puzzle.
CLEAR ALL
CLEAR
PUBLIC oForm
oForm=CREATEOBJECT("WordSearch")
oForm.show(1)
*!* IF _vfp.StartMode>0
*!* READ events
*!* ENDIF
#DEFINE wdCharacter 1
#DEFINE wdWord 2
#DEFINE wdSentence 3
#DEFINE wdParagraph 4
#DEFINE wdLine 5
#DEFINE wdStory 6
#DEFINE wdScreen 7
#DEFINE wdSection 8
#DEFINE wdColumn 9
#DEFINE wdRow 10
#DEFINE wdWindow 11
#DEFINE wdCell 12
#DEFINE wdCharacterFormatting 13
#DEFINE wdParagraphFormatting 14
#DEFINE wdTable 15
#DEFINE wdItem 16
#DEFINE wdCellAlignVerticalTop 0
#DEFINE wdCellAlignVerticalCenter 1
#DEFINE wdCellAlignVerticalBottom 3
#DEFINE wdBorderTop -1
#DEFINE wdBorderLeft -2
#DEFINE wdBorderBottom -3
#DEFINE wdBorderRight -4
#DEFINE wdBorderHorizontal -5
#DEFINE wdBorderVertical -6
#DEFINE wdBorderDiagonalDown -7
#DEFINE wdBorderDiagonalUp -8
#DEFINE emptyenum 0
#DEFINE wdSectionBreakNextPage 2
#DEFINE wdSectionBreakContinuous 3
#DEFINE wdSectionBreakEvenPage 4
#DEFINE wdSectionBreakOddPage 5
#DEFINE wdLineBreak 6
#DEFINE wdPageBreak 7
#DEFINE wdColumnBreak 8
#DEFINE wdLineBreakClearLeft 9
#DEFINE wdLineBreakClearRight 10
#DEFINE wdTextWrappingBreak 11
DEFINE CLASS WordSearch as Form
left=310
height=600
width=500
allowoutput=.t.
oWord=0
fFirstPage=.t.
nPuzNo=0
ShowWindow=2
left=SYSMETRIC(1)*5/8
ADD OBJECT cmdDoit as CommandButton WITH left=100,;
caption="\<Generate Puzzles"
ADD OBJECT cmdQuit as CommandButton WITH left=300,;
caption="\<Quit"
ADD OBJECT edtText as editbox WITH ;
top = 50,;
height = thisform.Height-100,;
width=thisform.Width,;
Anchor=15,;
maxlength=3000
PROCEDURE init
* RAND(1) && remove this for diff seed value each run
WITH this.edtText
.Visible=1
.Height=thisform.Height-100
.Width=thisform.Width
TEXT TO cvar NOSHOW
Aimee, Bible, Sprint, Chicken, Acts, Gordon, Jesus, KCC, Rice, NewHope, Wedding, Worship, Softball, Zippys
GUESTS wendy
martin
ENDTEXT
*martin, franklin, duncan
*kyla robert
.Value=cVar
ENDWITH
PROCEDURE Destroy
CLEAR EVENTS
IF _vfp.StartMode>0
QUIT
ENDIF
PROCEDURE cmdQuit.Click
thisform.Release
PROCEDURE CreateWordDoc
this.oWord=CREATEOBJECT("Word.Application")
WITH this.oWord as Word.Application
.Visible=.t.
.Top=0
.WindowState= 0 && wdWindowStateNormal
.Width=SYSMETRIC(1)/2
.Height=SYSMETRIC(2)-12
.Documents.Add
WITH .ActiveDocument.PageSetup as WORD.PageSetup
*!* .FooterDistance=0
*!* .HeaderDistance=0
.TopMargin=20
.BottomMargin=30
.LeftMargin=20
.RightMargin=20
ENDWITH
.ActiveWindow.ActivePane.View.Type= 3 && wdPrintView
.ActiveWindow.ActivePane.View.SeekView= 1 && wdSeekPrimaryHeader
WITH .Selection as WORD.Selection
.Font.Name="Arial"
.Font.Size=24
.Font.Bold=1
.ParagraphFormat.Alignment= 1 && wdAlignParagraphCenter
.TypeText("Aimee and Gordon Wedding Reception")
.TypeParagraph
.Font.Size=14
.TypeText("ASL Word Search")
.Font.Name="Arial"
.Font.Size=12
.TypeParagraph
.ParagraphFormat.Alignment= 0 && wdAlignParagraphLeft
.TypeText("Find all the hidden words. As a bonus, your name is hidden in a word search on your table but someone else may have your paper. But who?... Good luck! ")
.Font.Italic=1
.TypeText("Mahalo and God Bless, Aimee & Gordon ;o)")
.Font.Italic=0
ENDWITH
.ActiveWindow.ActivePane.View.SeekView= 4 && wdSeekPrimaryFooter
WITH .Selection as WORD.Selection
.Font.Name="Arial"
.Font.Size=6
.ParagraphFormat.Alignment= 2 && wdAlignParagraphRight
.TypeText("June 30, 2007")
* .TypeText("Word Search by Calvin Hsia & Visual FoxPro http://blogs.msdn.com/calvin_hsia/archive/2006/01/10/511258.aspx")
ENDWITH
.ActiveWindow.ActivePane.View.SeekView=0 && wdSeekMainDocument
ENDWITH
*!* CANCEL
*!* RETURN .f.
* oWord.Documents.Close(false)
PROCEDURE click
IF !thisform.edtText.visible
thisform.Cls
thisform.edtText.visible=1
thisform.cmdDoit.visible=1
ENDIF
PROCEDURE cmdDoit.Click
LOCAL i,j
thisform.CreateWordDoc
thisform.edtText.visible=.f.
this.Visible=.f.
nFixedWords=0
nLines=ALINES(aa,UPPER(thisform.edtText.value)) && create an array elem for each line of text
CREATE CURSOR words (word c(10)) && a table to store the words
FOR i = 1 TO nLines && each line of text
FOR j = 1 TO GETWORDCOUNT(aa[i]) && each word on the line
cWord=GETWORDNUM(aa[i],j)
cTemp=""
FOR k = 1 TO LEN(cWord)
IF ISALPHA(SUBSTR(cWord,k,1)) && make sure only alpha chars are used
cTemp=cTemp+SUBSTR(cWord,k,1)
ENDIF
ENDFOR
IF LEN(cTemp) >= 3 && only words > min length
IF cTemp="GUESTS"
INSERT INTO words VALUES (cTemp) && create placeholder record
nFixedWords=RECCOUNT()
ELSE
IF nFixedWords= 0 && still processing Fixed words
INSERT INTO words VALUES (cTemp)
ELSE
GO nFixedWords
thisform.Caption="Guest="+cTemp
REPLACE word WITH cTemp
thisform.nPuzNo=thisform.nPuzNo+1
thisform.GenPuzzle (cTemp)
SELECT words
ENDiF
ENDIF
ENDIF
ENDFOR
ENDFOR
thisform.oWord.Selection.HomeKey(wdStory) && move to top of doc
* thisform.Release
PROCEDURE GenPuzzle(cName)
* LIST
SELECT distinct word,LEN(ALLTRIM(word)) as len, 100 as x, 100 as y,9 as dir;
FROM words ORDER BY 2 descending INTO CURSOR WordList READWRITE
nMax=MAX(WordList.len,15) && size of sq must be >= longest word
* ?"nmax",nMax
fGotit = .f.
FOR nTries = 1 TO 10
* ?"Trying to fit "+TRANSFORM(RECCOUNT())+" in square",TRANSFORM(nTries)+" x "+TRANSFORM(nTries)
IF thisform.fitit(10,10,cName) && if success
fGotit=.t.
EXIT
ELSE
?" failed to generate for '",cName, "' Retry # ",nTries
ENDIF
ENDFOR
IF !fGotit
?"Failed for ",cName
ENDIF
PROCEDURE FitIt(numX as Integer, numY as Integer,cName)
LOCAL nTried,nLen,x0,y0,fGotit,nDir,ch,fFits,i,j,nRows,nCols
DIMENSION aGrid[numX,numY] && Each element is a character
DIMENSION aTried[numX,numY] && track direction tried for each cell in bitfield
aGrid=" " && int all cells to space
thisform.Cls && erase the form
UPDATE wordlist SET x=0,y=0,dir=0 && init recorded word positions
SCAN
aTried=0 && set all elements to 0
nTried=0 && number of tries to fit this particular word
DO WHILE .t.
nLen = LEN(ALLTRIM(word))
IF nTried < 4 * numX * numY && for the first few attempts, try random placement
DO WHILE .t. && get random direction: dx,dy = 0 or +=1: but both can't be 0
nDir = INT(RAND()*9) && get a random direction
IF nDir != 4 && 4 is dx=0 and dy=0
EXIT
ENDIF
ENDDO
x0=INT(RAND()*numX)+1 && Random starting point in the grid
y0=INT(RAND()*numY)+1
IF BITTEST(aTried[x0,y0],nDir) && if this dir was tried, lets try another
nTried=nTried+1
LOOP
ENDIF
ELSE && if failed to fit the first few attempts randomly: try systematically
fGotit=.f.
FOR x0 = 1 TO numX && each row,col
FOR y0 = 1 TO numY
FOR nDir = 0 TO 8 && each direction
IF nDir !=4 && 4 is dx=0 and dy=0
IF !BITTEST(aTried[x0,y0],nDir) && if this dir is untried, lets try it
fGotit=.t.
EXIT
ENDIF
ENDIF
ENDFOR
IF fGotit
EXIT
ENDIF
ENDFOR
IF fGotit
EXIT
ENDIF
ENDFOR
IF !fGotit
RETURN .f. && couldn't fit anywhere
ENDIF
ENDIF
dx=nDir%3-1 && -1, 0, 1
dy=INT(nDir/3)-1 && -1, 0, 1
aTried[x0,y0]=BITSET(aTried[x0,y0],nDir) && set bit indicating direction tried
nTried=nTried+1
IF BETWEEN(x0 + dx*nLen,1,numX) AND BETWEEN(y0 + dy * nLen,1, numY) && if enough room for word in grid
fFits = .t.
fHadBlank = .f.
FOR i = 0 TO nLen-1 && now see if existing letters in grid match word
ch = aGrid[x0+dx*i,y0+dy * i]
IF ch = " " && track empty squares (so "ear" not placed in "hear"
fHadBlank = .t.
ELSE
IF ch != SUBSTR(word,i+1,1) && the existing letter doesn't match the word
fFits = .f.
EXIT
ENDIF
ENDIF
ENDFOR
IF fHadBlank AND fFits && had a blank: we have a fit
FOR i = 0 TO nLen-1 && now place word in grid
aGrid[x0+dx*i,y0+dy * i] = SUBSTR(word,i+1,1)
thisform.Print(SUBSTR(word,i+1,1),15*(x0+dx*i),20*(y0+dy * i))
REPLACE x WITH x0,y WITH y0,Dir WITH nDir && record position
ENDFOR
EXIT && go on to next word
ENDIF
ENDIF
ENDDO
ENDSCAN && finish looping on all words
******Start grid
WITH this.oWord as WORD.Application
IF !this.fFirstPage
.Selection.EndKey(wdStory)
.Selection.InsertBreak(wdPageBreak)
ENDIF
this.fFirstPage = .f.
.ActiveWindow.ActivePane.View.SeekView=0 && wdSeekMainDocument
WITH .Selection as WORD.Selection
.TypeParagraph
.Font.Name="Gallaudet" && comment out this line for english font
.Font.Size=55
.Font.Bold=0 && do you want ASL font bold?
ENDWITH
.ActiveDocument.Tables.Add(.Selection.Range,10,10)
WITH .ActiveDocument.Tables((this.nPuzNo-1)*2+1) as WORD.Table
.Borders(wdBorderLeft).LineStyle= 1 && wdLineStyleSingle
.Borders(wdBorderRight).LineStyle= 1 && wdLineStyleSingle
.Borders(wdBorderTop).LineStyle= 1 && wdLineStyleSingle
.Borders(wdBorderBottom).LineStyle= 1 && wdLineStyleSingle
.Borders(wdBorderHorizontal).LineStyle= 1 && wdLineStyleSingle
.Borders(wdBorderVertical).LineStyle= 1 && wdLineStyleSingle
.TopPadding=0
.BottomPadding=0
.LeftPadding=0
.RightPadding=0
.Rows.Alignment= 1 && wdAlignRowCenter
.Rows.HeightRule= 2 && wdRowHeightExactly
.Rows.Height=53
.Spacing=0
ENDWITH
oSelection=.Selection
FOR j = 1 TO 10
FOR i = 1 TO 10
oSelection.ParagraphFormat.Alignment=1 && wdAlignParagraphCenter
* oSelection.Range.Cells.VerticalAlignment= 1 && wdCellAlignVerticalCenter
IF aGrid[i,j]=' '
cChar=CHR(65+RAND()*26) && random letter
ELSE
cChar=aGrid[i,j]
ENDIF
* cChar=CHR(65+MOD(i,26))
oSelection.TypeText(cChar)
IF i *j< 100
oSelection.MoveRight(wdCell)
ELSE
ENDIF
ENDFOR
ENDFOR
oSelection.MoveDown(wdLine)
*****END Grid/Start Word list
oSelection.Font.Name="Arial"
oSelection.Font.Size=12
oSelection.Font.Bold=1
oSelection.TypeParagraph
* .ActiveWindow.View.TableGridlines=0
#if .f.
.Selection.TypeParagraph
.ActiveDocument.DefaultTabStop=110
FOR i = 1 TO 3
FOR j = 1 TO 5
.Selection.TypeText("SOFTBALL")
IF j < 5
.Selection.TypeText(CHR(9))
ENDIF
ENDFOR
.Selection.TypeParagraph
ENDFOR
#endif
#if .t.
.ActiveDocument.Tables.Add(.Selection.Range,3,5)
WITH .ActiveDocument.Tables(this.nPuzNo*2) as WORD.Table
.TopPadding=0
.BottomPadding=0
.LeftPadding=0
.RightPadding=0
.Rows.Alignment= 1 && wdAlignRowCenter
.Rows.HeightRule= 2 && wdRowHeightExactly
.Rows.Height=14
.Spacing=0
ENDWITH
SELECT word FROM words INTO CURSOR WordListAlpha READWRITE
* SELECT word FROM wordlist WHERE word != cName ORDER BY 1 INTO CURSOR WordListAlpha READWRITE
GO BOTTOM
REPLACE word WITH "[NAME?]"
* INSERT INTO WordListAlpha VALUES ("[NAME?]")
nWords=RECCOUNT()
nCols=5
nRows = 3
FOR i = 1 TO nCols
FOR j = 1 TO nRows
ndx = (i-1) * nRows + (j-1)
IF ndx < nWords
GO ndx+1
.Selection.TypeText(word)
IF i *j< 15
.Selection.MoveRight(wdCell)
ENDIF
ENDIF
ENDFOR
ENDFOR
*!* FOR i = 1 TO 15
*!* .Selection.TypeText("SOFTBALL")
*!* IF i < 15
*!* .Selection.MoveRight(wdCell)
*!* ELSE
*!* ENDIF
*!* ENDFOR
#endif
ENDWITH
RETURN
FOR j = 1 TO numX
?SPACE(6)
FOR i = 1 TO numY
IF aGrid[i,j]=' '
??CHR(65+RAND()*26)+" " && random letter
ELSE
??aGrid[i,j]+" "
ENDIF
ENDFOR
ENDFOR
SELECT word FROM wordlist WHERE word != cName INTO CURSOR WordListAlpha READWRITE
* SELECT word FROM wordlist WHERE word != cName ORDER BY 1 INTO CURSOR WordListAlpha READWRITE
INSERT INTO WordListAlpha VALUES ("[NAME?]")
nWords=RECCOUNT()
nCols=5
nRows = INT(_tally/nCols)
IF nRows*nCols != _tally
nRows=nRows+1
ENDIF
?
?
FOR j = 1 TO nRows
FOR i = 1 TO nCols
ndx = (i-1) * nRows + (j-1)
IF ndx < nWords
GO ndx+1
??word
ENDIF
ENDFOR
?
ENDFOR
?"Word Search by Calvin Hsia & Visual FoxPro", DATETIME()
*Word Search by Calvin Hsia & Visual FoxPro http://blogs.msdn.com/calvin_hsia/archive/2006/01/10/511258.aspx
RETURN .t.
ENDDEFINE
