I wrote a Word Search generating program in C++ (308 lines) years ago: my brother used it to generate a puzzle including all the girls in his 8th grade class, which was 22 years ago: about 1984 (sounds Orwellian<g>). I wrote one in C# (456 lines) about 3 years ago. I wrote a VFP version (180 lines) which has more features than the prior 2:

it presents UI for user input (the C++ program used a text file as input)

it records the answers into a table

it parses the input into separate words, filtering out punctuation (the C# program does that)

it ignores duplicates (the C# program does that)

it prefills the data with the first few lines of War and Peace (see I cant understand why men cant live without wars)

 

 

Run the code below, paste some text into the editbox, then hit the button

 

You can make a list of your 8th grade classmates or your customers or favorite football teams or….

 

You can paste the elements into the text too. I copied this from an old C++ program:

 

"Hydrogen", "Helium", "Lithium", "Beryllium", "Boron", "Carbon", "Nitrogen",

"Oxygen", "Fluorine", "Neon", "Sodium", "Magnesium", "Aluminum", "Silicon",

"Phosphorus", "Sulfur", "Chlorine", "Argon", "Potassium", "Calcium", "Scandium",

"Titanium", "Vanadium", "Chromium", "Manganese", "Iron", "Cobalt", "Nickel", "Copper",

"Zinc", "Gallium", "Germanium", "Arsenic", "Selenium", "Bromine", "Krypton",

"Rubidium", "Strontium", "Yttrium", "Zirconium", "Niobium", "Molybdenum",

"Technetium", "Ruthenium", "Rhodium", "Palladium", "Silver", "Cadmium", "Indium",

"Tin", "Antimony", "Tellurium", "Iodine", "Xenon", "Cesium", "Barium", "Lanthanum",

"Cerium", "Praseodymium", "Neodymium", "Promethium", "Samarium", "Europium",

"Gadolinium", "Terbium", "Dysprosium", "Holmium", "Erbium", "Thulium", "Ytterbium",

"Lutetium", "Hafnium", "Tantalum", "Tungsten", "Rhenium", "Osmium", "Iridium",

"Platinum", "Gold", "Mercury", "Thallium", "Lead", "Bismuth", "Polonium", "Astatine",

"Radon", "Francium", "Radium", "Actinium", "Thorium", "Protactinium", "Uranium",

"Neptunium", "Plutonium", "Americium", "Curium", "Berkelium", "Californium",

"Einsteinium", "Fermium", "Mendelevium", "Nobelium", "Lawrencium"

 

CLEAR ALL

CLEAR

PUBLIC oForm

oForm=CREATEOBJECT("WordSearch")

oForm.show

 

DEFINE CLASS WordSearch as Form

      left=310

      height=600

      width=500

      allowoutput=.f.

      ADD OBJECT edtText as editbox WITH height = thisform.Height-100,width=thisform.Width,maxlength=3000

      ADD OBJECT cmdDoit as CommandButton WITH left=100,;

            top=thisform.Height-50,caption="\<Generate"

      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

  "Well, Prince, so Genoa and Lucca are now just family estates of the Buonapartes. But I warn you,

  if you don't tell me that this means war, if you still try to defend the infamies and horrors

  perpetrated by that Antichrist- I really believe he is Antichrist- I will have nothing more to do

  with you and you are no longer my friend, no longer my 'faithful slave,' as you call yourself!

  But how do you do? I see I have frightened you- sit down and tell me all the news."

  It was in July, 1805, and the speaker was the well-known Anna Pavlovna Scherer, maid of honor

  and favorite of the Empress Marya Fedorovna. With these words she greeted Prince Vasili Kuragin, a man

  of high rank and importance, who was the first to arrive at her reception. Anna Pavlovna had had

  a cough for some days. She was, as

ENDTEXT

                  .Value=cVar

            ENDWITH

      PROCEDURE click

            IF !thisform.edtText.visible

                  thisform.Cls

                  thisform.edtText.visible=1

                  thisform.cmdDoit.visible=1

            ENDIF

      PROCEDURE cmdDoit.Click

            thisform.edtText.visible=.f.

            this.Visible=.f.

            ALINES(aa,UPPER(thisform.edtText.value))  && create an array elem for each line of text

            CREATE CURSOR words (word c(20))                && a table to store the words

            FOR i = 1 TO ALEN(aa)                     && 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

                              INSERT INTO words VALUES (cTemp)

                        ENDIF

                  ENDFOR

            ENDFOR

            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

            FOR nTries = nMax TO 40

                  ?"Trying to fit "+TRANSFORM(RECCOUNT())+" in square",TRANSFORM(nTries)+" x "+TRANSFORM(nTries)

                  IF thisform.fitit(nTries, nTries)   && if success

                        EXIT

                  ENDIF

            ENDFOR

      PROCEDURE FitIt(numX as Integer, numY as Integer)

            LOCAL nTried,nLen,x0,y0,fGotit,nDir,ch,fFits

            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

            IF WEXIST("t.txt")      && if open from prior run

                  RELEASE WINDOWS t.txt   && close it

            ENDIF

            SET PRINTER off

            SET PRINTER  TO t.txt  

            SET PRINTER on

            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 ORDER BY 1 INTO CURSOR WordListAlpha

            nCols=IIF(_tally > 50,4,3)

            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 < _tally

                              GO ndx+1

                              ??word

                        ENDIF

                  ENDFOR

                  ?

            ENDFOR

            ?"Word Search by Calvin Hsia & Visual FoxPro", DATETIME()

            _screen.FontName="Courier New"

            SET PRINTER off

            SET PRINTER TO

            SELECT wordlist

            LOCATE

            BROWSE LAST NOWAIT

            MODIFY FILE t.txt NOWAIT

            RETURN .t.

ENDDEFINE