Word Search Maker

[SierraKen]

This is a word search puzzle maker. You can make a classic word search puzzle for yourself, family, or friends. It has printer support also which lets you print them on your printer when you press P. Unlike some apps, you don't place anything in the puzzle, it places everything automatically after you give it the words to use. I also added a feature to show you where any word is if you get stumped if you press A. Plus it has a clipboard function, if you press C. It copies the entire puzzle to your computer's clipboard so you can paste it as an image to another graphics program, where you can save it as an image or change it. Instructions are in the program and on the heading. Thank you to B+ and PhilofPerth for your help and ideas. Also thanks to ChatGPT for some help, although I did get pretty far by myself.
If you come across a word that it can't use, you will have to start over on making the puzzle. Once in awhile there won't be enough letters to use for the puzzle, especially long words. There's also a 15 letter limit on all words. 

The puzzle itself is 18 letters by 18 letters large that can use between 1 and 24 words.  

Have fun! 

(Code deleted for a new update fix post below.)

[PhilOfPerth]

This is a word search puzzle maker. You can make a classic word search puzzle for yourself, family, or friends. It has printer support also which lets you print them on your printer when you press P. Unlike some apps, you don't place anything in the puzzle, it places everything automatically after you give it the words to use. I also added a feature to show you where any word is if you get stumped if you press A. Plus it has a clipboard function, if you press C. It copies the entire puzzle to your computer's clipboard so you can paste it as an image to another graphics program, where you can save it as an image or change it. Instructions are in the program and on the heading. Thank you to B+ and PhilofPerth for your help and ideas. Also thanks to ChatGPT for some help, although I did get pretty far by myself.
If you come across a word that it can't use, you will have to start over on making the puzzle. Once in awhile there won't be enough letters to use for the puzzle, especially long words. There's also a 15 letter limit on all words. 

The puzzle itself is 18 letters by 18 letters large that can use between 1 and 24 words.  

Have fun! 

Nice one, Ken. Nice and quick.
I have a draft of one of these that I've shelved for a while, but you beat me to it..
I was battling with a way to re-use letters in another word, and to allow reverse  and diagonal words as difficulty options.
Maybe your next challenge? 
Might be good to have the instructions visible after you make a wordsearch - I couldn't remember what to do to print it out. etc.

[SierraKen]

LOL I don't think I'm going to make this any harder than it is already Phil. I do have the instructions on the _TITLE bar up above, you probably didn't see it. Unless you are using an operating system that doesn't have title bars. P is to print, A for answers, C is to copy to clipboard, Space Bar is to make a new one, and Esc to quit. 

Here is a change I just made to it, using your idea of letters instead of numbers for INKEY$. I also had to clear out the word$ array in the beginning for people that want to make more than 1. 

(Code deleted on this post, update to a much better one posted below on this forum thread.)

[PhilOfPerth]

[quote="SierraKen" pid="33247" dateline="1743645540"]
LOL I don't think I'm going to make this any harder than it is already Phil. I do have the instructions on the _TITLE bar up above, you probably didn't see it. Unless you are using an operating system that doesn't have title bars. P is to print, A for answers, C is to copy to clipboard, Space Bar is to make a new one, and Esc to quit. 



ah, yes! I see it now. I have tunnel vision! But I think it would be  more visible if kept on-screen. 
Yes, I meant to come back and mention about clearing the previous entry.
Looking good!

[SierraKen]

Thanks again for another great idea Phil! I just remove the instructions from the _TITLE bar and put it on the page itself. But when people select C to copy the image or P to print, it removes the instructions so they won't be on those. Then it puts it back. I really like the layout now!  

(Code deleted for the update below.)

[SierraKen]

Update: I made the list of words centered better at the bottom for any amount used. 

(Code deleted for another update added below.)

[SierraKen]

Update: I added a way to save your puzzle as a JPG picture to use elsewhere. I also added your heading title for you to display over your puzzle.

Code: (Select All)

'Word Search Maker by SierraKen

'May 17, 2025 - 2

'With some help by ChatGPT. I was very close by myself, all of the math and arrays are from me, just needed it cleaned up a bit.

'Thank you to B+ for the graphics rotation code to print on printer and also for the idea of seeing the answers to the words.

