Posts: 605
Threads: 107
Joined: Apr 2022
Reputation:
47
04-02-2025, 01:11 AM
(This post was last modified: 04-02-2025, 01:15 AM by SierraKen.)
This program makes an 18 x 18 word search grid using words you add in the beginning. You can use up to 24 words with words being up to 15 letters long. All of this is explained in the program. It also has printer support to print your puzzle and also clipboard support if you want to paste it into a graphics program, if you wish to save it or change it.
I've always wanted to make one of these but never could. I came incredibly close to making it all by myself today, had the right math pretty much and arrays, it just wasn't cleaned up enough so ChatGPT helped me a little bit with that.
Thank you to B+ on that code that rotates a picture before it prints it. I used that back when I did my Paint Pixels program so I got it from there. B+ used it on his Calendar Making program.
The program uses a white background with black text so it is much easier on your printer. I've tested this quite a few times and it seems to work fine with the 24 word limit. But if for some reason it hangs up and doesn't do anything, just close the app and start over, maybe using smaller words or less of them. It shouldn't though, I just added a fail-safe counter so if it tries too many times with 1 word, it tells you the word and tells you to start the puzzle over.
Tell me what you think, thanks.
Enjoy!
Code: (Select All)
| | | | | | | | | | | | | Dim word$(24), grid$(18, 18) | | | | Screen _NewImage(800, 600, 32) | | _Title "Word Search Maker - P to Print on Printer C to Clipboard Space Bar For Another One Esc to Quit" | | begin: | | t = 0: num = 0 | | 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 " P to Print on Printer." | | 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 | | 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. Only large letters are used:" | | 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$ | | For ii = 1 To Len(word$(w)) | | If Mid$(word$(w), ii, 1) < Chr$(65) Or Mid$(word$(w), ii, 1) > Chr$(90) Then | | Print " Only large letters used.": GoTo words | | End If | | Next ii | | Next w | | Cls | | Paint (1, 1), _RGB32(255, 255, 255) | | Color _RGB32(0, 0, 0), _RGB32(255, 255, 255) | | | | For y = 1 To 18 | | For x = 1 To 18 | | grid$(y, x) = "" | | Next x | | Next y | | | | 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 = Int(Rnd * 8) + 1 | | x = Int(Rnd * 18) + 1: y = Int(Rnd * 18) + 1 | | | | | | If dir = 1 And x + Len(word$(w)) > 18 Then GoTo placement | | If dir = 2 And x - Len(word$(w)) < 1 Then GoTo placement | | If dir = 3 And y + Len(word$(w)) > 18 Then GoTo placement | | If dir = 4 And y - Len(word$(w)) < 1 Then GoTo placement | | If dir = 5 And (x + Len(word$(w)) > 18 Or y + Len(word$(w)) > 18) Then GoTo placement | | If dir = 6 And (x - Len(word$(w)) < 1 Or y + Len(word$(w)) > 18) Then GoTo placement | | If dir = 7 And (x - Len(word$(w)) < 1 Or y - Len(word$(w)) < 1) Then GoTo placement | | If dir = 8 And (x + Len(word$(w)) > 18 Or y - Len(word$(w)) < 1) Then GoTo placement | | | | | | For l = 1 To Len(word$(w)) | | cx = x: cy = y | | If dir = 1 Then cx = x + l | | If dir = 2 Then cx = x - l | | If dir = 3 Then cy = y + l | | If dir = 4 Then cy = y - l | | If dir = 5 Then cx = x + l: cy = y + l | | If dir = 6 Then cx = x - l: cy = y + l | | If dir = 7 Then cx = x - l: cy = y - l | | If dir = 8 Then cx = x + l: cy = y - l | | | | If grid$(cy, cx) <> "" And grid$(cy, cx) <> Mid$(word$(w), l, 1) Then GoTo placement | | Next l | | | | | | For l = 1 To Len(word$(w)) | | cx = x: cy = y | | If dir = 1 Then cx = x + l | | If dir = 2 Then cx = x - l | | If dir = 3 Then cy = y + l | | If dir = 4 Then cy = y - l | | If dir = 5 Then cx = x + l: cy = y + l | | If dir = 6 Then cx = x - l: cy = y + l | | If dir = 7 Then cx = x - l: cy = y - l | | If dir = 8 Then cx = x + l: cy = y - l | | | | grid$(cy, cx) = Mid$(word$(w), l, 1) | | Next l | | t = 0 | | Next w | | | | | | 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 | | | | | | For y = 1 To 18 | | For x = 1 To 18 | | Locate y + 5, (x * 2) + 30: Print grid$(y, x); " "; | | Next x | | Print | | Next y | | | | listx = 15: listy = 25 | | 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 | | | | Do | | a$ = InKey$ | | If a$ = "c" Or a$ = "C" Then | | 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 4 | | For sz = 0 To 20 | | Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 255, 255), B | | Next sz | | _FreeImage landscape2& | | End If | | If a$ = "p" Or a$ = "P" Then | | | | 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& | | End If | | If a$ = " " Then GoTo begin | | If a$ = Chr$(27) Then End | | Loop | | |
Posts: 4,144
Threads: 187
Joined: Apr 2022
Reputation:
253
Posts: 605
Threads: 107
Joined: Apr 2022
Reputation:
47
Thanks B+! 
Posts: 695
Threads: 105
Joined: Apr 2022
Reputation:
25
(04-02-2025, 01:11 AM)SierraKen Wrote: This program makes an 18 x 18 word search grid using words you add in the beginning. You can use up to 24 words with words being up to 15 letters long. All of this is explained in the program. It also has printer support to print your puzzle and also clipboard support if you want to paste it into a graphics program, if you wish to save it or change it.
I've always wanted to make one of these but never could. I came incredibly close to making it all by myself today, had the right math pretty much and arrays, it just wasn't cleaned up enough so ChatGPT helped me a little bit with that.
Thank you to B+ on that code that rotates a picture before it prints it. I used that back when I did my Paint Pixels program so I got it from there. B+ used it on his Calendar Making program.
The program uses a white background with black text so it is much easier on your printer. I've tested this quite a few times and it seems to work fine with the 24 word limit. But if for some reason it hangs up and doesn't do anything, just close the app and start over, maybe using smaller words or less of them. It shouldn't though, I just added a fail-safe counter so if it tries too many times with 1 word, it tells you the word and tells you to start the puzzle over.
Tell me what you think, thanks.
Enjoy!
Code: (Select All)
| | | | | | | | | | | | | Dim word$(24), grid$(18, 18) | | | | Screen _NewImage(800, 600, 32) | | _Title "Word Search Maker - P to Print on Printer C to Clipboard Space Bar For Another One Esc to Quit" | | begin: | | t = 0: num = 0 | | 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 " P to Print on Printer." | | 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 | | 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. Only large letters are used:" | | 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$ | | For ii = 1 To Len(word$(w)) | | If Mid$(word$(w), ii, 1) < Chr$(65) Or Mid$(word$(w), ii, 1) > Chr$(90) Then | | Print " Only large letters used.": GoTo words | | End If | | Next ii | | Next w | | Cls | | Paint (1, 1), _RGB32(255, 255, 255) | | Color _RGB32(0, 0, 0), _RGB32(255, 255, 255) | | | | For y = 1 To 18 | | For x = 1 To 18 | | grid$(y, x) = "" | | Next x | | Next y | | | | 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 = Int(Rnd * 8) + 1 | | x = Int(Rnd * 18) + 1: y = Int(Rnd * 18) + 1 | | | | | | If dir = 1 And x + Len(word$(w)) > 18 Then GoTo placement | | If dir = 2 And x - Len(word$(w)) < 1 Then GoTo placement | | If dir = 3 And y + Len(word$(w)) > 18 Then GoTo placement | | If dir = 4 And y - Len(word$(w)) < 1 Then GoTo placement | | If dir = 5 And (x + Len(word$(w)) > 18 Or y + Len(word$(w)) > 18) Then GoTo placement | | If dir = 6 And (x - Len(word$(w)) < 1 Or y + Len(word$(w)) > 18) Then GoTo placement | | If dir = 7 And (x - Len(word$(w)) < 1 Or y - Len(word$(w)) < 1) Then GoTo placement | | If dir = 8 And (x + Len(word$(w)) > 18 Or y - Len(word$(w)) < 1) Then GoTo placement | | | | | | For l = 1 To Len(word$(w)) | | cx = x: cy = y | | If dir = 1 Then cx = x + l | | If dir = 2 Then cx = x - l | | If dir = 3 Then cy = y + l | | If dir = 4 Then cy = y - l | | If dir = 5 Then cx = x + l: cy = y + l | | If dir = 6 Then cx = x - l: cy = y + l | | If dir = 7 Then cx = x - l: cy = y - l | | If dir = 8 Then cx = x + l: cy = y - l | | | | If grid$(cy, cx) <> "" And grid$(cy, cx) <> Mid$(word$(w), l, 1) Then GoTo placement | | Next l | | | | | | For l = 1 To Len(word$(w)) | | cx = x: cy = y | | If dir = 1 Then cx = x + l | | If dir = 2 Then cx = x - l | | If dir = 3 Then cy = y + l | | If dir = 4 Then cy = y - l | | If dir = 5 Then cx = x + l: cy = y + l | | If dir = 6 Then cx = x - l: cy = y + l | | If dir = 7 Then cx = x - l: cy = y - l | | If dir = 8 Then cx = x + l: cy = y - l | | | | grid$(cy, cx) = Mid$(word$(w), l, 1) | | Next l | | t = 0 | | Next w | | | | | | 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 | | | | | | For y = 1 To 18 | | For x = 1 To 18 | | Locate y + 5, (x * 2) + 30: Print grid$(y, x); " "; | | Next x | | Print | | Next y | | | | listx = 15: listy = 25 | | 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 | | | | Do | | a$ = InKey$ | | If a$ = "c" Or a$ = "C" Then | | 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 4 | | For sz = 0 To 20 | | Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 255, 255), B | | Next sz | | _FreeImage landscape2& | | End If | | If a$ = "p" Or a$ = "P" Then | | | | 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& | | End If | | If a$ = " " Then GoTo begin | | If a$ = Chr$(27) Then End | | Loop | | |
Nice.
Maybe translate the words when input into Caps (letter$=ucase$(letter$) (for both setup and playing)? (avoids error message).
Posts: 605
Threads: 107
Joined: Apr 2022
Reputation:
47
(04-02-2025, 03:21 AM)PhilOfPerth Wrote: SierraKenThis program makes an 18 x 18 word search grid using words you add in the beginning. You can use up to 24 words with words being up to 15 letters long. All of this is explained in the program. It also has printer support to print your puzzle and also clipboard support if you want to paste it into a graphics program, if you wish to save it or change it.
I've always wanted to make one of these but never could. I came incredibly close to making it all by myself today, had the right math pretty much and arrays, it just wasn't cleaned up enough so ChatGPT helped me a little bit with that.
Thank you to B+ on that code that rotates a picture before it prints it. I used that back when I did my Paint Pixels program so I got it from there. B+ used it on his Calendar Making program.
The program uses a white background with black text so it is much easier on your printer. I've tested this quite a few times and it seems to work fine with the 24 word limit. But if for some reason it hangs up and doesn't do anything, just close the app and start over, maybe using smaller words or less of them. It shouldn't though, I just added a fail-safe counter so if it tries too many times with 1 word, it tells you the word and tells you to start the puzzle over.
Tell me what you think, thanks.
Enjoy!
Code: (Select All)
| | | | | | | | | | | | | Dim word$(24), grid$(18, 18) | | | | Screen _NewImage(800, 600, 32) | | _Title "Word Search Maker - P to Print on Printer C to Clipboard Space Bar For Another One Esc to Quit" | | begin: | | t = 0: num = 0 | | 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 " P to Print on Printer." | | 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 | | 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. Only large letters are used:" | | 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$ | | For ii = 1 To Len(word$(w)) | | If Mid$(word$(w), ii, 1) < Chr$(65) Or Mid$(word$(w), ii, 1) > Chr$(90) Then | | Print " Only large letters used.": GoTo words | | End If | | Next ii | | Next w | | Cls | | Paint (1, 1), _RGB32(255, 255, 255) | | Color _RGB32(0, 0, 0), _RGB32(255, 255, 255) | | | | For y = 1 To 18 | | For x = 1 To 18 | | grid$(y, x) = "" | | Next x | | Next y | | | | 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 = Int(Rnd * 8) + 1 | | x = Int(Rnd * 18) + 1: y = Int(Rnd * 18) + 1 | | | | | | If dir = 1 And x + Len(word$(w)) > 18 Then GoTo placement | | If dir = 2 And x - Len(word$(w)) < 1 Then GoTo placement | | If dir = 3 And y + Len(word$(w)) > 18 Then GoTo placement | | If dir = 4 And y - Len(word$(w)) < 1 Then GoTo placement | | If dir = 5 And (x + Len(word$(w)) > 18 Or y + Len(word$(w)) > 18) Then GoTo placement | | If dir = 6 And (x - Len(word$(w)) < 1 Or y + Len(word$(w)) > 18) Then GoTo placement | | If dir = 7 And (x - Len(word$(w)) < 1 Or y - Len(word$(w)) < 1) Then GoTo placement | | If dir = 8 And (x + Len(word$(w)) > 18 Or y - Len(word$(w)) < 1) Then GoTo placement | | | | | | For l = 1 To Len(word$(w)) | | cx = x: cy = y | | If dir = 1 Then cx = x + l | | If dir = 2 Then cx = x - l | | If dir = 3 Then cy = y + l | | If dir = 4 Then cy = y - l | | If dir = 5 Then cx = x + l: cy = y + l | | If dir = 6 Then cx = x - l: cy = y + l | | If dir = 7 Then cx = x - l: cy = y - l | | If dir = 8 Then cx = x + l: cy = y - l | | | | If grid$(cy, cx) <> "" And grid$(cy, cx) <> Mid$(word$(w), l, 1) Then GoTo placement | | Next l | | | | | | For l = 1 To Len(word$(w)) | | cx = x: cy = y | | If dir = 1 Then cx = x + l | | If dir = 2 Then cx = x - l | | If dir = 3 Then cy = y + l | | If dir = 4 Then cy = y - l | | If dir = 5 Then cx = x + l: cy = y + l | | If dir = 6 Then cx = x - l: cy = y + l | | If dir = 7 Then cx = x - l: cy = y - l | | If dir = 8 Then cx = x + l: cy = y - l | | | | grid$(cy, cx) = Mid$(word$(w), l, 1) | | Next l | | t = 0 | | Next w | | | | | | 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 | | | | | | For y = 1 To 18 | | For x = 1 To 18 | | Locate y + 5, (x * 2) + 30: Print grid$(y, x); " "; | | Next x | | Print | | Next y | | | | listx = 15: listy = 25 | | 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 | | | | Do | | a$ = InKey$ | | If a$ = "c" Or a$ = "C" Then | | 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 4 | | For sz = 0 To 20 | | Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 255, 255), B | | Next sz | | _FreeImage landscape2& | | End If | | If a$ = "p" Or a$ = "P" Then | | | | 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& | | End If | | If a$ = " " Then GoTo begin | | If a$ = Chr$(27) Then End | | Loop | | |
Nice.
Maybe translate the words when input into Caps (letter$=ucase$(letter$) (for both setup and playing)? (avoids error message). Yeah I tried that at first, but then I thought about numbers and symbols, and there's a couple symbols between the lower and upper case, so I would have to work around all of that. I might still do it, we'll see. Thanks!
Posts: 605
Threads: 107
Joined: Apr 2022
Reputation:
47
Now you can use small letters as well, it will just convert them to large letters automatically. Thanks Phil for the idea! It was easier than I thought. I tested it with all the symbols and numbers too, which just lets you type the word again.
Code: (Select All)
| | | | | | | | | | | | | Dim word$(24), grid$(18, 18) | | | | Screen _NewImage(800, 600, 32) | | _Title "Word Search Maker - P to Print on Printer C to Clipboard Space Bar For Another One Esc to Quit" | | begin: | | t = 0: num = 0 | | 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 " P to Print on Printer." | | 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 | | 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$ | | | | 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) | | | | For y = 1 To 18 | | For x = 1 To 18 | | grid$(y, x) = "" | | Next x | | Next y | | | | 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 = Int(Rnd * 8) + 1 | | x = Int(Rnd * 18) + 1: y = Int(Rnd * 18) + 1 | | | | | | If dir = 1 And x + Len(word$(w)) > 18 Then GoTo placement | | If dir = 2 And x - Len(word$(w)) < 1 Then GoTo placement | | If dir = 3 And y + Len(word$(w)) > 18 Then GoTo placement | | If dir = 4 And y - Len(word$(w)) < 1 Then GoTo placement | | If dir = 5 And (x + Len(word$(w)) > 18 Or y + Len(word$(w)) > 18) Then GoTo placement | | If dir = 6 And (x - Len(word$(w)) < 1 Or y + Len(word$(w)) > 18) Then GoTo placement | | If dir = 7 And (x - Len(word$(w)) < 1 Or y - Len(word$(w)) < 1) Then GoTo placement | | If dir = 8 And (x + Len(word$(w)) > 18 Or y - Len(word$(w)) < 1) Then GoTo placement | | | | | | For l = 1 To Len(word$(w)) | | cx = x: cy = y | | If dir = 1 Then cx = x + l | | If dir = 2 Then cx = x - l | | If dir = 3 Then cy = y + l | | If dir = 4 Then cy = y - l | | If dir = 5 Then cx = x + l: cy = y + l | | If dir = 6 Then cx = x - l: cy = y + l | | If dir = 7 Then cx = x - l: cy = y - l | | If dir = 8 Then cx = x + l: cy = y - l | | | | If grid$(cy, cx) <> "" And grid$(cy, cx) <> Mid$(word$(w), l, 1) Then GoTo placement | | Next l | | | | | | For l = 1 To Len(word$(w)) | | cx = x: cy = y | | If dir = 1 Then cx = x + l | | If dir = 2 Then cx = x - l | | If dir = 3 Then cy = y + l | | If dir = 4 Then cy = y - l | | If dir = 5 Then cx = x + l: cy = y + l | | If dir = 6 Then cx = x - l: cy = y + l | | If dir = 7 Then cx = x - l: cy = y - l | | If dir = 8 Then cx = x + l: cy = y - l | | | | grid$(cy, cx) = Mid$(word$(w), l, 1) | | Next l | | t = 0 | | Next w | | | | | | 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 | | | | | | For y = 1 To 18 | | For x = 1 To 18 | | Locate y + 5, (x * 2) + 30: Print grid$(y, x); " "; | | Next x | | Print | | Next y | | | | listx = 15: listy = 25 | | 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 | | | | Do | | a$ = InKey$ | | If a$ = "c" Or a$ = "C" Then | | 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 4 | | For sz = 0 To 20 | | Line (sz, sz)-(800 - sz, 600 - sz), _RGB32(255, 255, 255), B | | Next sz | | _FreeImage landscape2& | | End If | | If a$ = "p" Or a$ = "P" Then | | | | 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& | | End If | | If a$ = " " Then GoTo begin | | If a$ = Chr$(27) Then End | | Loop | | |
Posts: 4,144
Threads: 187
Joined: Apr 2022
Reputation:
253
Ken have you thought about displaying a solution if a person can't find the word?
b = b + ...
Posts: 605
Threads: 107
Joined: Apr 2022
Reputation:
47
Yeah I've thought about it briefly. I might look into it. Thanks. 
Posts: 605
Threads: 107
Joined: Apr 2022
Reputation:
47
04-02-2025, 06:46 PM
(This post was last modified: 04-02-2025, 07:11 PM by SierraKen.)
Now it will show the answer to a word when you press A, then a number of a word on the list. It will light up the answer in red for 5 seconds, then it will go back to the regular puzzle. Thanks B+ for the idea!
I almost did it completely myself again. I got it down where it lit up just the first letter of the word. But I couldn't figure out the rest so I went to chatgpt again. It was so simple, I almost fell over in my chair lol. It uses SELECT CASE which I really need to practice on. But it works now! I added a few things chatgpt didn't tell me, like making it inkey$ (and VAL) instead of input and also going back to the main puzzle after 5 seconds, as well as the numbers on the list.
I hope you all enjoy it as much as I had making this. Tell me what you think, thanks.
(Code Deleted, please go to next page for the fix, thank you.)
Posts: 4,144
Threads: 187
Joined: Apr 2022
Reputation:
253
My idea was to copy the puzzle before you filled it in with junk, lets see what you and Chat came up with
b = b + ...
|
