un p'tit sudoku a resoudre

DIM a% , b% , x% , y% , n% , c% , px% , py% , ng% , nh% , nv% , pos%
DIM num% , grille$(9) , grillev$(9) , grilleh$(9) , chiffre%(9)

LABEL choix , selection

HIDE 0 : LEFT 0,520 : TOP 0,235 : WIDTH 0,600 : HEIGHT 0,463 : FONT_NAME 0,"arial"
FONT_NAME 0,"arial.ttf" : FONT_SIZE 0,20 : COLOR 0,100,100,100 : CAPTION 0,"SUDOKU"

num%=1 : n%=1
FOR a%=1 to 3
  FOR b%=1 to 3
      FOR y%=1 to 3
        FOR x%=1 to 3
            PANEL num% : LEFT num%,a%*133+x%*43-160 : TOP num%,b%*133+y%*43-160 : WIDTH num%,43 : HEIGHT num%,43 : COLOR num%,255,255,255 : ON_CLICK num%,selection
            c%=RND(9) : IF c%<>0 AND INSTR(grille$(n%),STR$(c%))<>0 THEN c%=0
            px%=a%*3-3+x% : IF c%<>0 AND INSTR(grillev$(px%),STR$(c%))<>0 : c%=0 : END_IF : py%=b%*3-3+y% : IF c%<>0 AND INSTR(grilleh$(py%),STR$(c%))<>0 : c%=0 : END_IF
            grillev$(px%)=grillev$(px%)+STR$(c%) : grilleh$(py%)=grilleh$(py%)+STR$(c%) : grille$(n%)=grille$(n%)+STR$(c%)
            IF c%<>0 THEN CAPTION num%,STR$(c%) : chiffre%(c%)=chiffre%(c%)+1 : INACTIVE num% : COLOR num%,240,240,240
            num%=num%+1
        NEXT x%
      NEXT y%
      n%=n%+1
  NEXT b%
NEXT a%

num%=99
ALPHA num% : LEFT num%,420 : TOP num%,15 : WIDTH num%,120 : HEIGHT num%,30 : FONT_SIZE num%,12
FONT_COLOR num%,255,255,255 : CAPTION num%,"Nombre d'apparitions" : num%=num%+1

FOR a%=2 to 10
  PANEL num% : LEFT num%,420 : TOP num%,a%*30-23 : WIDTH num%,150 : HEIGHT num%,30 : FONT_SIZE num%,12
  CAPTION num%,"Chiffre "+STR$(a%-1)+"  :  "+STR$(chiffre%(a%-1))+" fois" : ON_CLICK num%,choix
  num%=num%+1
NEXT a%
num%=1 :  COLOR 100,255,255,0

PANEL 110 : LEFT 110,420 : TOP 110,350 : WIDTH 110,150 : HEIGHT 110,30 : FONT_SIZE 110,12 : CAPTION 110,"Rejouer" : ' ON_CLICK 110,nouveau
PANEL 111 : LEFT 111,420 : TOP 111,380 : WIDTH 111,150 : HEIGHT 111,30 : FONT_SIZE 111,12 : CAPTION 111,"Quitter" : ' ON_CLICK 111,quitter
SHOW 0

END

choix:
  FOR n%=100 to 108 : COLOR n%,240,240,240 : NEXT n%
  num%=number_click-99 :  COLOR num%+99,255,255,0
RETURN