'Thank you also to PhilofPerth for the idea of still using small letters and converting them to large. Also for using letters instead of numbers on the answers selections.

'Also, thank you PhilofPerth for the idea of putting the instructions on the main page.



'Update: Shifted list of words at the bottom so they are right under the puzzle and centered better for any amount.

'Update: Added ability to save as JPG picture. Also added a title displayed on your puzzle.

'Update: Added limit to length of title.



Dim word$(24), grid$(18, 18), dir(24), x(24), y(24)



Screen _NewImage(800, 600, 32)

_Title "Word Search Maker - by SierraKen"

begin:

t = 0: num = 0

For a = 1 To 24

    word$(a) = ""

Next a



Cls

Paint (1, 1), _RGB32(255, 255, 255)

Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)

Print "                                        Word Search Maker"

Print "                                          by SierraKen"

Print: Print: Print

Print "    Instructions"

Print "    ------------"

Print

Print "    A to see an Answer to a Word."

Print "    P to Print on Printer."

Print "    S to Save as JPG picture."

Print "    C to Copy to Clipboard to use with another graphics program."

Print "    Space Bar for another one."

Print "    Esc to Quit."

Print

Print "    Words cannot be over 15 letters long."

Print

title:

Print "    New title name to display."

Print "    Must be less than 100 letters, numbers, symbols and spaces."

Print "    Just press Enter for no title."

Print

Input "    ->", nm$

If Len(nm$) > 99 Then

    Print

    Print "    Title name is too long, must be less than 100 letters, numbers, symbols, or spaces."

    Print "    Try again."

    Print

    GoTo title

End If

Print

Input "    How many words (1-24): ", num

If num > 24 Or num < 1 Or num <> Int(num) Then GoTo begin

Cls

Paint (1, 1), _RGB32(255, 255, 255)

Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)

Print "    Type one word at a time here for your puzzle."

Print

For w = 1 To num

    words:

    Print Str$(w) + ". ";

    Input word$(w)

    If Len(word$(w)) > 15 Then Print "    Words cannot be over 15 letters long.": Print: GoTo words

    temp$ = ""

    For ii = 1 To Len(word$(w))

        If Mid$(word$(w), ii, 1) <> " " Then temp$ = temp$ + Mid$(word$(w), ii, 1)

    Next ii

    If temp$ <> "" Then word$(w) = temp$ ' Only assign if temp$ changed

    If word$(w) = "" Or word$(w) = " " Or word$(w) = "  " Or word$(w) = "  " Or word$(w) = "    " Or word$(w) = "    " Or word$(w) = "      " Or word$(w) = "      " Or word$(w) = "        " Or word$(w) = "        " Or word$(w) = "          " Then

        Print "        Nothing typed, try again."

        GoTo words

    End If

    For ii = 1 To Len(word$(w))

        If Mid$(word$(w), ii, 1) < Chr$(65) Or (Mid$(word$(w), ii, 1) > Chr$(90) And Mid$(word$(w), ii, 1) < Chr$(97)) Then

            Print "    No numbers or symbols,  try again.": GoTo words

        End If

    Next ii

    For ii = 1 To Len(word$(w))

        If Mid$(word$(w), ii, 1) > Chr$(122) Then

            Print "    No numbers or symbols, try again.": GoTo words

        End If

    Next ii



    For ii = 1 To Len(word$(w))

        If Mid$(word$(w), ii, 1) > Chr$(96) Or Mid$(word$(w), ii, 1) < Chr$(123) Then

            word$(w) = UCase$(word$(w))

        End If

    Next ii



Next w

Cls

Paint (1, 1), _RGB32(255, 255, 255)

Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)

' Initialize grid

For y = 1 To 18

    For x = 1 To 18

        grid$(y, x) = ""

    Next x

Next y



_PrintString ((_Width / 2) - ((Len(nm$) * 8) / 2), 30), nm$ 'Centers nm$



Randomize Timer

