+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Word Search Maker (/showthread.php?tid=3579)
RE: Word Search Maker - SierraKen - 04-02-2025
Well, I messed up. People can't use INKEY$ because there could be more than 9 words, so I changed it back to INPUT.
Here is the fix:
Code: (Select All)
'Word Search Maker by SierraKen
'April 1, 2025
'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.
Dim word$(24), grid$(18, 18), dir(24), x(24), y(24)
Screen _NewImage(800, 600, 32)
_Title "Word Search Maker - A to see Answer 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 " A to see an Answer to a Word."
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$ ' Only assign if temp$ changed
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
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) + 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$ = "a" Or a$ = "A" Then GoSub answers
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
'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&
End If
If a$ = " " Then GoTo begin
If a$ = Chr$(27) Then End
Loop
answers:
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 Str$(l) + ". " + word$(l)
Next l
Locate 23, 5: Input "Which word number? ", n
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
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
Return
B+, with my memory problems, I like it this way better. If I saw all the answers in the beginning and then tried to remember, it would be pretty rough.
RE: Word Search Maker - bplus - 04-02-2025
Uh, tell me again why you have to use Inkey$ ? why not input the number?
Oh you seem to have a menu attempting 2 different things... all I played with is just getting a puzzle.
RE: Word Search Maker - SierraKen - 04-02-2025
Bplus, if you didn't get the update above, please get it. I can't have INKEY because there's more than 9 words when choosing which word you want to see the answer to.
I'm actually surprised I made this, even with the help of chatgpt, because I haven't felt too great lately. But I like it.
RE: Word Search Maker - bplus - 04-02-2025
Well I like it too and I didn't mean to hassle you with Inkey$ thing. You should not feel too great more often if this is typical result
RE: Word Search Maker - SierraKen - 04-02-2025
LOL thanks B+. I know.... I get all excited when I get really close to finishing and then something goes wrong and it's like UGH!!! LOL
In the 1990's I had one of the best QBasic websites online in Geocities. Then I went to ASIC 5.0 and was like the 2nd or 3rd website of those programs online. But I got too stressed when I ran into a problem and stayed up past midnight (in my younger years), so I gave up programming back then, until I found you guys around 6 years ago.
I just gotta give myself more time and there's really no pressure. There never has been with you guys which I've always appreciated.
With my PTSD and other head injury problems, I have to remind myself that this is just a hobby.
RE: Word Search Maker - PhilOfPerth - 04-03-2025
(04-02-2025, 07:49 PM)SierraKen Wrote: Bplus, if you didn't get the update above, please get it. I can't have INKEY because there's more than 9 words when choosing which word you want to see the answer to.
I'm actually surprised I made this, even with the help of chatgpt, because I haven't felt too great lately. But I like it.
Dunno if it's essential, but inkey$ is certainly simpler to use. An option would be to use alpha instead of numeric for items, then you could have up to 26 options.
RE: Word Search Maker - SierraKen - 04-03-2025
Phil, I've never made inkey$ where you have to press the keyboard twice for 1 number. It would be impossible because let's say you want to see word 14, but you press 1 and that would give you word 1.
Also, UCASE doesn't work with numbers and symbols, I had to work around them to grab letters, then I do use UCASE to make all letters uppercase.
RE: Word Search Maker - PhilOfPerth - 04-03-2025
(04-03-2025, 01:19 AM)SierraKen Wrote: Phil, I've never made inkey$ where you have to press the keyboard twice for 1 number. It would be impossible because let's say you want to see word 14, but you press 1 and that would give you word 1.
Also, UCASE doesn't work with numbers and symbols, I had to work around them to grab letters, then I do use UCASE to make all letters uppercase.
What I meant was, instead of pressing "14" you would press "n"
And to filter to only alpha, if everything is UCase$ (including punctuations, which remain unchanged), you could use " if letter>64 and letter<91..."
RE: Word Search Maker - SierraKen - 04-03-2025
Wow thanks Phil! Instead of numbers for the words I used letters like you said, with INKEY$ and it works great! I also had to add loop at the beginning to clear all the words for people that want to make more than 1 puzzle.
Here is an update folks, thank you for your patience.
Code: (Select All)
'Word Search Maker by SierraKen
'April 2, 2025
'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.
Dim word$(24), grid$(18, 18), dir(24), x(24), y(24)
Screen _NewImage(800, 600, 32)
_Title "Word Search Maker - A to see Answer P to Print on Printer C to Clipboard Space Bar For Another One Esc to Quit"
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 " A to see an Answer to a Word."
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$ ' Only assign if temp$ changed
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
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) + 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$ = "a" Or a$ = "A" Then GoSub answers
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
'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&
End If
If a$ = " " Then GoTo begin
If a$ = Chr$(27) Then End
Loop
answers:
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 "(" + 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
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
RE: Word Search Maker - SierraKen - 04-03-2025
Phil gave me another great idea, to put the instructions on the regular window so people can see them better. So I did that and removed them off the _TITLE bar and when people copy the image or print it, the instructions will be removed off the regular window automatically and then afterward they are placed back.
Thanks Phil!
Here is the update:
Code: (Select All)
'Word Search Maker by SierraKen
'April 2, 2025
'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.
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 " A to see an Answer to a Word."
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$ ' Only assign if temp$ changed
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
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) + 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
Locate 1, 15: Print "(A)nswer | (P)rint | (C)opy | (Space Bar) For New Puzzle | (Esc) To Quit"
Do
a$ = InKey$
If a$ = "a" Or a$ = "A" Then GoSub answers
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, 15: Print "(A)nswer | (P)rint | (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, 15: Print "(A)nswer | (P)rint | (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
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
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