selection:
  n%=NUMBER_CLICK : ng%=INT((n%+8)/9) : nh%=INT((n%+2)/3) : WHILE nh%>9 : nh%=nh%-9 : END_WHILE : nv%=n%
  IF nv%<28 : WHILE nv%>3 : nv%=nv%-3 : END_WHILE : END_IF : IF nv%>27 AND nv%<55 : WHILE nv%>6 : nv%=nv%-3 : END_WHILE : END_IF : IF nv%>54 : WHILE nv%>9 : nv%=nv%-3 : END_WHILE : END_IF
  pos%=MOD((n%+8),9)+1
  ' CAPTION 0,"Grille : "+grille$(ng%)+ " / Grilleh : "+grilleh$(nh%)+" / Grillev : "+Grillev$(nv%)+" / Position : "+STR$(pos%)
 
  IF INSTR(grille$(ng%),STR$(num%))=0 AND INSTR(grilleh$(nh%),STR$(num%))=0 AND INSTR(Grillev$(nv%),STR$(num%))=0
      IF CAPTION$(n%)<>""
        chiffre%(VAL(CAPTION$(n%)))=chiffre%(VAL(CAPTION$(n%)))-1
        CAPTION VAL(CAPTION$(n%))+99,"Chiffre "+STR$(VAL(CAPTION$(n%)))+"  :  "+STR$(chiffre%(VAL(CAPTION$(n%))))+" fois"
        chiffre%(num%)=chiffre%(num%)+1
        CAPTION n%,STR$(num%) : CAPTION num%+99,"Chiffre "+STR$(num%)+"  :  "+STR$(chiffre%(num%))+" fois"
      ELSE
        chiffre%(num%)=chiffre%(num%)+1
        CAPTION n%,num% : CAPTION num%+99,"Chiffre "+STR$(num%)+"  :  "+STR$(chiffre%(num%))+" fois"
      END_IF
  ELSE
      MESSAGE " C'EST PAS POSSIBLE"
  END_IF

RETURN

v% = int(rnd(2))

v% = 1 + int(rnd(6))

v% = int(rnd(2))

v%=rnd(1)

v%=int(rnd(2))

dim key,jeux$,num$
dim a1$,a2$,a3$,a4$,a5$,a6$,a7$,a8$,a9$,x,y,z%,posx%,posy%
dim num1%,num2%,num3%,num4%,num5%,num6%,num7%,num8%,num9%,num%
dim suite$(1,9),gride1$,gride2$,gride3$,gride4$,gride5$,gride6$,gride7$,gride8$,gride9$
dim  RGB% ,B%,R%,G%,FRGB%,res%,font$

label tri,trie,choix,
label choix1,choix2,choix3,choix4,choix5,choix6,choix7,choix8,jeu

num%=0
num$=""
num1%=0: num2%=0: num3%=0: num4%=0: num5%=0: num6%=0: num7%=0: num8%=0: num9%=0

font$="arial.ttf"
num$=""
left 0,520
top 0,235
width 0,590
height 0,510
caption 0,"Sudoku"
font_name 0,"arial"
font_size 0,10

grid 1
left 1,10
top 1,10
width 1,428
height 1,428
grid_row 1,10: grid_column 1,10
grid_column_width 1,(465/10): grid_one_column_width 1,1,0.01
grid_row_height 1,(465/10): grid_one_row_height 1,1,0.01
font_color 1,255,0,0
font_size 1,20
on_click 1,jeu
' ooooooooooooooooooooooooooooooooooooooooooooooo
' instalation des séparation pour la grille
for x=1 to 2
scene2d 11+x
top 11+x,top(1):height 11+x,height(1)-1
width 11+x,3: left 11+x,left(1)+(141*x)+1
next x
for x=1 to 2
scene2d 15+x
left 15+x,left(1): width 15+x,width(1)-1
height 15+x,3: top 15+x,top(1)+(141*x)+1
next x
' ooooooooooooooooooooooooooooooooooooooooooooooo

button 2          :alpha 22
left 2,460        :left 22,500
top 2,20          :top 22,20
width 2,31        :width 22,10
caption 2,"1"      :caption 22,"0"
on_click 2,choix

button 3          :alpha 23
left 3,460        :left 23,500
top 3,60          :top 23,60
width 3,30        :width 23,10
caption 3,"2"      :caption 23,"0"
on_click 3,choix1