For w = 1 To num

    placement:

    t = t + 1

    If t > 2000 Then

        Print word$(w) + " unable to work with this puzzle, press Enter to start over."

        Input ab$

        t = 0

        GoTo begin

    End If

    dir(w) = Int(Rnd * 8) + 1

    x(w) = Int(Rnd * 18) + 1: y(w) = Int(Rnd * 18) + 1



    ' Ensure the word fits in the selected direction

    If dir(w) = 1 And x(w) + Len(word$(w)) > 18 Then GoTo placement ' Right

    If dir(w) = 2 And x(w) - Len(word$(w)) < 1 Then GoTo placement ' Left

    If dir(w) = 3 And y(w) + Len(word$(w)) > 18 Then GoTo placement ' Down

    If dir(w) = 4 And y(w) - Len(word$(w)) < 1 Then GoTo placement ' Up

    If dir(w) = 5 And (x(w) + Len(word$(w)) > 18 Or y(w) + Len(word$(w)) > 18) Then GoTo placement ' Right-Down

    If dir(w) = 6 And (x(w) - Len(word$(w)) < 1 Or y(w) + Len(word$(w)) > 18) Then GoTo placement ' Left-Down

    If dir(w) = 7 And (x(w) - Len(word$(w)) < 1 Or y(w) - Len(word$(w)) < 1) Then GoTo placement ' Left-Up

    If dir(w) = 8 And (x(w) + Len(word$(w)) > 18 Or y(w) - Len(word$(w)) < 1) Then GoTo placement ' Right-Up



    ' Check for conflicts

    For l = 1 To Len(word$(w))

        cx = x(w): cy = y(w)

        If dir(w) = 1 Then cx = x(w) + l ' Right

        If dir(w) = 2 Then cx = x(w) - l ' Left

        If dir(w) = 3 Then cy = y(w) + l ' Down

        If dir(w) = 4 Then cy = y(w) - l ' Up

        If dir(w) = 5 Then cx = x(w) + l: cy = y(w) + l ' Right-Down

        If dir(w) = 6 Then cx = x(w) - l: cy = y(w) + l ' Left-Down

        If dir(w) = 7 Then cx = x(w) - l: cy = y(w) - l ' Left-Up

        If dir(w) = 8 Then cx = x(w) + l: cy = y(w) - l ' Right-Up



        If grid$(cy, cx) <> "" And grid$(cy, cx) <> Mid$(word$(w), l, 1) Then GoTo placement

    Next l



    ' Place word

    For l = 1 To Len(word$(w))

        cx = x(w): cy = y(w)

        If dir(w) = 1 Then cx = x(w) + l ' Right

        If dir(w) = 2 Then cx = x(w) - l ' Left

        If dir(w) = 3 Then cy = y(w) + l ' Down

        If dir(w) = 4 Then cy = y(w) - l ' Up

        If dir(w) = 5 Then cx = x(w) + l: cy = y(w) + l ' Right-Down

        If dir(w) = 6 Then cx = x(w) - l: cy = y(w) + l ' Left-Down

        If dir(w) = 7 Then cx = x(w) - l: cy = y(w) - l ' Left-Up

        If dir(w) = 8 Then cx = x(w) + l: cy = y(w) - l ' Right-Up



        grid$(cy, cx) = Mid$(word$(w), l, 1)

    Next l

    t = 0

Next w



' Fill empty spaces with random letters

For y = 1 To 18

    For x = 1 To 18

        If grid$(y, x) = "" Then grid$(y, x) = Chr$(Int(Rnd * 26) + 65)

    Next x

Next y



' Display grid with spaces between letters

For y = 1 To 18

    For x = 1 To 18

        Locate y + 5, (x * 2) + 31: Print grid$(y, x); " ";

    Next x

    Print

Next y

listx = 15: listy = 25

If num < 7 Then listx = 46

If num > 6 And num < 13 Then listx = 35

If num > 12 And num < 19 Then listx = 28

For l = 1 To num

    listy = listy + 1

    If listy / 8 = Int(listy / 8) Then

        listy = 26: listx = listx + 20

    End If

    Locate listy, listx: Print word$(l)

Next l



Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"



