Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
SUDOKU Helper
| Uploader: |  Muttonhead |
| Datum/Zeit: | 04.01.2025 17:10:49 |
screen 19,32
dim as integer Xo,Yo,CellSize,CellStatus(8,8),ClickedRow,ClickedColumn
dim as integer LayerIndex,SudokuIndex(8,8)
dim as integer countfree,countset,mode
dim as integer e,click,button,oldbutton,mx,my'"Maus"
dim as string key,tmpkey
Xo=30
Yo=50
CellSize=50
sub Stats (byref countfree as integer,byref countset as integer,byref LayerIndex as integer,byref mode as integer,CellStatus() as integer)
countfree=0
countset=0
for i as integer=0 to 8
for k as integer=0 to 8
if CellStatus(i,k)=2 then countfree +=1
if CellStatus(i,k)=3 then countset +=1
next k
next i
print "LayerIndex:";LayerIndex;" left:";9-countset
if countset=9 then print "!!! Press 'space' to fix this Layer"
if mode=1 then print "!!! Keep Back Mode !!!"
end sub
sub DrawCellStatus(Xo as integer,Yo as integer,CellSize as integer,CellStatus() as integer,SudokuIndex() as integer,byref LayerIndex as integer,countset as integer)
dim as integer midcell,lwidth
midcell=CellSize/2
for i as integer=0 to 9
if (i mod 3) then lwidth=0 else lwidth=3
line (Xo+i*CellSize,Yo)-(Xo+i*CellSize+lwidth,Yo+9*CellSize),&HFFFFFF,bf
line (Xo,Yo+i*CellSize)-(Xo+9*CellSize,Yo+i*CellSize+lwidth),&HFFFFFF,bf
next i
for i as integer=0 to 8
for k as integer=0 to 8
select case CellStatus(i,k)
case 3
if countset=9 then
paint (Xo+i*CellSize+midcell,Yo+k*CellSize+midcell),&HFFFF00,&HFFFFFF
else
paint (Xo+i*CellSize+midcell,Yo+k*CellSize+midcell),&H8888FF,&HFFFFFF
end if
case 2
paint (Xo+i*CellSize+midcell,Yo+k*CellSize+midcell),&H009900,&HFFFFFF
case 1
paint (Xo+i*CellSize+midcell,Yo+k*CellSize+midcell),&HDD0000,&HFFFFFF
case 0
paint (Xo+i*CellSize+midcell,Yo+k*CellSize+midcell),&H333333,&HFFFFFF
end select
if CellStatus(i,k)=0 then
if SudokuIndex(i,k)<>0 then
draw string (Xo+i*CellSize+midcell,Yo+k*CellSize+midcell),str(SudokuIndex(i,k))
else
draw string (Xo+i*CellSize+midcell,Yo+k*CellSize+midcell),"X"
end if
end if
next k
next i
end sub
'CellStatus(c,r)
'3 Zelle momentan fürs Layer "gesetzt",blau, wenn Layer vollstängig gelb
'2 momentan freie Zellen, grün
'1 momentan gesperrte Zellen, rot, Sudoku-Regelwerk technisch
'0 dauerhaft gesperrt, grau, durch vorherige fertige Layer, stehen prakisch nicht mehr zur Verfügung
sub LockRow( Row as integer,CellStatus() as integer)
for i as integer=0 to 8
if CellStatus(i,Row)<>0 then
if CellStatus(i,Row)=2 then CellStatus(i,Row)=1
end if
next i
end sub
sub LockColumn( Column as integer,CellStatus() as integer)
for i as integer=0 to 8
if CellStatus(Column,i)<>0 then
if CellStatus(Column,i)=2 then CellStatus(Column,i)=1
end if
next i
end sub
sub LockBlock(Column as integer,Row as integer,CellStatus() as integer)
dim as integer c,r
'r und c ist die linke obere "Adresse" des 3x3Bereiches
c=fix(Column/3)*3
r=fix(Row/3)*3
'3x3Bereich sperren, ausser gesetzte
for i as integer=0 to 2
for k as integer=0 to 2
if CellStatus(i+c,k+r)<>0 then
if (i+c<>Column) and (k+r<>Row) then CellStatus(i+c,k+r)=1
end if
next k
next i
end sub
sub ClearCellStatus (CellStatus() as integer,SudokuIndex() as integer,byref LayerIndex as integer,hold as integer=0)
select case hold
case 0'alle wieder frei 2
for i as integer=0 to 8
for k as integer=0 to 8
CellStatus(i,k)=2
SudokuIndex(i,k)=0
next k
next i
LayerIndex=1
case 1'gesetzte beiben 3 alle anderen auf 2, kann nur Zwischenschritt sein
for i as integer=0 to 8
for k as integer=0 to 8
if CellStatus(i,k)<>0 then
if CellStatus(i,k)<3 then CellStatus(i,k)=2'gesetzte bleiben erhalten
end if
next k
next i
case 2'gesetzte 3 werden zu 0 alle anderen, für Übernahme und weitere Suche
for i as integer=0 to 8
for k as integer=0 to 8
if CellStatus(i,k)<>0 then
if CellStatus(i,k)=3 then
CellStatus(i,k)=0
SudokuIndex(i,k)=LayerIndex
else
CellStatus(i,k)=2
end if
end if
next k
next i
LayerIndex +=1
end select
end sub
sub Rulez (ClickedColumn as integer,ClickedRow as integer,CellStatus() as integer,SudokuIndex() as integer,byref LayerIndex as integer)
select case CellStatus(ClickedColumn,ClickedRow)'die Cases schliessen 0=gesperrt aus
case 2'Zelle wäre setzbar 2->3
CellStatus(ClickedColumn,ClickedRow)=3
case 3'wieder "frei" werden 3->2
CellStatus(ClickedColumn,ClickedRow)=2
end select
ClearCellStatus CellStatus(),SudokuIndex(),LayerIndex,1'gesetzte werden gehalten
for i as integer=0 to 8
for k as integer=0 to 8
if CellStatus(i,k)=3 then
LockBlock(i,k,CellStatus())
LockColumn(i,CellStatus())
LockRow(k,CellStatus())
end if
next k
next i
end sub
sub KeepBack (ClickedColumn as integer,ClickedRow as integer,CellStatus() as integer,SudokuIndex() as integer,byref LayerIndex as integer)
select case CellStatus(ClickedColumn,ClickedRow)'die Cases schliessen 0=gesperrt aus
case 2'Zelle sperren 2->0
CellStatus(ClickedColumn,ClickedRow)=0
case 0'wieder "frei" werden 0->2, aber nur wenn sie nicht durch Layerabschluß belegt ist, dann SudokuIndex<>0
if SudokuIndex(ClickedColumn,ClickedRow)=0 then CellStatus(ClickedColumn,ClickedRow)=2
end select
end sub
'******************************************************************************
'******************************************************************************
'******************************************************************************
ClearCellStatus CellStatus(),SudokuIndex(),LayerIndex
do
sleep 1
' Mouse + Keyboard
click=0
button=0
key=""
do
oldbutton=button
e=getmouse (mx, my, ,button)
if e<>0 then button=0
if oldbutton>button then click=1 else click=0
loop until button=0
do
tmpkey=inkey
if len(tmpkey) then KEY=tmpkey
loop while len(tmpkey)
if click then
'angeklickte Zelle
ClickedColumn=fix((mx-Xo)/CellSize)
ClickedRow=fix((my-Yo)/CellSize)
'ArrayLimiter
if ClickedColumn<0 then ClickedColumn=0
if ClickedColumn>8 then ClickedColumn=8
if ClickedRow<0 then ClickedRow=0
if ClickedRow>8 then ClickedRow=8
'Sperrregelwerk
if mode then
KeepBack ClickedColumn,ClickedRow,CellStatus(),SudokuIndex(),LayerIndex
else
Rulez ClickedColumn,ClickedRow,CellStatus(),SudokuIndex(),LayerIndex
end if
end if
if key="k" then
mode=iif(mode=0,1,0)
end if
if key="s" then
ClearCellStatus CellStatus(),SudokuIndex(),LayerIndex
end if
if key=" " then
if countset=9 then
ClearCellStatus CellStatus(),SudokuIndex(),LayerIndex,2
end if
end if
screenlock
cls
Stats countfree,countset,LayerIndex,mode,CellStatus()
DrawCellStatus Xo,Yo,CellSize,CellStatus(),SudokuIndex(),LayerIndex,countset
screenunlock
loop until key="q"