button 4          :alpha 24
left 4,460        :left 24,500
top 4,100          :top 24,103
width 4,30        :width 24,10
caption 4,"3"      :caption 24,"0"
on_click 4,choix2

button 5          :alpha 25
left 5,460        :left 25,500
top 5,140          :top 25,143
width 5,30        :width 25,10
caption 5,"4"      :caption 25,"0"
on_click 5,choix3

button 6          :alpha 26
left 6,460        :left 26,500
top 6,180          :top 26,183
width 6,30        :width 26,10
caption 6,"5"      :caption 26,"0"
on_click 6,choix4

button 7          :alpha 27
left 7,460        :left 27,500
top 7,220          :top 27,223
width 7,30        :width 27,10
caption 7,"6"      :caption 27,"0"
on_click 7,choix5

button 8          :alpha 28
left 8,460        :left 28,500
top 8,260          :top 28,263
width 8,30        :width 28,10
caption 8,"7"      :caption 28,"0"
on_click 8,choix6

button 9          :alpha 29
left 9,460        :left 29,500
top 9,300          :top 29,303
width 9,30        :width 29,10
caption 9,"8"      :caption 29,"0"
on_click 9,choix7

button 10          :alpha 30
left 10,460        :left 30,500
top 10,340        :top 30,343
width 10,30        :width 30,10
caption 10,"9"    :caption 30,"0"
on_click 10,choix8

button 31
left 31,460
top 31,380
caption 31,"Annuler"
label Annuler : on_click 31,Annuler

label nouveau,quitter,Recomencer
main_menu 41
sub_menu 42:parent 42,41:caption 42,"jeu"
sub_menu 43:parent 43,42:caption 43,"Nouveau"
on_click 43,nouveau
sub_menu 44:parent 44,42:caption 44,"Recomencer"
on_click 44,Recomencer

sub_menu 46:parent 46,42:caption 46,"Quitter"
on_click 46,quitter

dll_on "KGF.dll"
  res% = dll_call6("GridFunction",object_internal(1),5,1,0,0,0)

end

' triage des chiffres
tri:
for x=1 to 9
trie:
y=int(rnd(9))+1
if suite$(1,y)=""
suite$(1,y)=str$(x)
else
goto trie
end_if
next x
 a1$=suite$(1,1)
 a2$=suite$(1,2)
 a3$=suite$(1,3)
 a4$=suite$(1,4)
 a5$=suite$(1,5)
 a6$=suite$(1,6)
 a7$=suite$(1,7)
 a8$=suite$(1,8)
 a9$=suite$(1,9)
' ooooooooooooooooooooooooooooooo
jeux() :' initialisation de la grille
return

' jeu en lui même
choix:
 num$=caption$(2)
return
choix1:
 num$=caption$(3)
return
choix2:
 num$=caption$(4)
return
choix3:
 num$=caption$(5)
return
choix4:
 num$=caption$(6)
return
choix5:
 num$=caption$(7)
return
choix6:
 num$=caption$(8)
return
choix7:
 num$=caption$(9)
return
choix8:
 num$=caption$(10)
return

jeu:
posx%=grid_x_to_column(1,mouse_x_position(1))
posy%=grid_y_to_row(1,mouse_y_position(1))

' section des recherche des doublons par ligne, colones et section 3X3
if clicked(1)=1
 if grid_read$(1,posy%,posx%)<>"" then return
 if num$="" then return
' doubon dans la ligne
 for x=2 to 10
  if grid_read$(1,posy%,x)="  "+num$
  message "DOUBLON "+num$+"  C"+str$(posy%)+"  L"+str$(x)
  return
  end_if
 next x
' Doublon dans la colone
 for y=2 to 10
  if grid_read$(1,y,posx%)="  "+num$
  message "DOUBLON "+num$+"  C"+str$(y)+"  L"+str$(posx%)
  return
  end_if
 next y