Do

    a$ = InKey$

    If a$ = "a" Or a$ = "A" Then GoSub answers

    If a$ = "s" Or a$ = "S" Then GoSub saving

    If a$ = "c" Or a$ = "C" Then

        Locate 1, 15: Print "                                                                        "

        _Delay .1

        landscape2& = _CopyImage(0)

        _ClipboardImage = landscape2&

        For sz = 0 To 20

            Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 0, 0), B

        Next sz

        _Delay 2

        For sz = 0 To 20

            Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 255, 255), B

        Next sz

        _FreeImage landscape2&

        Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"

    End If

    If a$ = "p" Or a$ = "P" Then

        Locate 1, 15: Print "                                                                        "

        _Delay .1

        'printer prep (code from bplus Free Calendar Program)

        YMAX = _Height: XMAX = _Width

        landscape& = _NewImage(YMAX, XMAX, 32)

        _MapTriangle (XMAX, 0)-(0, 0)-(0, YMAX), 0 To(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&

        _MapTriangle (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 To(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&

        _PrintImage landscape&

        _Delay 2

        _FreeImage landscape&

        Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"

    End If

    If a$ = " " Then GoTo begin

    If a$ = Chr$(27) Then End

Loop



answers:

listx = 15: listy = 25

If num < 7 Then listx = 46

If num > 6 And num < 13 Then listx = 35

If num > 12 And num < 19 Then listx = 28

For l = 1 To num

    listy = listy + 1

    If listy / 8 = Int(listy / 8) Then

        listy = 26: listx = listx + 20

    End If

    Locate listy, listx: Print "(" + Chr$(96 + l) + ") " + word$(l)

Next l



Locate 23, 5: Print "Which word letter?"

Do

    pick:

    n$ = InKey$

    If n$ <> "" Then

        If n$ = "a" Or n$ = "A" Then n = 1

        If n$ = "b" Or n$ = "B" Then n = 2

        If n$ = "c" Or n$ = "C" Then n = 3

        If n$ = "d" Or n$ = "D" Then n = 4

        If n$ = "e" Or n$ = "E" Then n = 5

        If n$ = "f" Or n$ = "F" Then n = 6

        If n$ = "g" Or n$ = "G" Then n = 7

        If n$ = "h" Or n$ = "H" Then n = 8

        If n$ = "i" Or n$ = "I" Then n = 9

        If n$ = "j" Or n$ = "J" Then n = 10

        If n$ = "k" Or n$ = "K" Then n = 11

        If n$ = "l" Or n$ = "L" Then n = 12

        If n$ = "m" Or n$ = "M" Then n = 13

        If n$ = "n" Or n$ = "N" Then n = 14

        If n$ = "o" Or n$ = "O" Then n = 15

        If n$ = "p" Or n$ = "P" Then n = 16

        If n$ = "q" Or n$ = "Q" Then n = 17

        If n$ = "r" Or n$ = "R" Then n = 18

        If n$ = "s" Or n$ = "S" Then n = 19

        If n$ = "t" Or n$ = "T" Then n = 20

        If n$ = "u" Or n$ = "U" Then n = 21

        If n$ = "v" Or n$ = "V" Then n = 22

        If n$ = "w" Or n$ = "W" Then n = 23

        If n$ = "x" Or n$ = "X" Then n = 24

        If word$(n) = "" Then GoTo pick

        GoTo nex

    End If

Loop

nex:



For l = 1 To Len(word$(n))

    cx = x(n): cy = y(n)

    Select Case dir(n)

        Case 1: cx = x(n) + l ' Right

        Case 2: cx = x(n) - l ' Left

        Case 3: cy = y(n) + l ' Down

        Case 4: cy = y(n) - l ' Up

        Case 5: cx = x(n) + l: cy = y(n) + l ' Right-Down

        Case 6: cx = x(n) - l: cy = y(n) + l ' Left-Down

        Case 7: cx = x(n) - l: cy = y(n) - l ' Left-Up

        Case 8: cx = x(n) + l: cy = y(n) - l ' Right-Up

    End Select

    Locate cy + 5, (cx * 2) + 30

    Color _RGB32(255, 0, 0)

    Print grid$(cy, cx);

Next l

_Delay 5



For l = 1 To Len(word$(n))

    cx = x(n): cy = y(n)

    Select Case dir(n)

        Case 1: cx = x(n) + l ' Right

        Case 2: cx = x(n) - l ' Left

        Case 3: cy = y(n) + l ' Down

        Case 4: cy = y(n) - l ' Up

        Case 5: cx = x(n) + l: cy = y(n) + l ' Right-Down

        Case 6: cx = x(n) - l: cy = y(n) + l ' Left-Down

        Case 7: cx = x(n) - l: cy = y(n) - l ' Left-Up

        Case 8: cx = x(n) + l: cy = y(n) - l ' Right-Up

    End Select

    Locate cy + 5, (cx * 2) + 30

    Color _RGB32(0, 0, 0)

    Print grid$(cy, cx);

Next l



Locate 23, 5: Print "                        "



listx = 15: listy = 25

If num < 7 Then listx = 46

If num > 6 And num < 13 Then listx = 35

If num > 12 And num < 19 Then listx = 28

For l = 1 To num

    listy = listy + 1

    If listy / 8 = Int(listy / 8) Then

        listy = 26: listx = listx + 20

    End If

    Locate listy, listx: Print "                      "

    Locate listy, listx: Print word$(l)

Next l

n = 0

n$ = ""

Return



saving:



name$ = _InputBox$("Save", "Type a name of file to save without jpg ending.")

If name$ = "" Then GoTo saving

name$ = name$ + ".jpg"

Locate 1, 11: Print "                                                                                    "

_SaveImage name$

path$ = _FullPath$(name$)

_MessageBox "Saved", "Puzzle picture saved as " + name$ + " to " + path$

Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"

Return

[PhilOfPerth]

Update: I added a way to save your puzzle as a JPG picture to use elsewhere. I also added your heading title for you to display over your puzzle.

Code: (Select All)

'Word Search Maker by SierraKen

'May 17, 2025 - 2

'With some help by ChatGPT. I was very close by myself, all of the math and arrays are from me, just needed it cleaned up a bit.

'Thank you to B+ for the graphics rotation code to print on printer and also for the idea of seeing the answers to the words.

'Thank you also to PhilofPerth for the idea of still using small letters and converting them to large. Also for using letters instead of numbers on the answers selections.

'Also, thank you PhilofPerth for the idea of putting the instructions on the main page.



'Update: Shifted list of words at the bottom so they are right under the puzzle and centered better for any amount.

'Update: Added ability to save as JPG picture. Also added a title displayed on your puzzle.

'Update: Added limit to length of title.



Dim word$(24), grid$(18, 18), dir(24), x(24), y(24)



Screen _NewImage(800, 600, 32)

_Title "Word Search Maker - by SierraKen"

begin:

t = 0: num = 0

For a = 1 To 24

    word$(a) = ""

Next a



Cls

Paint (1, 1), _RGB32(255, 255, 255)

Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)

Print "                                        Word Search Maker"

Print "                                          by SierraKen"

Print: Print: Print

Print "    Instructions"

Print "    ------------"

Print

Print "    A to see an Answer to a Word."

Print "    P to Print on Printer."

Print "    S to Save as JPG picture."

Print "    C to Copy to Clipboard to use with another graphics program."

Print "    Space Bar for another one."

Print "    Esc to Quit."

Print

Print "    Words cannot be over 15 letters long."

Print

title:

Print "    New title name to display."

Print "    Must be less than 100 letters, numbers, symbols and spaces."

Print "    Just press Enter for no title."

Print

Input "    ->", nm$

If Len(nm$) > 99 Then

    Print

    Print "    Title name is too long, must be less than 100 letters, numbers, symbols, or spaces."

    Print "    Try again."

    Print

    GoTo title

End If

Print

Input "    How many words (1-24): ", num

If num > 24 Or num < 1 Or num <> Int(num) Then GoTo begin

Cls

Paint (1, 1), _RGB32(255, 255, 255)

Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)

Print "    Type one word at a time here for your puzzle."

Print

For w = 1 To num

    words:

    Print Str$(w) + ". ";

    Input word$(w)

    If Len(word$(w)) > 15 Then Print "    Words cannot be over 15 letters long.": Print: GoTo words

    temp$ = ""

    For ii = 1 To Len(word$(w))

        If Mid$(word$(w), ii, 1) <> " " Then temp$ = temp$ + Mid$(word$(w), ii, 1)

    Next ii

    If temp$ <> "" Then word$(w) = temp$ ' Only assign if temp$ changed

    If word$(w) = "" Or word$(w) = " " Or word$(w) = "  " Or word$(w) = "  " Or word$(w) = "    " Or word$(w) = "    " Or word$(w) = "      " Or word$(w) = "      " Or word$(w) = "        " Or word$(w) = "        " Or word$(w) = "          " Then

        Print "        Nothing typed, try again."

        GoTo words

    End If

    For ii = 1 To Len(word$(w))

        If Mid$(word$(w), ii, 1) < Chr$(65) Or (Mid$(word$(w), ii, 1) > Chr$(90) And Mid$(word$(w), ii, 1) < Chr$(97)) Then

            Print "    No numbers or symbols,  try again.": GoTo words

        End If

    Next ii

    For ii = 1 To Len(word$(w))

        If Mid$(word$(w), ii, 1) > Chr$(122) Then

            Print "    No numbers or symbols, try again.": GoTo words

        End If

    Next ii



    For ii = 1 To Len(word$(w))

        If Mid$(word$(w), ii, 1) > Chr$(96) Or Mid$(word$(w), ii, 1) < Chr$(123) Then

            word$(w) = UCase$(word$(w))

        End If

    Next ii



Next w

Cls

Paint (1, 1), _RGB32(255, 255, 255)

Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)

