CreateCursor_spuzzles()
PUBLIC oForm
oForm = CreateObject("Sudoku")
**************************************************
*-- Class Library: d:\f_kullan\games\sudoku\sudoku.vcx
**************************************************
**************************************************
*-- Class: sudoku (d:\f_kullan\games\sudoku\sudoku.vcx)
*-- ParentClass: form
*-- BaseClass: form
*-- Time Stamp: 03/11/11 05:16:14 PM
*
DEFINE CLASS sudoku AS form
Height = 533
Width = 552
DoCreate = .T.
ShowTips = .T.
AutoCenter = .T.
Caption = " Sudoku !"
Name = "Form1"
DIMENSION givenvalues[1,1]
DIMENSION proposedvalues[1,1]
ADD OBJECT cmdgetsolution AS commandbutton WITH ;
Top = 432, ;
Left = 109, ;
Height = 25, ;
Width = 100, ;
Caption = "Get Solution", ;
Name = "CmdGetSolution"
ADD OBJECT cmdremovesolution AS commandbutton WITH ;
Top = 457, ;
Left = 109, ;
Height = 25, ;
Width = 100, ;
Caption = "Remove Solution", ;
Name = "CmdRemoveSolution"
ADD OBJECT cmdclearcells AS commandbutton WITH ;
Top = 432, ;
Left = 328, ;
Height = 25, ;
Width = 100, ;
Caption = "Clear Cells", ;
Name = "CmdClearCells"
ADD OBJECT cmdgetpuzzle AS commandbutton WITH ;
Top = 432, ;
Left = 2, ;
Height = 25, ;
Width = 100, ;
Caption = "Get Puzzle", ;
Name = "CmdGetPuzzle"
ADD OBJECT cmdverify AS commandbutton WITH ;
Top = 432, ;
Left = 438, ;
Height = 25, ;
Width = 100, ;
Caption = "Verify", ;
ToolTipText = "Check fdor NOT distinct numbers in rows, columns or 3x3 grids", ;
Name = "CmdVerify"
ADD OBJECT check1 AS checkbox WITH ;
Top = 441, ;
Left = 214, ;
Height = 16, ;
Width = 18, ;
FontSize = 8, ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "", ;
Value = .F., ;
Name = "Check1"
ADD OBJECT label1 AS label WITH ;
WordWrap = .T., ;
Alignment = 2, ;
Caption = "View Calculation Steps", ;
Height = 31, ;
Left = 228, ;
Top = 432, ;
Width = 98, ;
Name = "Label1"
ADD OBJECT cmdgeneratepuzzle AS commandbutton WITH ;
Top = 458, ;
Left = 0, ;
Height = 48, ;
Width = 102, ;
FontSize = 8, ;
WordWrap = .T., ;
Caption = "Generate Random Grid and then make a puzzle yourself", ;
ToolTipText = "Walter Meester , www.universalthread.com Thread 1073278 Message 1073927 ", ;
Name = "CmdGeneratePuzzle"
ADD OBJECT label2 AS label WITH ;
FontName = "Times New Roman", ;
FontSize = 8, ;
WordWrap = .T., ;
Alignment = 2, ;
Caption = "Click to see how to play", ;
Height = 36, ;
Left = 320, ;
Top = 465, ;
Width = 230, ;
Name = "Label2"
PROCEDURE highlightbox
LPARAMETERS pOne, pTwo
lccom="thisform.textbox"+pOne+".BackColor = RGB(255,255,0)"
&lccom
lccom="thisform.textbox"+pTwo+".BackColor = RGB(255,255,0)"
&lccom
WAIT WINDOW "Row, Column, Grid, cannot contain repeated numbers! " TIMEOUT 1.0
ENDPROC
PROCEDURE putvalue
LPARAMETERS irow,icol
WITH EVALUATE("thisform.textbox"+trans(irow)+TRANSFORM(icol))
.Value = VAL(thisform.proposedvalues[irow,icol])
.forecolor=RGB(128,0,0)
ENDWITH
thisform.givenvalues[irow,icol]=VAL(thisform.proposedvalues[irow,icol])
IF thisform.check1.Value
lcmessage=""
FOR i=1 TO 9
FOR j=1 TO 9
IF NOT (i=irow AND j=icol)
lcmessage=lcmessage + padc(ALLTRIM(thisform.proposedvalues[i,j]),7, "_")
else
lcmessage=lcmessage + padc(">"+ALLTRIM(thisform.proposedvalues[i,j])+"<",7,"_")
ENDIF
DO case
case j=3 OR j=6
lcmessage=lcmessage +" \\ "
CASE j#9
lcmessage=lcmessage +" | "
endcase
ENDFOR
lcmessage=lcmessage + CHR(13)+CHR(10)+ CHR(13)+CHR(10)
IF i=3 OR i=6
lcmessage=lcmessage + PADL("_",81,"_")+CHR(13)+CHR(10)+CHR(13)+CHR(10)
endif
ENDFOR
MESSAGEBOX(lcmessage)
ENDIF
ENDPROC
PROCEDURE Click
WAIT WINDOW ;
"Fill in the grid so that every row, every column, and every 3x3 grid contains distinct digits from 1 to 9"
ENDPROC
PROCEDURE Init
SET DECIMALS TO 0
lnwidth= 6/7*630
lnHeight=450
this.Height=525
this.width=lnwidth
FOR irow=1 TO 9
FOR icol=1 TO 9
lc="TextBox"+TRANSFORM(irow)+TRANSFORM(icol)
this.AddObject(lc,"TextBox")
WITH eval("this."+lc)
.Margin=0
.width=lnwidth/9
.height=lnheight/9
.left =.width * (icol-1)
.top = .height * (irow-1)
.fontsize=36
.Alignment=2
.FORMAT="Z"
.value = 0
.visible=.t.
ENDWITH
ENDFOR
ENDFOR
FOR i=1 TO 4
lc="Line"+TRANSFORM(i)
this.AddObject(lc,"Line")
WITH eval("this."+lc)
.width=IIF(i<3,0, lnWidth)
.left =IIF(i<3,lnwidth/9 * 3* i,0)
.top = IIF(i<3,0,lnHeight/9 * 3*(i-2))
.Height = IIF(i<3,lnHeight-5,0)
.borderwidth = 5
.visible=.t.
ENDWITH
ENDFOR
this.SetAll("top",lnHeight+2,"CommandButton")
WITH thisForm.cmdGetSolution
thisForm.cmdRemoveSolution.Top = .Top+.Height+2
this.Label1.Top=.Top
ENDWITH
this.Check1.Top=this.Label1.Top+8
WITH thisForm.cmdGetPuzzle
thisForm.cmdGeneratePuzzle.Top = .Top+.Height+2
ENDWITH
this.Label2.top=thisForm.cmdRemoveSolution.top+10
this.Label2.caption="Click to see how to play."+chr(13)+"Yuri Rubinov, rubinov@juno.com. June 2006"
this.textbox11.Setfocus
ENDPROC
PROCEDURE QueryUnload
SET DECIMALS TO 2
ENDPROC
PROCEDURE cmdgetsolution.Click
thisform.SetAll("Backcolor",RGB(255,255,255),"TextBox")
*1. Verify integrity of what is given
IF NOT thisform.cmdverify.click(.t.)
return .f.
ENDIF
*2. Try to solve
ACOPY(thisform.givenvalues, thisform.proposedvalues)
FOR i=1 TO ALEN(thisform.proposedvalues)
IF thisform.proposedvalues[i] = 0
thisform.proposedvalues[i] = "123456789"
else
thisform.proposedvalues[i]=TRANSFORM(thisform.proposedvalues[i])
endif
ENDFOR
lnattempts=1
DO WHILE ASCAN(thisform.givenvalues,0)>0 and lnattempts < 100
WAIT WINDOW NOWAIT "Calculations, loop #"+TRANSFORM(lnattempts)
lnattempts=lnattempts + 1
FOR irow=1 TO 9
FOR icol=1 TO 9
IF thisform.givenvalues[irow,icol]=0
* get numbers already given or found, store them in a string
lcgiven=""
*get along the row
for i=1 TO 9
lcnum=TRANSFORM(EVALUATE(;
"thisform.textbox"+TRANSFORM(irow)+TRANSFORM(i)+".Value"))
IF NOT lcnum$lcgiven
lcgiven=lcgiven + lcnum
ENDIF
ENDFOR
*get along the Column
for i=1 TO 9
lcnum=TRANSFORM(EVALUATE(;
"thisform.textbox"+TRANSFORM(i)+TRANSFORM(icol)+".Value"))
IF NOT lcnum$lcgiven
lcgiven=lcgiven + lcnum
ENDIF
ENDFOR
* get form the Grid, find the leftmost Grid index first
iGrid_row1=IIF(irow <4,1,IIF(irow<7,4,7))
iGrid_col1=IIF(icol <4,1,IIF(icol<7,4,7))
for i=iGrid_row1 TO iGrid_row1 + 2
FOR j=iGrid_col1 TO iGrid_col1 +2
lcnum=TRANSFORM(EVALUATE(;
"thisform.textbox"+TRANSFORM(i)+TRANSFORM(j)+".Value"))
IF NOT lcnum$lcgiven
lcgiven=lcgiven + lcnum
ENDIF
endfor
ENDFOR
*-----------------------------
IF EMPTY(lcgiven)
LOOP
endif
thisform.proposedvalues[irow,icol] = CHRTRAN(thisform.proposedvalues[irow,icol],lcgiven,"")
* find the proper number
DO case
case LEN(thisform.proposedvalues[irow,icol])=1 && found
thisform.PutValue(irow,icol)
LOOP
otherwise && see if there is a unique number in the row,column or in the grid
FOR inum = 1 TO LEN(thisform.proposedvalues[irow,icol])
lcnum=SUBSTR(thisform.proposedvalues[irow,icol],inum,1)
*along the row
lnoccur=0
FOR i=1 TO 9
lnoccur=lnoccur + IIF(lcnum $ thisform.proposedvalues[irow,i],1,0)
IF lnoccur>1 && not in the row
EXIT
ENDIF
ENDFOR
IF lnoccur=1
thisform.proposedvalues[irow,icol]=lcnum
thisform.PutValue(irow,icol)
EXIT
ENDIF
*along the column
lnoccur=0
FOR i=1 TO 9
lnoccur=lnoccur + IIF(lcnum $ thisform.proposedvalues[i,icol],1,0)
IF lnoccur>1 && not in the column
EXIT
ENDIF
ENDFOR
IF lnoccur=1
thisform.proposedvalues[irow,icol]=lcnum
thisform.PutValue(irow,icol)
EXIT
ENDIF
* in the Grid
lnoccur=0
for i=iGrid_row1 TO iGrid_row1 + 2
FOR j=iGrid_col1 TO iGrid_col1 +2
lnoccur=lnoccur + IIF(lcnum $ thisform.proposedvalues[i,j],1,0)
IF lnoccur>1 && not in the grid
EXIT
ENDIF
ENDFOR
IF lnoccur>1 && not in the grid
EXIT
ENDIF
ENDFOR
IF lnoccur=1
thisform.proposedvalues[irow,icol]=lcnum
thisform.PutValue(irow,icol)
EXIT
ENDIF
ENDFOR
ENDCASE
ENDIF
ENDFOR
ENDFOR
ENDDO
WAIT clear
if lnattempts > 99
=MESSAGEBOX("Have tryed 100 loops while calculating .... unable to solve the puzzle ?!")
ELSE
thisform.cmdverify.click()
endif
ENDPROC
PROCEDURE cmdremovesolution.Click
FOR irow=1 TO 9
FOR icol=1 TO 9
WITH EVALUATE("thisform.textbox"+TRANSFORM(irow)+TRANSFORM(icol))
IF .Forecolor#RGB(0,0,0)
.value=0
endif
ENDWITH
ENDFOR
ENDFOR
thisform.SetAll("Forecolor",RGB(0,0,0),"TextBox")
ENDPROC
PROCEDURE cmdclearcells.Click
thisform.SetAll("Value",0,"TextBox")
thisform.SetAll("Backcolor",RGB(255,255,255),"TextBox")
thisform.SetAll("Forecolor",RGB(0,0,0),"TextBox")
ENDPROC
PROCEDURE cmdgetpuzzle.Click
thisform.cmdClearCells.Click
IF NOT USED("spuzzles")
IF file("spuzzles.dbf")
USE spuzzles
ENDIF
ELSE
SELECT spuzzles
ENDIF
IF LOWER(ALIAS())="spuzzles"
GO (Max(INT(RECCOUNT()*RAND()),1))
lcgrid=fgrid
this.tooltiptext="Puzzle taken from "+ALLTRIM(source)+". "+ALLTRIM(contact)
ELSE
ln=10*RAND()
lcgrid=IIF(ln>5, ;
"068001005000036080130790020002010506500604009406070300020057063050160000600300150",;
"004013700703269000020040603450006901070000060106080527009050030000102408005630700")
this.tooltiptext="Puzzle taken from the private Examples Collection"
ENDIF
i=0
FOR irow=1 TO 9
FOR icol=1 TO 9
i=i+1
WITH eval("thisform.textbox"+TRANSFORM(irow)+TRANSFORM(icol))
.value=VAL(SUBSTR(lcgrid,i,1))
ENDWITH
ENDFOR
ENDFOR
ENDPROC
PROCEDURE cmdverify.Click
LPARAMETERS pDoNotShow
thisform.SetAll("Backcolor",RGB(255,255,255),"TextBox")
DIMENSION thisform.givenvalues[9,9]
FOR irow=1 TO 9
FOR icol=1 TO 9
thisform.givenvalues[irow,icol]= EVALUATE(;
"thisform.textbox"+TRANSFORM(irow)+TRANSFORM(icol)+".Value")
ENDFOR
ENDFOR
FOR irow=1 TO 9
FOR icol=1 TO 9
IF thisform.givenvalues[irow,icol]>0
*check along the row
for i=1 TO 9
ln2compare=EVALUATE(;
"thisform.textbox"+TRANSFORM(irow)+TRANSFORM(i)+".Value")
IF i # icol and ln2compare = thisform.givenvalues[irow,icol]
thisform.highlightbox(TRANSFORM(irow)+TRANSFORM(icol),;
TRANSFORM(irow)+TRANSFORM(i))
return .f.
ENDIF
ENDFOR
*check along the Column
for i=1 TO 9
ln2compare=EVALUATE(;
"thisform.textbox"+TRANSFORM(i)+TRANSFORM(icol)+".Value")
IF i # irow and ln2compare = thisform.givenvalues[irow,icol]
thisform.highlightbox(TRANSFORM(irow)+TRANSFORM(icol),;
TRANSFORM(i)+TRANSFORM(icol))
return .f.
ENDIF
ENDFOR
* check in the Grid
** find the leftmost Grid index
iGrid_row1=IIF(irow <4,1,IIF(irow<7,4,7))
iGrid_col1=IIF(icol <4,1,IIF(icol<7,4,7))
for i=iGrid_row1 TO iGrid_row1 + 2
FOR j=iGrid_col1 TO iGrid_col1 +2
ln2compare=EVALUATE(;
"thisform.textbox"+TRANSFORM(i)+TRANSFORM(j)+".Value")
IF NOT (i=irow AND j=icol) AND ;
ln2compare = thisform.givenvalues[irow,icol]
thisform.highlightbox(TRANSFORM(irow)+TRANSFORM(icol),;
TRANSFORM(i)+TRANSFORM(j))
return .f.
ENDIF
endfor
ENDFOR
ENDIF
ENDFOR
ENDFOR
IF TYPE("pDoNotShow")="L" AND !pDoNotShow
wait wind time 1.0 "OK"
endif
return .t.
ENDPROC
PROCEDURE cmdgeneratepuzzle.Click
thisform.cmdClearCells.Click
*Walter Meester, UT Thread ID: 1073278 Message ID: 1073927
DIMENSION aStrings[9], aResult[9], aRandomize[6,3]
CLEAR
FOR nT = 0 TO 17
aRandomize[nT+1] = VAL(SUBSTR(GETWORDNUM("123 132 231 213 312 321", INT(nT/3)+1),(nT%3)+1,1))
ENDFOR
* Generate a random number to use as a base
cString = "123456789"
FOR nT = 1 TO 9
nPos = INT(RAND() * 9)+1
cString = IIF(nPos>1, SUBSTR(cString, nPos,1)+LEFT(cString, nPos-1)+SUBSTR(cString,nPos+1), cString)
cString = SUBSTR(cString,2)+LEFT(cString,1)
ENDFOR
* Make a basic Soduko map
nT = 1
FOR nY = 1 TO 3
FOR nX = 1 TO 3
aStrings[nT] = cString
cString = SUBSTR(cString,4)+LEFT(cString,3)
nT = nT + 1
ENDFOR
cString = SUBSTR(cString,2)+LEFT(cString,1)
ENDFOR
* Move rows arround, to randomize
nT = 1
nRand2 = INT(RAND()*6)+1
FOR nY = 1 TO 3
nRand = INT(RAND()*6)+1
FOR nY2 = 1 TO 3
aResult[nT] = aStrings[(aRandomize[nRand2, nY]-1)*3+aRandomize[nRand, nY2]]
nT = nT + 1
ENDFOR
ENDFOR
* Move columns arround, to randomize
nT = 1
nRand2 = INT(RAND()*6)+1
FOR nX = 1 TO 3
nRand = INT(RAND()*6)+1
FOR nX2 = 1 TO 3
FOR nX3 = 1 TO 9
aStrings[nX3] = STUFF(aStrings[nx3], (aRandomize[nRand2, nX]-1)*3+aRandomize[nRand, nX2], 1, ;
SUBSTR(aResult[nX3], nT,1))
ENDFOR
nT = nT + 1
ENDFOR
ENDFOR
* Display puzzle
FOR irow = 1 TO 9
FOR icol=1 TO 9
lccom="thisform.textbox"+TRANSFORM(irow)+TRANSFORM(icol)+".value = "+SUBSTR(aStrings[irow],icol,1)
&lccom
endfor
ENDFOR
ENDPROC
PROCEDURE label2.Click
thisform.click
ENDPROC
ENDDEFINE
*
*-- EndDefine: sudoku
**************************************************
Procedure CreateCursor_spuzzles
LOCAL lcData, lcTemp
lcTemp = SYS(2015)+'.tmp'
TEXT TO m.lcData noshow
"004000016600340002950210007006000035803502409490000700300090051500021000160000890","www.ActivityVillage.co.uk","www.SudokuforKids.com"
"600000000300948000500000219017800000000000000000003740183000002000264008000000005","www.ActivityVillage.co.uk","www.SudokuforKids.com"
"000700000000049308000010024000800051001000600960007000540030000307650000000002000","www.ActivityVillage.co.uk","www.SudokuforKids.com"
"005000091600510008130620007003000075206905804750000900300050069400062000560000740","www.ActivityVillage.co.uk","www.SudokuforKids.com"
"010400020004000007030800001000390008008000700100058000700009050500000400090002010","www.ActivityVillage.co.uk","www.SudokuforKids.com"
"008200000090010004060000300000700020500000009010006000007000080200040010000003500","www.ActivityVillage.co.uk","www.SudokuforKids.com"
"091005046208079003000030800050002680002506400064700030003060000700284000420100970","www.ActivityVillage.co.uk","www.SudokuforKids.com"
"030000605402600079600470020006007230008006100043900000060018003350004708801000460","www.ActivityVillage.co.uk","www.SudokuforKids.com"
"010000406504100038906240010005002840000005760083600090050081009860003104401000380","www.ActivityVillage.co.uk","www.SudokuforKids.com"
"003000024400830007950460001006000092509206403270000500100020068600071000790000130","http://parex.metro.st/ftp/2006mmdd_Philadelphia.pdf","www.metro.us"
"000903160308007050100540800590038406000000000706400293003052001010600309027301000","http://parex.metro.st/ftp/2006mmdd_Philadelphia.pdf","www.metro.us"
"008907203607502400010003005904050320060000090073020008300200050005301900806405130","http://parex.metro.st/ftp/2006mmdd_Philadelphia.pdf","www.metro.us"
"064002005000056010530740060008020709400607001203090600080019023090270000300800190","http://parex.metro.st/ftp/2006mmdd_Philadelphia.pdf","www.metro.us"
"000903160308007050100540800590038406000000000706400293003052001010600309027301000","http://parex.metro.st/ftp/2006mmdd_Philadelphia.pdf","www.metro.us"
"003075100706912000010080207320004706090000020108020493001060040000201605002350800","http://parex.metro.st/ftp/2006mmdd_Philadelphia.pdf","www.metro.us"
"000010020703000000500003000400000507000620000000000300060200080010000000000005000","http://www.csse.uwa.edu.au/~gordon/sudokumin.php","Gordon Royle, gordon@csse.uwa.edu.au"
"000030050017000000000000200000401000600000090000700000530060000004000100000000708","http://www.csse.uwa.edu.au/~gordon/sudokumin.php","Gordon Royle, gordon@csse.uwa.edu.au"
ENDTEXT
STRTOFILE(m.lcData,m.lcTemp)
create CURSOR spuzzles ;
( ;
FGRID C(81,0) NOT NULL ;
,SOURCE C(80,0) NOT NULL ;
,CONTACT C(80,0) NOT NULL ;
)
APPEND FROM (m.lcTemp) TYPE delimited
ERASE (m.lcTemp)
endproc