' Doublon dans les section 3X3
 if posx%>1 and posx%<5
 if posy%>1 and posy%<5
    for x=2 to 4
    for y=2 to 4
      if grid_read$(1,y,x)="  "+num$
        message "DOUBLON "+num$+"  C"+str$(y)+"  L"+str$(x)
        return
      end_if
    next y
    next x
 end_if
 end_if

 if posx%>4 and posx%<8
 if posy%>1 and posy%<5
    for x=5 to 7
    for y=2 to 4
      if grid_read$(1,y,x)="  "+num$
        message "DOUBLON "+num$+"  C"+str$(y)+"  L"+str$(x)
        return
      end_if
    next y
    next x
 end_if
 end_if

 if posx%>7 and posx%<11
 if posy%>1 and posy%<5
    for x=8 to 10
    for y=2 to 4
      if grid_read$(1,y,x)="  "+num$
        message "DOUBLON "+num$+"  C"+str$(y)+"  L"+str$(x)
        return
      end_if
    next y
    next x
 end_if
 end_if

 if posx%>1 and posx%<5
 if posy%>4 and posy%<8
    for x=2 to 4
    for y=5 to 7
      if grid_read$(1,y,x)="  "+num$
        message "DOUBLON "+num$+"  C"+str$(y)+"  L"+str$(x)
        return
      end_if
    next y
    next x
 end_if
 end_if

 if posx%>4 and posx%<8
 if posy%>4 and posy%<8
    for x=5 to 7
    for y=5 to 7
      if grid_read$(1,y,x)="  "+num$
        message "DOUBLON "+num$+"  C"+str$(y)+"  L"+str$(x)
        return
      end_if
    next y
    next x
 end_if
 end_if

 if posx%>7 and posx%<11
 if posy%>4 and posy%<8
    for x=8 to 10
    for y=5 to 7
      if grid_read$(1,y,x)="  "+num$
        message "DOUBLON "+num$+"  C"+str$(y)+"  L"+str$(x)
        return
      end_if
    next y
    next x
 end_if
 end_if

 if posx%>1 and posx%<5
 if posy%>7 and posy%<11
    for x=2 to 4
    for y=8 to 10
      if grid_read$(1,y,x)="  "+num$
        message "DOUBLON "+num$+"  C"+str$(y)+"  L"+str$(x)
        return
      end_if
    next y
    next x
 end_if
 end_if

 if posx%>4 and posx%<8
 if posy%>7 and posy%<11
    for x=5 to 7
    for y=8 to 10
      if grid_read$(1,y,x)="  "+num$
        message "DOUBLON "+num$+"  C"+str$(y)+"  L"+str$(x)
        return
      end_if
    next y
    next x
 end_if
 end_if

 if posx%>7 and posx%<11
 if posy%>7 and posy%<11
    for x=8 to 10
    for y=8 to 10
      if grid_read$(1,y,x)="  "+num$
        message "DOUBLON "+num$+"  C"+str$(y)+"  L"+str$(x)
        return
      end_if
    next y
    next x
 end_if
 end_if

end_if
test()
grid_write 1,posy%,posx%,num$

 ' mise a jour des compteur
if num$="1" then num1%=num1%+1 : caption 22,str$(num1%)
if num$="2" then num2%=num2%+1 : caption 23,str$(num2%)
if num$="3" then num3%=num3%+1 : caption 24,str$(num3%)
if num$="4" then num4%=num4%+1 : caption 25,str$(num4%)
if num$="5" then num5%=num5%+1 : caption 26,str$(num5%)
if num$="6" then num6%=num6%+1 : caption 27,str$(num6%)
if num$="7" then num7%=num7%+1 : caption 28,str$(num7%)
if num$="8" then num8%=num8%+1 : caption 29,str$(num8%)
if num$="9" then num9%=num9%+1 : caption 30,str$(num9%)

