Giriş yapmadınız. Lütfen giriş yapın yada kayıt olun.
Sudoku oynamak ya da bulmaca çözmek ciddi anlamda düşünmeyi gerektiriyor.
Alzheimer hastalığına karşı sudoku çözmenin yararlı olduğunu belirten yazılar okudum. Ben de risk grubunda olduğum için günde 1 tane çözmeye gayret ediyorum.
İnternette birçok sudoku programları var. Hatta kodları olanlar da var. Bu konuda çalışması olan arkadaşlar var mı?
forumdan Timuçin arkadaşımızın bir çalışması var aşağıdaki linkten indirebilirsin...
http://www.cozbim.com.tr/qsc/userfiles/file/sudoku.exe
Author : Yuri RUBINOV
http://www.foxite.com/downloads/default.aspx?id=151
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
Teşekkür ederim.