' Initialize grid

For y = 1 To 18

    For x = 1 To 18

        grid$(y, x) = ""

    Next x

Next y



_PrintString ((_Width / 2) - ((Len(nm$) * 8) / 2), 30), nm$ 'Centers nm$



Randomize Timer

For w = 1 To num

    placement:

    t = t + 1

    If t > 2000 Then

        Print word$(w) + " unable to work with this puzzle, press Enter to start over."

        Input ab$

        t = 0

        GoTo begin

    End If

    dir(w) = Int(Rnd * 8) + 1

    x(w) = Int(Rnd * 18) + 1: y(w) = Int(Rnd * 18) + 1



    ' Ensure the word fits in the selected direction

    If dir(w) = 1 And x(w) + Len(word$(w)) > 18 Then GoTo placement ' Right

    If dir(w) = 2 And x(w) - Len(word$(w)) < 1 Then GoTo placement ' Left

    If dir(w) = 3 And y(w) + Len(word$(w)) > 18 Then GoTo placement ' Down

    If dir(w) = 4 And y(w) - Len(word$(w)) < 1 Then GoTo placement ' Up

    If dir(w) = 5 And (x(w) + Len(word$(w)) > 18 Or y(w) + Len(word$(w)) > 18) Then GoTo placement ' Right-Down

    If dir(w) = 6 And (x(w) - Len(word$(w)) < 1 Or y(w) + Len(word$(w)) > 18) Then GoTo placement ' Left-Down

    If dir(w) = 7 And (x(w) - Len(word$(w)) < 1 Or y(w) - Len(word$(w)) < 1) Then GoTo placement ' Left-Up

    If dir(w) = 8 And (x(w) + Len(word$(w)) > 18 Or y(w) - Len(word$(w)) < 1) Then GoTo placement ' Right-Up



    ' Check for conflicts

    For l = 1 To Len(word$(w))

        cx = x(w): cy = y(w)

        If dir(w) = 1 Then cx = x(w) + l ' Right

        If dir(w) = 2 Then cx = x(w) - l ' Left

        If dir(w) = 3 Then cy = y(w) + l ' Down

        If dir(w) = 4 Then cy = y(w) - l ' Up

        If dir(w) = 5 Then cx = x(w) + l: cy = y(w) + l ' Right-Down

        If dir(w) = 6 Then cx = x(w) - l: cy = y(w) + l ' Left-Down

        If dir(w) = 7 Then cx = x(w) - l: cy = y(w) - l ' Left-Up

        If dir(w) = 8 Then cx = x(w) + l: cy = y(w) - l ' Right-Up



        If grid$(cy, cx) <> "" And grid$(cy, cx) <> Mid$(word$(w), l, 1) Then GoTo placement

    Next l



    ' Place word

    For l = 1 To Len(word$(w))

        cx = x(w): cy = y(w)

        If dir(w) = 1 Then cx = x(w) + l ' Right

        If dir(w) = 2 Then cx = x(w) - l ' Left

        If dir(w) = 3 Then cy = y(w) + l ' Down

        If dir(w) = 4 Then cy = y(w) - l ' Up

        If dir(w) = 5 Then cx = x(w) + l: cy = y(w) + l ' Right-Down

        If dir(w) = 6 Then cx = x(w) - l: cy = y(w) + l ' Left-Down

        If dir(w) = 7 Then cx = x(w) - l: cy = y(w) - l ' Left-Up

        If dir(w) = 8 Then cx = x(w) + l: cy = y(w) - l ' Right-Up



        grid$(cy, cx) = Mid$(word$(w), l, 1)

    Next l

    t = 0