' neutralise si une des séries est complétées
if caption$(22)="9"
inactive 2
inactive 22
num%=num%+1
end_if
if caption$(23)="9"
inactive 3
inactive 23
num%=num%+1
end_if
if caption$(24)="9"
inactive 4
inactive 24
num%=num%+1
end_if
if caption$(25)="9"
inactive 5
inactive 25
num%=num%+1
end_if
if caption$(26)="9"
inactive 6
inactive 26
num%=num%+1
end_if
if caption$(27)="9"
inactive 7
inactive 27
num%=num%+1
end_if
if caption$(28)="9"
inactive 8
inactive 28
num%=num%+1
end_if
if caption$(29)="9"
inactive 9
inactive 29
num%=num%+1
end_if
if caption$(30)="9"
inactive 10
inactive 30
num%=num%+1
end_if
if num%=9 then message "Grille résolu bravo"+chr$(10)+"Vous avez gagné"
num%=0
return

Recomencer:
if file_exists("grid.ini")=0 then return
grid_load 1,"grid.ini"
for x=2 to 10
 active x
 active x+20
next x
return

quitter:
if file_exists("grid.ini")=1 then file_delete "grid.ini"
res% = dll_call1("KillProcessByHandle",handle(0))
dll_off
return

Annuler:
if num$="" then return
if grid_read$(1,posy%,posx%)="1"
 num1%=num1%-1 : caption 22,str$(num1%)
 if num1%<9 then active 2
 if num1%<9 then active 22
end_if
if grid_read$(1,posy%,posx%)="2"
 num2%=num2%-1 : caption 23,str$(num2%)
 if num2%<9 then active 3
 if num2%<9 then active 23
end_if
if grid_read$(1,posy%,posx%)="3"
 num3%=num3%-1 : caption 24,str$(num3%)
 if num3%<9 then active 4
 if num3%<9 then active 24
end_if
if grid_read$(1,posy%,posx%)="4"
 num4%=num4%-1 : caption 25,str$(num4%)
 if num4%<9 then active 5
 if num4%<9 then active 25
end_if
if grid_read$(1,posy%,posx%)="5"
 num5%=num5%-1 : caption 26,str$(num5%)
 if num5%<9 then active 6
 if num5%<9 then active 26
end_if
if grid_read$(1,posy%,posx%)="6"
 num6%=num6%-1 : caption 27,str$(num6%)
 if num6%<9 then active 7
 if num6%<9 then active 27
end_if
if grid_read$(1,posy%,posx%)="7"
 num7%=num7%-1 : caption 28,str$(num7%)
 if num7%<9 then active 8
 if num7%<9 then active 28
end_if
if grid_read$(1,posy%,posx%)="8"
 num8%=num8%-1 : caption 29,str$(num8%)
 if num8%<9 then active 9
 if num8%<9 then active 29
end_if
if grid_read$(1,posy%,posx%)="9"
 num9%=num9%-1 : caption 30,str$(num9%)
 if num9%<9 then active 10
 if num9%<9 then active 30
end_if
  grid_write 1,posy%,posx%,""

return

nouveau:
' obligé de faire cette commande pour éffacer la grille
' avec grid_clear N,R,C ça plante!
  res% = dll_call6("GridFunction",object_internal(1),5,1,0,0,0)
for x=2 to 10
for y=2 to 10
  grid_write 1,x,y,""
next y
next x
wait 1000
for x=2 to 10
 active x
 active x+20
next x
free suite$(1,9)
dim suite$(1,9)
gosub tri
return

' ooooooooooooooooooooooooooooooooooooooooooooo

