To celebrate upcoming Valentines Day I will share my luv of Snoopy and Woodstock cartoons as a Demo for updated:
Sudoku with Images 2026-01-21
You can collect your own images and name them d1.PNG thru d9.PNG for your own custom Sudoku with Images 2026-01-21 version! The images need to be simple subject and it helps to vary background color between images so you can tell in notes of cells which image they are (for very small image notes); nine fit and are ordered in cell notes thusly:
1 2 3
4 5 6
7 8 9 the digits represent the d1 to d9 images ie, if you cant tell the tiny image you can deduce the number by it's position in the cell. Image for digit 1 is in top left of cell and like wise the image for digit 9 is noted in the bottom right of the cell.
Code: (Select All)
_Title "Sudoku with Images 2026-01-21" 'b+
' from Sudoku with Images B+ restart 2019-05-04 from SB port. Yeah! for _SETALPHA first time I used it.
' 2020-11-26 2020-xmas version with Christmas Images massive overhaul for new screen, dumped code notes and constants except:
' 2020-12-20 just renamed the 2020 Christmas version, check if file exists beofre attempting a load.
' 2022-08-26 fix the size of the screen height
' 2025-09-21 halloween version
' 2026-01-21 updated to demo set of Snoopy and Woodstock snaps
Const ScreenWidth = 1024, ScreenHeight = 700
Screen _NewImage(ScreenWidth, ScreenHeight, 32)
_Delay .25
_ScreenMove 190, 0
DefLng A-Z
Randomize Timer
Dim Shared BoardX, BoardY, ImageN, UpdateFlag, Level, Mode$, CheckCellFill, SolnF, ShowSolnF
Dim Shared Grid(8, 8), Temp(8, 8), Notes$(8, 8), Soln(8, 8)
ReDim Shared DigitImage(1 To 9) As Long
$ExeIcon:'./ico sudoku.ico'
temp& = _LoadImage("ico sudoku.png")
_Icon temp&
_FreeImage temp&
'load special xmas images, that reps each digit in grid
For i = 1 To 9
DigitImage(i) = _LoadImage("d" + TS$(i) + ".png")
Next
'main loop sets up game puzzle, mainly gets level and clears variables from last puzzle run
While 1
getLevel ' This is Help/Intro screen
' globals SETUP for Game or Make Puzzle
BoardX = 0: BoardY = 0 ' current highlighted location on board
ImageN = 1 ' current key highlighted on keyPad, key = 0 clears cell
UpdateFlag = 1 ' when to show game board
Mode$ = "p" ' 2 modes: p for puzzle and m for make puzzle
CheckCellFill = 1 ' checkCellFill mode will check cell fills for blunders ie already in row, col or block
' the h key or the checkCellFill Menu function will Toggle this feature on/off
Erase Grid ' 9x9 board positive values are puzzle clues
' 0 value in grid is blank cell to fill out
' neg values in grid are players guesses to solve puzzle
Erase Notes$
makeGrid
hideCells2
While 1 'begin the game
If UpdateFlag Then showGrid
k$ = InKey$
If Len(k$) Then
UpdateFlag = 1
If Len(k$) = 1 Then
If k$ = " " Then
If ShowSolnF Then ShowSolnF = 0 Else ShowSolnF = 1
ElseIf k$ = "c" Then
If CheckCellFill Then CheckCellFill = 0 Else CheckCellFill = 1
ElseIf k$ = "m" Or k$ = "p" Then
If Mode$ = "m" Then Mode$ = "p" Else Mode$ = "m"
UpdateFlag = 1
If Mode$ = "m" Then 'convert grid to all positive values
For row = 0 To 8
For col = 0 To 8
Grid(col, row) = Abs(Grid(col, row))
Next
Next
SolnF = 0
ShowSolnF = 0
Erase Soln
End If
ElseIf k$ = "s" Then
savePZ
ElseIf k$ = "l" Then
loadPZ
ElseIf k$ = "x" Then
Exit While
ElseIf InStr("0123456789", k$) Then
handleNumber Val(k$)
ElseIf Asc(k$) = 27 Then
Cls: End
Else
kpos = InStr("!@#$%^&*()", k$)
If kpos > 0 Then handleNote _Trim$(Str$(kpos Mod 10)) Else UpdateFlag = 0
End If
ElseIf Len(k$) = 2 Then
Select Case Asc(Right$(k$, 1))
Case 72: If BoardY > 0 Then BoardY = BoardY - 1 'up arrow
Case 80: If BoardY < 8 Then BoardY = BoardY + 1 'down arrow
Case 75: If BoardX > 0 Then BoardX = BoardX - 1 'left arrow
Case 77: If BoardX < 8 Then BoardX = BoardX + 1 'right arrow
Case Else: UpdateFlag = 0
End Select
End If
End If
'get next mouse click, check if in board and if so update x, y
m = _MouseInput: mb1 = _MouseButton(1): mb2 = _MouseButton(2): mx = _MouseX: my = _MouseY
mb = mb1 Or mb2
If mb Then 'get last place mouse button was down
mb = _MouseButton(1) Or _MouseButton(2): mx = _MouseX: my = _MouseY
mb1 = _MouseButton(1): mb2 = _MouseButton(2):
While mb 'left button down, wait for mouse button release
m = _MouseInput: mx = _MouseX: my = _MouseY
mb = _MouseButton(1) Or _MouseButton(2)
Wend
'clicked inside Board?
If mx <= 700 And my <= 700 Then
BoardX = Int((mx - 8) / 76): BoardY = Int((my - 8) / 76)
If mb1 Then handleNumber ImageN: UpdateFlag = 1
If mb2 Then handleNote _Trim$(Str$(ImageN)): UpdateFlag = 1
End If
'clicked inside keyPad?
If ScreenWidth - 85 <= mx And mx <= ScreenWidth - 10 Then
ImageN = Int(my / 70): UpdateFlag = 1
End If
If mx >= ScreenWidth - 293 And mx <= ScreenWidth - 93 Then
If my >= ScreenHeight - 480 And my <= ScreenHeight - 430 Then
UpdateFlag = 1: Exit While 'Help & level change
ElseIf my > ScreenHeight - 400 And my <= ScreenHeight - 350 Then
UpdateFlag = 1: If ShowSolnF Then ShowSolnF = 0 Else ShowSolnF = -1
ElseIf my >= ScreenHeight - 320 And my <= ScreenHeight - 270 Then
UpdateFlag = 1: If CheckCellFill Then CheckCellFill = 0 Else CheckCellFill = -1
ElseIf my >= ScreenHeight - 240 And my <= ScreenHeight - 190 Then
UpdateFlag = 1: If Mode$ = "m" Then Mode$ = "p" Else Mode$ = "m"
If Mode$ = "m" Then
For row = 0 To 8
For col = 0 To 8
Grid(col, row) = Abs(Grid(col, row))
Next
Next
SolnF = 0
ShowSolnF = 0
Erase Soln
End If
ElseIf my >= ScreenHeight - 160 And my <= ScreenHeight - 110 Then
UpdateFlag = 1: savePZ
ElseIf my >= ScreenHeight - 80 And my <= ScreenHeight - 30 Then
UpdateFlag = 1: loadPZ
End If 'my in menu range
End If ' mx in menu range
End If ' mb click
_Display
_Limit 400 '? save fan?
Wend
Wend
Sub handleNumber (ky)
If Mode$ = "m" And ky = 0 Then
Grid(BoardX, BoardY) = 0
ElseIf Mode$ = "m" And ky <> 0 Then
temp = Grid(BoardX, BoardY)
Grid(BoardX, BoardY) = 0 'aok needs to see an emptry cell to check if a is OK
If aok(ky, BoardX, BoardY) Then
Grid(BoardX, BoardY) = ky
Else
Beep: Grid(BoardX, BoardY) = temp
End If
ElseIf Mode$ = "p" And Grid(BoardX, BoardY) <= 0 Then 'don't change clues!
temp = Grid(BoardX, BoardY)
Grid(BoardX, BoardY) = 0 'aok needs to see an emptry cell to check if a is OK
If ky = 0 Then
Grid(BoardX, BoardY) = 0
ElseIf CheckCellFill <> 0 Then 'checkCellFill on
If aok(ky, BoardX, BoardY) Then
Grid(BoardX, BoardY) = -ky
Else
Beep: Grid(BoardX, BoardY) = temp
End If
ElseIf CheckCellFill = 0 Then 'allow blunders
Grid(BoardX, BoardY) = -ky
End If
ElseIf Mode$ = "p" And Grid(BoardX, BoardY) > 0 Then 'don't change clues!
Beep
End If
End Sub
Sub handleNote (ky$)
If ky$ = "0" Then 'clear notes for cell
Notes$(BoardX, BoardY) = ""
Else 'toggle numbers
find = InStr(Notes$(BoardX, BoardY), ky$)
If find > 0 Then 'if find it erase
If find = 1 Then
Notes$(BoardX, BoardY) = Mid$(Notes$(BoardX, BoardY), find + 1)
ElseIf find > 1 Then
Notes$(BoardX, BoardY) = Mid$(Notes$(BoardX, BoardY), 1, find - 1) + Mid$(Notes$(BoardX, BoardY), find + 1)
End If
Else 'if don't find it add it
Notes$(BoardX, BoardY) = Notes$(BoardX, BoardY) + ky$
End If
End If
End Sub
Function solved ()
solved = 0 'n must be found in every column, row and 3x3 cell
For n = 1 To 9
'check columns for n
For col = 0 To 8
found = 0
For row = 0 To 8
If Abs(Grid(col, row)) = n Then found = 1: Exit For
Next
If found = 0 Then Exit Function
Next
'check rows for n
For row = 0 To 8
found = 0
For col = 0 To 8
If Abs(Grid(col, row)) = n Then found = 1: Exit For
Next
If found = 0 Then Exit Function
Next
'check 3x3 cells for n
For cell = 0 To 8
cellcol = cell Mod 3
cellrow = Int(cell / 3)
found = 0
For col = 0 To 2
For row = 0 To 2
If Abs(Grid(cellcol * 3 + col, cellrow * 3 + row)) = n Then found = 1: Exit For
Next
If found = 1 Then Exit For
Next
If found = 0 Then Exit Function
Next
Next
solved = 1
End Function
Sub showGrid () 'complete update of entire screen
' grid numbers ScreenHeight = 725 outside 0,0 - 723, 723 that 720 pixels + 2 for each border edge
' 9 squares inside boreder are 240x240 also 2 pixels wide 0 step 80
' cells are 80, 80 start at 3
Dim main9 As _Unsigned Long, blankCell As _Unsigned Long, cellGrid As _Unsigned Long
Dim i, x, y, r, c
main9 = &HFF000088: blankCell = &HFFFFFFFF: cellGrid = &HFFFFFF00 'grid colors
UpdateFlag = 0 'global calls for this display set back to 0
Color &HFFFFFFFF, &HFF880000: Cls
'draw grid first
For i = 1 To 684 Step 76
Line (i + 8, 0 + 8)-Step(2, 684), cellGrid, BF
Line (0 + 8, i + 8)-Step(684, 2), cellGrid, BF
Next
For i = 0 To 720 Step 228
Line (i + 8, 0 + 8)-Step(2, 687), main9, BF
Line (0 + 8, i + 8)-Step(687, 2), main9, BF
Next
' panels LINE (c * 80 + 3, r * 80 + 3)-STEP(77, 77), blankCell, BF 'blank
For y = 0 To 8
For x = 0 To 8
If Grid(x, y) <> 0 Then 'show image for digit
_PutImage (x * 76 + 3 + 8, y * 76 + 3 + 8)-Step(73, 73), DigitImage(Abs(Grid(x, y))), 0
If Grid(x, y) < 0 Then Line (x * 76 + 3 + 8, y * 76 + 3 + 8)-Step(73, 73), &H44008800, BF 'tint the clues
Else
Line (x * 76 + 3 + 8, y * 76 + 3 + 8)-Step(73, 73), blankCell, BF 'blank background
If Notes$(x, y) <> "" Then
For i = 1 To Len(Notes$(x, y)) 'read the digits and position in cell
d = Val(Mid$(Notes$(x, y), i, 1))
r = Int((d - 1) / 3): c = (d - 1) Mod 3
_PutImage (x * 76 + 3 + 8 + c * 24, y * 76 + 3 + 8 + r * 24)-Step(23, 23), DigitImage(d), 0
Next
End If
End If
'highlite?
If x = BoardX And y = BoardY Then 'BoardX, BoardY cursor in grid
Line (x * 76 + 4 + 8, y * 76 + 4 + 8)-Step(71, 71), &HAAFF0000, BF 'blank background
End If
Next
Next
If ShowSolnF Then 'layer solution over everything else as transparency
' to set transparencies of imagesuse: _SETALPHA alphalevel 0_255&, c1 TO c1, handle&
If SolnF Then 'show it
For i = 1 To 9
_SetAlpha 80, , DigitImage(i)
Next
For y = 0 To 8
For x = 0 To 8
If Grid(x, y) <= 0 Then
_PutImage (x * 76 + 3 + 8, y * 76 + 3 + 8)-Step(73, 73), DigitImage(Abs(Soln(x, y))), 0
End If
Next
Next
For i = 1 To 9
_SetAlpha 255, , DigitImage(i)
Next
End If
End If
For i = 0 To 9 'image buttons
If i = 0 Then
Line (ScreenWidth - 85, i * 70)-Step(68, 68), &HFFFFFFFF, BF
Else
_PutImage (ScreenWidth - 85, i * 70)-Step(68, 68), DigitImage(i), 0
End If
Color &HFF880000, &H00000000
_PrintString (ScreenWidth - 85 + 5, i * 70 + 2), TS$(i)
If ImageN = i Then Line (ScreenWidth - 85 + 1, i * 70 + 1)-Step(66, 66), &H55FF0000, BF 'highlite
Color &HFFFFFFFF, &HFF880000
Next
' x = 293 + 200 y = ScreenHeight - 80 * ( 7- i) Menu Buttons
If Level = -1 Then
drwBtn ScreenWidth - 293, ScreenHeight - 480, "Help & Level - file load"
Else
drwBtn ScreenWidth - 293, ScreenHeight - 480, "Help & Level - " + TS$(Level)
End If
If ShowSolnF Then
drwBtn ScreenWidth - 293, ScreenHeight - 400, "Show Solution - ON"
Else
drwBtn ScreenWidth - 293, ScreenHeight - 400, "Show Solution - OFF"
End If
If CheckCellFill Then
drwBtn ScreenWidth - 293, ScreenHeight - 320, "Cell Checking - ON"
Else
drwBtn ScreenWidth - 293, ScreenHeight - 320, "Cell Checking - OFF"
End If
If Mode$ = "m" Then
drwBtn ScreenWidth - 293, ScreenHeight - 240, "Mode = Make Grid"
Else
drwBtn ScreenWidth - 293, ScreenHeight - 240, "Mode = Play!"
End If
drwBtn ScreenWidth - 293, ScreenHeight - 160, "File Save"
drwBtn ScreenWidth - 293, ScreenHeight - 80, "File Load"
If solved Then
Color &HFFFFFFFF, &HFF880000
s$ = "Puzzle Solved!"
_PrintString (ScreenWidth - 247, ScreenHeight - 560), s$
End If
_Display
End Sub
Sub makeGrid 'this version requires the assistance of loadBox sub routine
Do
Erase Grid, Temp
startOver = 0
For n = 1 To 9
For r = 0 To 8
For c = 0 To 8
Temp(c, r) = Grid(c, r)
Next
Next
cnt = 0
Do
For cellBlock = 0 To 8
success = loadBox(n, cellBlock)
If success = 0 Then
cnt = cnt + 1 'EDIT remove the counters used to test code tCnt and tStartOver
If cnt >= 20 Then startOver = 1: Exit For
For r = 0 To 8
For c = 0 To 8
Grid(c, r) = Temp(c, r)
Next
Next
Exit For
End If
Next
If startOver Then Exit Do
Loop Until success
If startOver Then Exit For
Next
Loop Until startOver = 0
'make a copy of grid as soln()
For r = 0 To 8
For c = 0 To 8
Soln(c, r) = Grid(c, r)
Next
Next
solnFlag = 1
End Sub
Sub hideCells2
'Unique Puzzle make a 2nd resolve that starts at different n's
' I think if the puzzle is not unique a different puzzle will be created for at least 1 of the n Starts
' that would indicate not to hide that cell
' 1. so save the solution after makeGrid (makeGrid does that now)
' 2. hide a cell
' 3. test 9 different startNs resolve2(startN)
' 4. if any produce a different solution than puzzle grid solution, don't hide that cell
' else hide that cell and find another in loop until the required number of cells to hide is met.
' Man that is allot of coding and I am not sure it will work
'CLS
'PRINT "level * 9"; level * 9
'INPUT "OK press enter... "; wate$
If Level = 9 Then
Erase Grid
Erase Soln
SolnF = 0
ShowSolnF = 0
Mode$ = "m"
Else
'make copy of grid/soln
If Level = 8 Then
stopHiding = 57
ElseIf Level = 7 Then
stopHiding = 54
ElseIf Level = 6 Then
stopHiding = 50
Else
stopHiding = Level * 9
End If
startOver:
startOver = startOver + 1
If startOver Mod 2 = 0 Then
stopHiding = stopHiding - 1
End If
For r = 0 To 8
For c = 0 To 8
Grid(c, r) = Soln(c, r)
Next
Next
hidden = 0
fails = 0
'debug
'CLS
'PRINT "Level:"; level
'PRINT "Start Overs"; startOver
'PRINT "Number of cells hiding:"; stopHiding
'INPUT "OK press enter.. "; wate$
While hidden < stopHiding
hr = Int(Rnd * 9): hc = Int(Rnd * 9)
While Grid(hc, hr) = 0
hr = Int(Rnd * 9): hc = Int(Rnd * 9)
Wend
saveCellValue = Grid(hc, hr)
Grid(hc, hr) = 0
hideCellFail = 0
For ns = 1 To 9
resolve2 ns 'this sould solve everytime no matter where start N
If solved Then 'compare to solution
For r = 0 To 8
For c = 0 To 8
If Soln(c, r) <> Abs(Grid(c, r)) Then
hideCellFail = 1: Exit For
End If
Next
If hideCellFail Then Exit For
Next
'restore grid to pretest conditions
For r = 0 To 8
For c = 0 To 8
If Grid(c, r) < 0 Then Grid(c, r) = 0
Next
Next
If hideCellFail Then Exit For
Else 'this has never happened in all my testing
'big error
Cls
Print "Resolve2 failed to get to a solution while hiding cells. bye!"
Input "Press enter to end... "; wate$
End
End If
Next
If hideCellFail Then
Grid(hc, hr) = saveCellValue 'restore value
fails = fails + 1
'PRINT fails
If fails > 50 Then
GoTo startOver
End If
'PRINT "Hide Cell Failed."
'INPUT " OK press enter to cont... "; wate$
Else
hidden = hidden + 1 'yeah a cell is hidden
'PRINT "Hidden "; hidden
'INPUT "OK press enter... "; wate$
End If
Wend
SolnF = 1
End If
End Sub
Function loadBox (n, box) 'this one uses aok function to help load boxes
xoff = 3 * (box Mod 3): yoff = 3 * Int(box / 3)
'make a list of free cells in cellblock
Dim clist(8)
For y = 0 To 2 'make list of cells available
For x = 0 To 2 'find open cell in cellBlock first
If aok(n, xoff + x, yoff + y) Then available = available + 1: clist(3 * y + x) = 1
Next
Next
If available = 0 Then
Exit Function
End If
Dim cell(1 To available): pointer = 1
For i = 0 To 8
If clist(i) Then cell(pointer) = i: pointer = pointer + 1
Next
'OK our list has cells available to load, pick one randomly
If available > 1 Then 'shuffle cells
For i = available To 2 Step -1
r = Int(Rnd * i) + 1
Swap cell(i), cell(r)
Next
End If
'load the first one listed
Grid(xoff + (cell(1) Mod 3), yoff + Int(cell(1) / 3)) = n
loadBox = 1
End Function
Sub savePZ
fName$ = "Temp Saved Puzzle.txt"
Open fName$ For Output As #1
For r = 0 To 8
For c = 0 To 8
Print #1, Notes$(r, c)
Next
Next
Print #1, "---"
For r = 0 To 8
s$ = ""
For c = 0 To 8
s$ = s$ + Right$(" " + Str$(Grid(c, r)), 3)
Next
Print #1, s$
Next
Print #1, "---"
If SolnF Then
For r = 0 To 8
s$ = ""
For c = 0 To 8
s$ = s$ + Right$(" " + Str$(Soln(c, r)), 3)
Next
Print #1, s$
Next
End If
Close #1
showGrid
Color &HFFFFFFFF, &HFF880000
_PrintString (ScreenWidth - 247, ScreenHeight - 560), Space$(15)
s$ = "Puzzle Saved"
_PrintString (ScreenWidth - 247, ScreenHeight - 560), s$
End Sub
Sub loadPZ ()
If _FileExists("Temp Saved Puzzle.txt") Then
Open "Temp Saved Puzzle.txt" For Input As #1
For r = 0 To 8
For c = 0 To 8
Input #1, Notes$(r, c)
Next
Next
Input #1, dum$
For row = 0 To 8
Input #1, fl$
For i = 0 To 8
n = Val(Mid$(fl$, 3 * i, 3))
Grid(i, row) = n
Next
Next
Close #1
SolnF = 0
checkSoln
Level = -1 'signal no longer using the puzzle setup from getLevel intro
Else
Beep
End If
End Sub
' resolve sub written by cassiope01 on 18 Nov 2011,
' modified very slightly by TyCamden on 19 Nov 2011,
' modified more by me for testing code at JB in mainwin code:
' use aok() function in place of ok() as it does
' the same thing without string processing.
' Now modified by me more, to use in SB but too many stack
' overflow errors in SB, try QB64, Oh yeah!!! Nice...
Sub resolve2 (startN)
For r = 0 To 8
For c = 0 To 8
If Grid(c, r) = 0 Then
For nMod = startN To startN + 8
If nMod > 9 Then n = nMod - 9 Else n = nMod
If aok(n, c, r) Then
temp = Grid(c, r)
Grid(c, r) = -n
resolve2 startN
If solved Then UpdateFlag = 1: Exit Sub 'try solved instead of complete
Grid(c, r) = temp
End If
Next
Exit Sub
End If
Next
Next
End Sub
Function aok (a, c, r) 'check to see if a is OK to place at (c, r)
aok = 0
If Grid(c, r) = 0 Then 'check cell empty
For i = 0 To 8 'check row and column
If Abs(Grid(i, r)) = a Or Abs(Grid(c, i)) = a Then Exit Function
Next
cbase = Int(c / 3) * 3: rbase = Int(r / 3) * 3
For rr = 0 To 2
For cc = 0 To 2
If Abs(Grid(cbase + cc, rbase + rr)) = a Then Exit Function
Next
Next
aok = 1
End If
End Function
Sub getLevel () 'isolated to work on independently
'get desired level of difficulty set
Color &HFFFFFFFF, &HFF880000: Cls
cp 2, "*** Sudoku with Images 2026-01-21 update by bplus ***"
cp 4, "Features 6 Function Menu:"
lp 20, 5, "1 Help & Level - (this screen) reset game at given level (current level listed)."
lp 20, 6, "2 Show Solution - ON/OFF toggle to overlay solution."
lp 20, 7, "3 Cell Checking - ON/OFF toggle will beep and prevent digit when illegal"
lp 20, 8, " (but no beep doesn't mean it's correct)."
lp 20, 9, "4 Mode - toggle between Make Grid and Play! in Make Grid all your entries are clues."
lp 20, 10, " In Play! mode your guesses are tinted so you can change them."
lp 20, 11, "5 Save - file a puzzle at any stage."
lp 20, 12, "6 Load - load the filed puzzle back."
cp 14, "Levels 0 to 9:"
lp 20, 15, "Levels 1 to 3 are good for developing 'flash card' automatic skills."
lp 20, 16, "Levels 4, 5 are pretty easy."
lp 20, 17, "6, 7, 8 intermediate to difficult puzzles."
lp 20, 18, "The puzzles might not be unique or solvable,"
lp 20, 19, "but some effort has gone into making them so."
lp 20, 21, "Use level 9 to blank a puzzle and input your own."
lp 20, 22, "BTW Level 0 is a solved puzzle, so you might try to make a puzzle by removing clues."
lp 20, 23, "Remember to switch to Play! mode after entering clues."
cp 25, "Keys: images are numbered, use number for image or shift + number to note."
lp 20, 26, "spacebar <sp> to toggle solution display."
lp 20, 27, "<c> to toggle Check Cell Fill ON/OFF."
lp 20, 28, "<p> for Play mode (changeable tinted numbers in grid)."
lp 20, 29, "<m> for Make Grid mode all entries become clues until you remember to switch to Play!"
lp 20, 30, "<s> to Save to file: Temp Saved Puzzle.txt (in same folder as this game)."
lp 20, 31, "<l> to Load that puzzle in again."
lp 20, 32, "<x> or <h> to eXit back to this Help Reset screen for new puzzle."
cp 35, "Mouse: (BTW you can navigate with arrow keys as well as mouse.)"
lp 20, 36, "Left click a cell to insert highlighted image as guess or clue."
lp 20, 37, "Right click a cell toggles potential image as Note, 1/9th cell size."
lp 20, 38, "Use blank image top right corner to erase cell numbers."
lp 20, 39, "The game should come with a TXT file with these same instructions."
Color &HFFFFFF00, &HFF880000
cp 41, "Now about that level? Press 0 to 9 or Escape..."
_Display
lvl$ = getChar$("0123456789" + Chr$(27))
If Asc(lvl$) = 27 Then System Else Level = Val(lvl$)
End Sub
Sub cp (cpRow, text$)
_PrintString ((ScreenWidth - 8 * Len(text$)) / 2, cpRow * 16), text$
End Sub
Sub lp (spacer, lpRow, text$)
_PrintString (spacer * 8, lpRow * 16), text$
End Sub
Sub checkSoln
If SolnF = 0 Then
'make copy of grid
For rrow = 0 To 8
For ccol = 0 To 8
Temp(ccol, rrow) = Grid(ccol, rrow)
Next
Next
'clear negs to get soln for clues only!
For rrow = 0 To 8
For ccol = 0 To 8
If Grid(ccol, rrow) < 0 Then Grid(ccol, rrow) = 0
Next
Next
'resolve it
resolve2 1
'save it to soln array
If solved Then
For rrow = 0 To 8
For ccol = 0 To 8
Soln(ccol, rrow) = Grid(ccol, rrow)
Next
Next
'set flag
SolnF = 1
Else
Erase Soln 'if not already done
'set flag
SolnF = 0
End If
'restore grid
For rrow = 0 To 8
For ccol = 0 To 8
Grid(ccol, rrow) = Temp(ccol, rrow)
Next
Next
End If
End Sub
Sub drwBtn (x, y, s$) '200 x 50
Line (x, y)-Step(200, 50), _RGB32(0, 0, 0), BF
Line (x, y)-Step(197, 47), _RGB32(255, 255, 255), BF
Line (x + 1, y + 1)-Step(197, 47), &HFFEEEEEE, BF
Color _RGB32(0, 100, 0), &HFFEEEEEE
_PrintString (x + 100 - 4 * Len(s$), y + 17), s$
End Sub
Function TS$ (n As Integer)
TS$ = _Trim$(Str$(n))
End Function
Function getChar$ (fromStr$)
Dim OK As Integer, k$
While OK = 0
k$ = InKey$
If Len(k$) Then
If InStr(fromStr$, k$) <> 0 Then OK = -1
End If
_Limit 200
Wend
_KeyClear
getChar$ = k$
End Function
Sample level 6 Puzzle:
Sample of Solved Puzzle:
The images are for demo purposes only! Please don't copy and distribute them elsewhere.
Collect and customize you own set, if you are a BIG Sudoku fan, its more fun!
Zip contains some Ico images, Snoopy and Woodstock Images collection and snaps folder, help text file and source code.
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