Next w



' Fill empty spaces with random letters

For y = 1 To 18

    For x = 1 To 18

        If grid$(y, x) = "" Then grid$(y, x) = Chr$(Int(Rnd * 26) + 65)

    Next x

Next y



' Display grid with spaces between letters

For y = 1 To 18

    For x = 1 To 18

        Locate y + 5, (x * 2) + 31: Print grid$(y, x); " ";

    Next x

    Print

Next y

listx = 15: listy = 25

If num < 7 Then listx = 46

If num > 6 And num < 13 Then listx = 35

If num > 12 And num < 19 Then listx = 28

For l = 1 To num

    listy = listy + 1

    If listy / 8 = Int(listy / 8) Then

        listy = 26: listx = listx + 20

    End If

    Locate listy, listx: Print word$(l)

Next l



Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"



Do

    a$ = InKey$

    If a$ = "a" Or a$ = "A" Then GoSub answers

    If a$ = "s" Or a$ = "S" Then GoSub saving

    If a$ = "c" Or a$ = "C" Then

        Locate 1, 15: Print "                                                                        "

        _Delay .1

        landscape2& = _CopyImage(0)

        _ClipboardImage = landscape2&

        For sz = 0 To 20

            Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 0, 0), B

        Next sz

        _Delay 2

        For sz = 0 To 20

            Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 255, 255), B

        Next sz

        _FreeImage landscape2&

        Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"

    End If

    If a$ = "p" Or a$ = "P" Then

        Locate 1, 15: Print "                                                                        "

        _Delay .1

        'printer prep (code from bplus Free Calendar Program)

        YMAX = _Height: XMAX = _Width

        landscape& = _NewImage(YMAX, XMAX, 32)

        _MapTriangle (XMAX, 0)-(0, 0)-(0, YMAX), 0 To(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&

        _MapTriangle (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 To(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&

        _PrintImage landscape&

        _Delay 2

        _FreeImage landscape&

        Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"

    End If

    If a$ = " " Then GoTo begin

    If a$ = Chr$(27) Then End

Loop



answers:

listx = 15: listy = 25

If num < 7 Then listx = 46

If num > 6 And num < 13 Then listx = 35

If num > 12 And num < 19 Then listx = 28

For l = 1 To num

    listy = listy + 1

    If listy / 8 = Int(listy / 8) Then

        listy = 26: listx = listx + 20

    End If

    Locate listy, listx: Print "(" + Chr$(96 + l) + ") " + word$(l)

Next l



Locate 23, 5: Print "Which word letter?"

Do

    pick:

    n$ = InKey$

    If n$ <> "" Then

        If n$ = "a" Or n$ = "A" Then n = 1

        If n$ = "b" Or n$ = "B" Then n = 2

        If n$ = "c" Or n$ = "C" Then n = 3

        If n$ = "d" Or n$ = "D" Then n = 4

        If n$ = "e" Or n$ = "E" Then n = 5

        If n$ = "f" Or n$ = "F" Then n = 6

        If n$ = "g" Or n$ = "G" Then n = 7

        If n$ = "h" Or n$ = "H" Then n = 8

        If n$ = "i" Or n$ = "I" Then n = 9

        If n$ = "j" Or n$ = "J" Then n = 10

        If n$ = "k" Or n$ = "K" Then n = 11

        If n$ = "l" Or n$ = "L" Then n = 12

        If n$ = "m" Or n$ = "M" Then n = 13

        If n$ = "n" Or n$ = "N" Then n = 14

        If n$ = "o" Or n$ = "O" Then n = 15

        If n$ = "p" Or n$ = "P" Then n = 16

        If n$ = "q" Or n$ = "Q" Then n = 17

        If n$ = "r" Or n$ = "R" Then n = 18

        If n$ = "s" Or n$ = "S" Then n = 19

        If n$ = "t" Or n$ = "T" Then n = 20

        If n$ = "u" Or n$ = "U" Then n = 21

        If n$ = "v" Or n$ = "V" Then n = 22

        If n$ = "w" Or n$ = "W" Then n = 23

        If n$ = "x" Or n$ = "X" Then n = 24

        If word$(n) = "" Then GoTo pick

        GoTo nex

    End If

Loop

nex:



For l = 1 To Len(word$(n))

    cx = x(n): cy = y(n)

    Select Case dir(n)

        Case 1: cx = x(n) + l ' Right

        Case 2: cx = x(n) - l ' Left

        Case 3: cy = y(n) + l ' Down

        Case 4: cy = y(n) - l ' Up

        Case 5: cx = x(n) + l: cy = y(n) + l ' Right-Down

        Case 6: cx = x(n) - l: cy = y(n) + l ' Left-Down

        Case 7: cx = x(n) - l: cy = y(n) - l ' Left-Up

        Case 8: cx = x(n) + l: cy = y(n) - l ' Right-Up

    End Select

    Locate cy + 5, (cx * 2) + 30

    Color _RGB32(255, 0, 0)

    Print grid$(cy, cx);

Next l

_Delay 5



For l = 1 To Len(word$(n))

    cx = x(n): cy = y(n)

    Select Case dir(n)

        Case 1: cx = x(n) + l ' Right

        Case 2: cx = x(n) - l ' Left

        Case 3: cy = y(n) + l ' Down

        Case 4: cy = y(n) - l ' Up

        Case 5: cx = x(n) + l: cy = y(n) + l ' Right-Down

        Case 6: cx = x(n) - l: cy = y(n) + l ' Left-Down

        Case 7: cx = x(n) - l: cy = y(n) - l ' Left-Up

        Case 8: cx = x(n) + l: cy = y(n) - l ' Right-Up

    End Select

    Locate cy + 5, (cx * 2) + 30

    Color _RGB32(0, 0, 0)

    Print grid$(cy, cx);

Next l



Locate 23, 5: Print "                        "



listx = 15: listy = 25

If num < 7 Then listx = 46

If num > 6 And num < 13 Then listx = 35

If num > 12 And num < 19 Then listx = 28

For l = 1 To num

    listy = listy + 1

    If listy / 8 = Int(listy / 8) Then

        listy = 26: listx = listx + 20

    End If

    Locate listy, listx: Print "                      "

    Locate listy, listx: Print word$(l)

Next l

n = 0

n$ = ""

Return



saving:



name$ = _InputBox$("Save", "Type a name of file to save without jpg ending.")

If name$ = "" Then GoTo saving

name$ = name$ + ".jpg"

Locate 1, 11: Print "                                                                                    "

_SaveImage name$

path$ = _FullPath$(name$)

_MessageBox "Saved", "Puzzle picture saved as " + name$ + " to " + path$

Locate 1, 11: Print "(A)nswer | (P)rint | (S)ave | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"

Return

Looking great, Ken.
I found it a bit confusing trying to start, from the menu, with a title ( the prompt is for Enter for no title).
Would it be useful to have a word- verification (maybe similar to mine in Alchemy) to check all words are "legal tender"?
Nice work!

[SierraKen]

Thanks @PhilofPerth Well, it does count the letters and if it's too long, it will have you do it again. What you see at the start isn't a menu, just instructions. The menu is after it is created and then you can do things with it. Or are you saying it must have a title? I made it so people that don't want a title can just press Enter so it won't show a title. People might want to make their own titles using a graphics program or something like that. I'm glad you like it!

[PhilOfPerth]

Ok, gotcha. Yes, you said it was instructions; I missed that.
What I meant for the word-checker is using a random-access file to check the word was a proper word.  It would take less than a second to check if the word was ok or not. It may not matter though, as the list of words will be given in the word-search anyway and it won't matter how they're spelled. Some may like to know they spelled the word correctly when creating it though, and that they spelled the word the same in the clue. The word checker can include word-length check as well.