' initialisation de la grille
sub jeux()
gride1$ =a1$+a2$+a3$+a4$+a5$+a6$+a7$+a8$+a9$
gride2$ =a7$+a6$+a9$+a3$+a8$+a1$+a2$+a5$+a4$
gride3$ =a4$+a5$+a8$+a9$+a7$+a2$+a3$+a1$+a6$
gride4$ =a9$+a3$+a4$+a5$+a1$+a7$+a6$+a2$+a8$
gride5$ =a2$+a1$+a6$+a8$+a9$+a3$+a4$+a7$+a5$
gride6$ =a8$+a7$+a5$+a6$+a2$+a4$+a1$+a9$+a3$
gride7$ =a6$+a9$+a7$+a1$+a4$+a5$+a8$+a3$+a2$
gride8$ =a3$+a8$+a1$+a2$+a6$+a9$+a5$+a4$+a7$
gride9$ =a5$+a4$+a2$+a7$+a3$+a8$+a9$+a6$+a1$

for x=1 to 9
z%=int(rnd(1))
grid_write 1,2,x+1,"  "+mid$(gride1$,x,1)
z%=int(rnd(2)):if z%=0 then grid_write 1,2,x+1,""

grid_write 1,3,x+1,"  "+mid$(gride2$,x,1)
z%=int(rnd(2)):if z%=0 then grid_write 1,3,x+1,""

grid_write 1,4,x+1,"  "+mid$(gride3$,x,1)
z%=int(rnd(2)):if z%=0 then grid_write 1,4,x+1,""

grid_write 1,5,x+1,"  "+mid$(gride4$,x,1)
z%=int(rnd(2)):if z%=0 then grid_write 1,5,x+1,""

grid_write 1,6,x+1,"  "+mid$(gride5$,x,1)
z%=int(rnd(1)):if z%=0 then grid_write 1,6,x+1,""

grid_write 1,7,x+1,"  "+mid$(gride6$,x,1)
z%=int(rnd(2)):if z%=0 then grid_write 1,7,x+1,""

grid_write 1,8,x+1,"  "+mid$(gride7$,x,1)
z%=int(rnd(2)):if z%=0 then grid_write 1,8,x+1,""

grid_write 1,9,x+1,"  "+mid$(gride8$,x,1)
z%=int(rnd(2)):if z%=0 then grid_write 1,9,x+1,""

grid_write 1,10,x+1,"  "+mid$(gride9$,x,1)
z%=int(rnd(2)):if z%=0 then grid_write 1,10,x+1,""
next x
comptage()
grid_save 1,10,10,"Grid.ini"
end_sub

sub comptage()
for x=2 to 10
for y=2 to 10
if grid_read$(1,y,x)="  1" then num1%=num1%+1 : caption 22,str$(num1%)
if grid_read$(1,y,x)="  2" then num2%=num2%+1 : caption 23,str$(num2%)
if grid_read$(1,y,x)="  3" then num3%=num3%+1 : caption 24,str$(num3%)
if grid_read$(1,y,x)="  4" then num4%=num4%+1 : caption 25,str$(num4%)
if grid_read$(1,y,x)="  5" then num5%=num5%+1 : caption 26,str$(num5%)
if grid_read$(1,y,x)="  6" then num6%=num6%+1 : caption 27,str$(num6%)
if grid_read$(1,y,x)="  7" then num7%=num7%+1 : caption 28,str$(num7%)
if grid_read$(1,y,x)="  8" then num8%=num8%+1 : caption 29,str$(num8%)
if grid_read$(1,y,x)="  9" then num9%=num9%+1 : caption 30,str$(num9%)
next y
next x
end_sub

sub test()
  ' Atribut du texte
  res% = dll_call6("GridFunction",object_internal(1),9,1,20,adr(font$),0)
  ' changer la couleur d'une cellule
  RGB(0,0,0)  : ' écriture noir
  FRGB% = RGB%
  RGB(255,255,255)  : ' fond blanc
  res% = dll_call6("GridFunction",object_internal(1),2,posx%-1,posy%-1,RGB%,FRGB%)
end_sub

sub RGB(R%,G%,B%) : ' produire une valeur RGB valide
 RGB% = (B%*256+R%)*256+G%
end_sub