Je vais ensuite mettre ce petit programme sur mon site. Question bête, il n'y a pas de problème de droit ? il y a plein de site qui propose des grilles gratuitement donc je pense pas mais je sais pas comment être sur.
Code : Tout sélectionner
; Auteur : Le Soldat Inconnu
; Version de PB : 4
;
; Explication du programme :
; Pour jouer au Sudoku
Structure Structure_Case
Valeur.s
ValeurMemoire.s[3]
Gadget.l
Image.l
Original.l
Souris.l
EndStructure
Enumeration
#Rechercher
#Verifier
#Sauver
#Charger
#ViderTout
#ViderReponses
#Nouvelle_Facile
#Nouvelle_Moyenne
#Nouvelle_Difficile
#Nouvelle_TresDifficile
#Info
#Barre
EndEnumeration
#Case_Nb = 9
#Case_Separation = 3
#Case_Espace = 2
#Case_ValeurDefaut = "123456789"
#Bouton_H = 25
Global Police_Gras, Police_Normal, Case_SourisActive.l, Case_T.l, SousCase_Nb.l, SousCase_T.l
Global Dim Sudoku.Structure_Case(#Case_Nb - 1, #Case_Nb - 1)
Procedure.l LoadWindowFont(Bold = -1, Italic = -1, UnderLine = -1)
Protected ncm.NONCLIENTMETRICS
ncm\cbSize = SizeOf(NONCLIENTMETRICS)
SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @ncm, 0)
If Bold = 0
ncm\lfMessageFont\lfWeight = 0
ElseIf Bold = 1
ncm\lfMessageFont\lfWeight = 700
EndIf
If Italic = 0
ncm\lfMessageFont\lfItalic = 0
ElseIf Italic = 1
ncm\lfMessageFont\lfItalic = 1
EndIf
If UnderLine = 0
ncm\lfMessageFont\lfUnderline = 0
ElseIf UnderLine = 1
ncm\lfMessageFont\lfUnderline = 1
EndIf
ProcedureReturn CreateFontIndirect_( @ncm\lfMessageFont)
EndProcedure
Procedure Information()
Texte.s = "Auteur : LSI Développements"
Texte + Chr(10) + "Site : www.lsi-dev.com"
Texte + Chr(10) + "Logiciel de programmation : PureBasic (www.purebasic.fr)"
Texte + Chr(10)
Texte + Chr(10) + "Ce logiciel est gratuit. Il est formellement interdit de le vendre sans mon autorisation écrite."
Texte + Chr(10) + "L'utilisation de ce logiciel est à vos risques et périls. Je ne pourrais pas être tenue pour responsable de tous problèmes causés par ce logiciel."
MessageRequester("Sudoku", Texte)
EndProcedure
Procedure.l ValeurValide(x, y, NouvelleGrille = 0)
If Len(Sudoku(x, y)\Valeur) <> 1 Or Sudoku(x, y)\Original
ProcedureReturn 1
EndIf
; On vérifie la ligne verticale
Compteur = 0
For yy = 0 To #Case_Nb - 1
If yy <> y And Sudoku(x, yy)\Valeur <> #Case_ValeurDefaut
If NouvelleGrille
Compteur + 1
If Compteur > Len(#Case_ValeurDefaut) / 2 ; Pour une nouvelle grille, une valeur n'est pas valide si on remplie plus de la moitié de la ligne
ProcedureReturn 0
EndIf
EndIf
If FindString(Sudoku(x, yy)\Valeur, Sudoku(x, y)\Valeur, 1)
ProcedureReturn 0
EndIf
EndIf
Next
; On vérifie la ligne horizontale
Compteur = 0
For xx = 0 To #Case_Nb - 1
If xx <> x And Sudoku(xx, y)\Valeur <> #Case_ValeurDefaut
If NouvelleGrille
Compteur + 1
If Compteur > Len(#Case_ValeurDefaut) / 2 ; Pour une nouvelle grille, une valeur n'est pas valide si on remplie plus de la moitié de la ligne
ProcedureReturn 0
EndIf
EndIf
If FindString(Sudoku(xx, y)\Valeur, Sudoku(x, y)\Valeur, 1)
ProcedureReturn 0
EndIf
EndIf
Next
; On vérifie le carré
Compteur = 0
For n = 0 To #Case_Nb - 1 Step #Case_Separation
For nn = 0 To #Case_Nb - 1 Step #Case_Separation
If x >= n And x < n + #Case_Separation And y >= nn And y < nn + #Case_Separation ; On recherche le bon carré
For xx = n To n + #Case_Separation - 1
For yy = nn To nn + #Case_Separation - 1
If xx <> x And yy <> y And Sudoku(xx, yy)\Valeur <> #Case_ValeurDefaut
If NouvelleGrille
Compteur + 1
If Compteur > Len(#Case_ValeurDefaut) / 2 ; Pour une nouvelle grille, une valeur n'est pas valide si on remplie plus de la moitié du carré
ProcedureReturn 0
EndIf
EndIf
If FindString(Sudoku(xx, yy)\Valeur, Sudoku(x, y)\Valeur, 1)
ProcedureReturn 0
EndIf
EndIf
Next
Next
EndIf
Next
Next
ProcedureReturn 1
EndProcedure
Procedure DessinCase(x, y)
; Aide sur la case
If Sudoku(x, y)\Valeur = #Case_ValeurDefaut
GadgetToolTip(Sudoku(x, y)\Gadget, "Clic droit sur une valeur pour définir la grille de départ (Valeur en orange)")
Else
GadgetToolTip(Sudoku(x, y)\Gadget, "")
EndIf
StartDrawing(ImageOutput(Sudoku(x, y)\Image))
Box(0, 0, Case_T, Case_T, $FFFFFF)
DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_Outlined)
ValeurValide = ValeurValide(x, y)
If Sudoku(x, y)\Souris Or (Len(Sudoku(x, y)\Valeur) > 1 And Len(Sudoku(x, y)\Valeur) < Len(#Case_ValeurDefaut)) Or ValeurValide = 0 ; Affichage complet si on survole à la souris ou si il existe plusieurs possibilité
Index = 0
For nn = 0 To SousCase_Nb - 1
For n = 0 To SousCase_Nb - 1
Index + 1
Texte.s = Mid(#Case_ValeurDefaut, Index, 1)
If Texte
Box(n * SousCase_T, nn * SousCase_T, SousCase_T + 1, SousCase_T + 1, $E0E0E0)
If FindString(Sudoku(x, y)\Valeur, Texte, 1)
If Len(Sudoku(x, y)\Valeur) = 1 And ValeurValide ; Si on connait la valeur de la case
If Sudoku(x, y)\Original
Couleur = $0080E0
Else
Couleur = $000000
EndIf
DrawingFont(Police_Gras)
Else
Couleur = $404040
DrawingFont(Police_Normal)
EndIf
ElseIf Sudoku(x, y)\Valeur = "" ; Si on a une erreur, pas de valeur sur la case. On affiche tout les chiffres en rouge
Couleur = $0000FF
DrawingFont(Police_Normal)
ElseIf Sudoku(x, y)\Souris ; Si on est survolée par la souris
Couleur = $B0B0B0
DrawingFont(Police_Normal)
Else ; Sinon on n'affiche rien
Couleur = $FFFFFF
DrawingFont(Police_Normal)
EndIf
DrawText(n * SousCase_T + (SousCase_T - TextWidth(Texte)) / 2, nn * SousCase_T + (SousCase_T - TextHeight(Texte)) / 2, Texte, Couleur)
EndIf
Next
Next
Else ; Affichage réduit quand on ne survole pas la case
If Len(Sudoku(x, y)\Valeur) <= 1
If Sudoku(x, y)\Original
Couleur = $0080E0
Else
Couleur = $000000
EndIf
DrawingFont(Police_Gras)
Texte = Sudoku(x, y)\Valeur
If Texte = "" ; Si on a une erreur, pas de valeur sur la case. On affiche 0 en rouge
Texte = "0"
Couleur = $0000FF
EndIf
DrawText((SousCase_Nb * SousCase_T - TextWidth(Texte)) / 2, (SousCase_Nb * SousCase_T - TextHeight(Texte)) / 2, Texte, Couleur)
EndIf
EndIf
Box(0, 0, SousCase_Nb * SousCase_T + 1, SousCase_Nb * SousCase_T + 1, $000000)
StopDrawing()
; On affiche l'image
SetGadgetState(Sudoku(x, y)\Gadget, ImageID(Sudoku(x, y)\Image))
EndProcedure
Procedure CaseSelection(x, y)
; Si on a fait un clic droit, on met la case en couleur
If EventType() = #PB_EventType_RightClick
Original = 1
EndIf
; Position du clic sur l'image
Clic_X = WindowMouseX(0) - GadgetX(Sudoku(x, y)\Gadget)
Clic_Y = WindowMouseY(0) - GadgetY(Sudoku(x, y)\Gadget)
; Case cliquée
SousCase_X = Clic_X / SousCase_T
SousCase_Y = Clic_Y / SousCase_T
; Valeur cliquée
Index = SousCase_Y * SousCase_Nb + SousCase_X + 1
Valeur.s = Mid(#Case_ValeurDefaut, Index, 1)
If FindString(Sudoku(x, y)\Valeur, Valeur, 1) ; Si le chiffre cliqué exite déjà
If Len(Sudoku(x, y)\Valeur) = Len(#Case_ValeurDefaut) ; Si tous les chiffres existaient déjà, on ne garde que le chiffre cliqué
Sudoku(x, y)\Valeur = Valeur
Sudoku(x, y)\Original = Original
Else ; Sinon, on retire le chiffre cliqué
Sudoku(x, y)\Valeur = ReplaceString(Sudoku(x, y)\Valeur, Valeur, "")
If Sudoku(x, y)\Valeur = "" ; Si on a retiré tous les chiffres, on les remet tous
Sudoku(x, y)\Valeur = #Case_ValeurDefaut
Sudoku(x, y)\Original = 0
EndIf
EndIf
ElseIf Sudoku(x, y)\Valeur = "" ; Si on souhaite corriger une erreur
Sudoku(x, y)\Valeur = Valeur
Sudoku(x, y)\Original = 0
Else
; tout ce bazar, c'est pour garder les numéros dans le bon ordre
For n = 1 To Len(Sudoku(x, y)\Valeur)
Texte.s = Mid(Sudoku(x, y)\Valeur, n, 1)
Emplacement = FindString(#Case_ValeurDefaut, Texte, 1)
If Emplacement > Index
Sudoku(x, y)\Valeur = Left(Sudoku(x, y)\Valeur, n - 1) + Valeur + Right(Sudoku(x, y)\Valeur, Len(Sudoku(x, y)\Valeur) - n + 1)
Break
EndIf
If n = Len(Sudoku(x, y)\Valeur)
Sudoku(x, y)\Valeur + Valeur
Break
EndIf
Next
Sudoku(x, y)\Original = 0
EndIf
DessinCase(x, y)
For x = 0 To #Case_Nb - 1
For y = 0 To #Case_Nb - 1
If Len(Sudoku(x, y)\Valeur) = 1
DessinCase(x, y)
EndIf
Next
Next
EndProcedure
Procedure CaseSouris()
; Analyse de la case survolée par la souris
GadgetID = WindowFromPoint_(DesktopMouseX(), DesktopMouseY()) ; ID de la fenêtre sous la souris
Case_SourisActive = 0
For x = 0 To #Case_Nb - 1
For y = 0 To #Case_Nb - 1
If GadgetID(Sudoku(x, y)\Gadget) = GadgetID ; On change l'affichage de la case survolée
If Sudoku(x, y)\Souris = 0
Sudoku(x, y)\Souris = 1
DessinCase(x, y)
EndIf
Case_SourisActive = 1
Else
If Sudoku(x, y)\Souris = 1
Sudoku(x, y)\Souris = 0
DessinCase(x, y)
EndIf
EndIf
Next
Next
EndProcedure
Procedure Sauver()
Grille.s = SaveFileRequester("Sudoku - Sauver", GetCurrentDirectory() + "Grille " + FormatDate("%yyyy-%mm-%dd %hh-%ii-%ss", Date()) + ".sudoku", "Grille sudoku|*.sudoku", 0)
If Grille
If LCase(GetExtensionPart(Grille)) <> "sudoku"
Grille + ".sudoku"
EndIf
If CheckFilename(GetFilePart(Grille))
If CreatePreferences(Grille)
For x = 0 To #Case_Nb - 1
For y = 0 To #Case_Nb - 1
WritePreferenceString(Str(x) + "x" + Str(y), Sudoku(x, y)\Valeur)
If Len(Sudoku(x, y)\Valeur) = 1
WritePreferenceLong(Str(x) + "x" + Str(y) + " Original", Sudoku(x, y)\Original)
EndIf
Next
Next
ClosePreferences()
Else
MessageRequester("Sudoku - Erreur", "Impossible de créer la sauvegarde")
EndIf
Else
MessageRequester("Sudoku - Erreur", "Nom de fichier incorrect")
EndIf
EndIf
EndProcedure
Procedure Charger()
Grille.s = OpenFileRequester("Sudoku - Sauver", GetCurrentDirectory(), "Grille sudoku|*.sudoku", 0)
If Grille
OpenPreferences(Grille)
For x = 0 To #Case_Nb - 1
For y = 0 To #Case_Nb - 1
Sudoku(x, y)\Valeur = ReadPreferenceString(Str(x) + "x" + Str(y), "")
If Len(Sudoku(x, y)\Valeur) = 1
Sudoku(x, y)\Original = ReadPreferenceLong(Str(x) + "x" + Str(y) + " Original", 1)
Else
Sudoku(x, y)\Original = 0
EndIf
DessinCase(x, y)
Next
Next
ClosePreferences()
EndIf
EndProcedure
Procedure.f GrilleRemplie() ; Retourne le pourcentage de remplissage de la grille, un retour à 0 signifie que la grille est fausse
Compteur = 0
For x = 0 To #Case_Nb - 1
For y = 0 To #Case_Nb - 1
If Sudoku(x, y)\Valeur
Compteur + Len(Sudoku(x, y)\Valeur)
Else
ProcedureReturn 0
EndIf
Next
Next
ProcedureReturn #Case_Nb * #Case_Nb / Compteur
EndProcedure
Procedure MemoriserGrille(Index = 0)
For x = 0 To #Case_Nb - 1
For y = 0 To #Case_Nb - 1
Sudoku(x, y)\ValeurMemoire[Index] = Sudoku(x, y)\Valeur
Next
Next
EndProcedure
Procedure RestaurerGrille(Index = 0)
For x = 0 To #Case_Nb - 1
For y = 0 To #Case_Nb - 1
Sudoku(x, y)\Valeur = Sudoku(x, y)\ValeurMemoire[Index]
If Index = 0
DessinCase(x, y)
EndIf
Next
Next
EndProcedure
Procedure Analyse_Afficher()
For x = 0 To #Case_Nb - 1
For y = 0 To #Case_Nb - 1
DessinCase(x, y)
Next
Next
EndProcedure
Procedure Analyse(Test.l = 0, Niveau.l = 99)
Protected Nouveau.s, Evolution.l, CompteurNiveau4.l
; On va traiter par passe sucessive les cases jusqu'à ce qu'il ne reste plus qu'une seule possibilité dans chaque case
; Le niveau d'analyse est utiliser pour créer une nouvelle, il permet de tester la difficulté de la grille
CompteurNiveau4 = 0 ; Utiliser pour la recherche de nouvelle grille
; L'affichage ne se fait que si le niveau est de 99, donc si on ne recherche pas une nouvelle grille
; La recherche de nouvelle grille est complexe, il ne faut pas d'affichage pour arriver à trouver une nouvelle grille rapidement
Repeat
Repeat
Evolution = 0
;- Les lignes verticales
For x = 0 To #Case_Nb - 1
; on retire tous les cas impossible. si on a une case valide, on retire le chiffre de cette case à toutes les autres case de la ligne
If Niveau >= 1
For y = 0 To #Case_Nb - 1
If Len(Sudoku(x, y)\Valeur) = 1 ; Si case valide
For nn = 0 To #Case_Nb - 1
If nn <> y
Nouveau = RemoveString(Sudoku(x, nn)\Valeur, Sudoku(x, y)\Valeur)
If Sudoku(x, nn)\Valeur <> Nouveau
Sudoku(x, nn)\Valeur = Nouveau
Evolution = 1
EndIf
EndIf
Next
EndIf
Next
EndIf
; Si un chiffre n'existe plus qu'une fois sur la ligne, on le valide
If Niveau >= 2
For Index = 1 To Len(#Case_ValeurDefaut)
Compteur = 0
Texte.s = Mid(#Case_ValeurDefaut, Index, 1)
For y = 0 To #Case_Nb - 1 ; on compte le nombre de fois que le chiffre existe
If FindString(Sudoku(x, y)\Valeur, Texte, 1)
Compteur + 1
nn = y
EndIf
Next
If Compteur = 1 And Sudoku(x, nn)\Valeur <> Texte ; Si le chiffre n'existe qu'une fois, on le valide
Sudoku(x, nn)\Valeur = Texte
Evolution = 1
EndIf
Next
EndIf
Next
;- Les lignes horizontales
For y = 0 To #Case_Nb - 1
; on retire tous les cas impossible. si on a une case valide, on retire le chiffre de cette case à toutes les autres case de la ligne
If Niveau >= 1
For x = 0 To #Case_Nb - 1
If Len(Sudoku(x, y)\Valeur) = 1 ; Si case valide
For n = 0 To #Case_Nb - 1
If n <> x
Nouveau = RemoveString(Sudoku(n, y)\Valeur, Sudoku(x, y)\Valeur)
If Sudoku(n, y)\Valeur <> Nouveau
Sudoku(n, y)\Valeur = Nouveau
Evolution = 1
EndIf
EndIf
Next
EndIf
Next
EndIf
; Si un chiffre n'existe plus qu'une fois sur la ligne, on le valide
If Niveau >= 2
For Index = 1 To Len(#Case_ValeurDefaut)
Compteur = 0
Texte.s = Mid(#Case_ValeurDefaut, Index, 1)
For x = 0 To #Case_Nb - 1 ; on compte le nombre de fois que le chiffre existe
If FindString(Sudoku(x, y)\Valeur, Texte, 1)
Compteur + 1
n = x
EndIf
Next
If Compteur = 1 And Sudoku(n, y)\Valeur <> Texte ; Si le chiffre n'existe qu'une fois, on le valide
Sudoku(n, y)\Valeur = Texte
Evolution = 1
EndIf
Next
EndIf
Next
;- Les carrés
For x = 0 To #Case_Nb - 1 Step #Case_Separation
For y = 0 To #Case_Nb - 1 Step #Case_Separation
; On retire tous les cas impossible. si on a une case valide, on retire le chiffre de cette case à toutes les autres cases du carré
If Niveau >= 1
For xx = x To x + #Case_Separation - 1
For yy = y To y + #Case_Separation - 1
If Len(Sudoku(xx, yy)\Valeur) = 1 ; Si case valide
For n = x To x + #Case_Separation - 1
For nn = y To y + #Case_Separation - 1
If n <> xx And nn <> yy
Nouveau = RemoveString(Sudoku(n, nn)\Valeur, Sudoku(xx, yy)\Valeur)
If Sudoku(n, nn)\Valeur <> Nouveau
Sudoku(n, nn)\Valeur = Nouveau
Evolution = 1
EndIf
EndIf
Next
Next
EndIf
Next
Next
EndIf
; Si un chiffre n'existe plus qu'une fois dans le carré, on le valide
If Niveau >= 2
For Index = 1 To Len(#Case_ValeurDefaut)
Compteur = 0
Texte.s = Mid(#Case_ValeurDefaut, Index, 1)
For xx = x To x + #Case_Separation - 1 ; on compte le nombre de fois que le chiffre existe
For yy = y To y + #Case_Separation - 1
If FindString(Sudoku(xx, yy)\Valeur, Texte, 1)
Compteur + 1
n = xx
nn = yy
EndIf
Next
Next
If Compteur = 1 And Sudoku(n, nn)\Valeur <> Texte ; Si le chiffre n'existe qu'une fois, on le valide
Sudoku(n, nn)\Valeur = Texte
Evolution = 1
EndIf
Next
EndIf
; Si on a 2 cases avec les mêmes 2 chiffres, alors ces 2 chiffres ne peuvent pas exister ailleurs dans le carré
If Niveau >= 3
For xx = x To x + #Case_Separation - 1
For yy = y To y + #Case_Separation - 1
For Longueur = 2 To Len(#Case_ValeurDefaut) / 2
If Len(Sudoku(xx, yy)\Valeur) = Longueur ; Si case valide
Compteur = 0
For n = x To x + #Case_Separation - 1
For nn = y To y + #Case_Separation - 1
If Sudoku(xx, yy)\Valeur = Sudoku(n, nn)\Valeur
Compteur + 1
EndIf
Next
Next
If Compteur = Longueur
For n = x To x + #Case_Separation - 1
For nn = y To y + #Case_Separation - 1
If Sudoku(xx, yy)\Valeur <> Sudoku(n, nn)\Valeur
For Index = 1 To Longueur
Texte.s = Mid(Sudoku(xx, yy)\Valeur, Index, 1)
Nouveau = RemoveString(Sudoku(n, nn)\Valeur, Texte)
If Sudoku(n, nn)\Valeur <> Nouveau
Sudoku(n, nn)\Valeur = Nouveau
Evolution = 1
EndIf
Next
EndIf
Next
Next
EndIf
EndIf
Next
Next
Next
EndIf
; Si un chiffre n'existe que sur une ligne du carré, on supprime ce chiffre des autres cases de la meme ligne (en dehors du carré en cours)
If Niveau >= 3
For Index = 1 To Len(#Case_ValeurDefaut)
Texte.s = Mid(#Case_ValeurDefaut, Index, 1)
Horizontal = 1
Vertical = 1
Compteur = 0
For xx = x To x + #Case_Separation - 1 ; On regarde ou se trouve le chiffre dans le carré
For yy = y To y + #Case_Separation - 1
If FindString(Sudoku(xx, yy)\Valeur, Texte, 1)
Compteur + 1
If Compteur > 1
If n <> xx
Vertical = 0
EndIf
If nn <> yy
Horizontal = 0
EndIf
Else
n = xx
nn = yy
EndIf
EndIf
Next
Next
If Compteur > 1 ; Si on a trouvé le même chiffre plus d'une fois, sinon, cette analyse ne sert à rien
If Vertical ; Si on n'a le chiffre que sur une verticale
For yy = 0 To #Case_Nb - 1
If yy < y Or yy > y + #Case_Separation - 1 ; Sur les autres cases de la verticale
Nouveau = RemoveString(Sudoku(n, yy)\Valeur, Texte)
If Sudoku(n, yy)\Valeur <> Nouveau
Sudoku(n, yy)\Valeur = Nouveau
Evolution = 1
EndIf
EndIf
Next
EndIf
If Horizontal ; Si on n'a le chiffre que sur une horizontale
For xx = 0 To #Case_Nb - 1
If xx < x Or xx > x + #Case_Separation - 1 ; Sur les autres cases de l'horizontale
Nouveau = RemoveString(Sudoku(xx, nn)\Valeur, Texte)
If Sudoku(xx, nn)\Valeur <> Nouveau
Sudoku(xx, nn)\Valeur = Nouveau
Evolution = 1
EndIf
EndIf
Next
EndIf
EndIf
Next
EndIf
Next
Next
;- On affiche
If Test = 0 And Niveau = 99
Analyse_Afficher()
EndIf
While WindowEvent() : Wend ; On vide les évènements
Until Evolution = 0 ; Jusqu'à ce qu'on ne trouve plus rien à faire
; Dans le dernier retranchement des possibilités, on fait un essai sur une case (on valide une valeur au hazard) et on regarde si on ne trouve PAS de solution, cela signifie que la valeur validée n'est pas possible.
; ou alors quand on valide un chiffre, si on trouve la solution finale, c'est bon.
; Mais on ne valide pas de chiffre si après l'essai, on n'a pas de solution finale. Une solution imcomplète ne permet pas de valider un chiffre.
; on ne fait cette recherche que sur les cases à 2 chiffres pour limiter, sinon, ca veut dire que cette grille est intordable sans outil informatique
If Niveau >= 4
If Test = 0 ; Si on n'est pas déjà en train de faire des tests
If GrilleRemplie() <> 1 ; Si la grille n'est pas finie, on fait un test
For x = 0 To #Case_Nb - 1
For y = 0 To #Case_Nb - 1
If Len(Sudoku(x, y)\Valeur) = 2 ; On recherche une case avec 2 chiffres
For Index = 1 To Len(Sudoku(x, y)\Valeur) ; On fait l'essai avec chaque valeur de la case
MemoriserGrille(1) ; On enregistre la grille pour revenir en arrière après l'essai
Texte = Mid(Sudoku(x, y)\Valeur, Index, 1) ; On valide le premier chiffre
Sudoku(x, y)\Valeur = Texte
Analyse(1, Niveau)
Grille_Etat = GrilleRemplie()
If Grille_Etat = 1
If Niveau = 99
Analyse_Afficher()
EndIf
Break 3 ; On a finis la grille
Else
If Grille_Etat = 0 ; Le test à générer une erreur
; On est sur que la valeur validée n'est pas bonne
RestaurerGrille(1)
Sudoku(x, y)\Valeur = RemoveString(Sudoku(x, y)\Valeur, Texte)
If Niveau = 99
Analyse_Afficher()
EndIf
CompteurNiveau4 + 1
If Niveau = 99 Or CompteurNiveau4 <= 2 ; Dans le cas de la recherche de nouvelle grille, on n'autorise que 2 tests dans la grille, sinon, c'est trop complexe à résoudre.
Evolution = 1
EndIf
Break 3 ; On a trouvé une case
Else
; Aucun résultat du test
RestaurerGrille(1)
EndIf
EndIf
Next
EndIf
Next
Next
EndIf
EndIf
EndIf
Until Evolution = 0
EndProcedure
Procedure Vider(Tout = 1, Alerte = 1)
Compteur = 0
For x = 0 To #Case_Nb - 1
For y = 0 To #Case_Nb - 1
If Sudoku(x, y)\Valeur <> #Case_ValeurDefaut
Compteur + 1
EndIf
Next
Next
If Compteur
If Alerte
If Tout = 1 And MessageRequester("Sudoku - Effacer", "Effacer la grille ?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_No
ProcedureReturn
ElseIf Tout <> 1 And MessageRequester("Sudoku - Effacer", "Effacer les réponses ?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_No
ProcedureReturn
EndIf
EndIf
For x = 0 To #Case_Nb - 1
For y = 0 To #Case_Nb - 1
If (Tout Or Sudoku(x, y)\Original = 0) And Sudoku(x, y)\Valeur <> #Case_ValeurDefaut
Sudoku(x, y)\Valeur = #Case_ValeurDefaut
Sudoku(x, y)\Original = 0
If Alerte
DessinCase(x, y)
EndIf
EndIf
Next
Next
EndIf
EndProcedure
Procedure Solution()
Protected Nouveau.s, Evolution.l
; On va traiter par passe sucessive les cases jusqu'à ce qu'il ne reste plus qu'une seule possibilité dans chaque case
If MessageRequester("Sudoku", "Résoudre cette grille ?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
MemoriserGrille()
Analyse()
If GrilleRemplie() = 0
MessageRequester("Sudoku", "Impossible de résoudre la grille proposée")
RestaurerGrille()
EndIf
EndIf
EndProcedure
Procedure Verifier()
If GrilleRemplie() <> 1
MessageRequester("Sudoku", "La grille n'est pas remplie totalement")
Else
MemoriserGrille()
Analyse()
If GrilleRemplie() <> 1
MessageRequester("Sudoku", "Grille fausse")
RestaurerGrille()
Else
MessageRequester("Sudoku", "Grille résolue")
EndIf
EndIf
EndProcedure
Procedure Nouvelle(Niveau)
Protected Grille_OK, Grille_Etat.f, Grille_Etat_Max.f
Vider(1) ; On efface la grille
; On masque les cases du milieu pour afficher une barre de progression
For x = 1 To #Case_Nb - 2
HideGadget(Sudoku(x, Int(#Case_Nb / 2))\Gadget, 1)
Next
HideGadget(#Barre, 0)
; Départ de la recherche de la nouvelle grille
Repeat
Compteur = 0
Repeat
x = Random(#Case_Nb - 1)
y = Random(#Case_Nb - 1)
If Sudoku(x, y)\Valeur = #Case_ValeurDefaut
Sudoku(x, y)\Valeur = Mid(#Case_ValeurDefaut, Random(#Case_Nb - 1) + 1, 1)
If ValeurValide(x, y, 1) ; Si on a placé une valeur possible
Sudoku(x, y)\Original = 1
Compteur + 1
If Compteur > #Case_Nb ; on ne commence le test du niveau qu'après avoir mis 9 chiffres
For Index = 1 To Niveau
MemoriserGrille(2)
Analyse(0, Index)
Grille_Etat.f = GrilleRemplie() ; Etat de la grille
If Grille_Etat <> 0
If Grille_Etat = 1 ; Si la grille est faisable
If Index < Niveau
; Le niveau de la grille est trop facile, on recommence
Break 2
Else
; On a trouvé une grille du bon niveau
Grille_OK = 1
RestaurerGrille(2)
Break 2
EndIf
Else ; Sinon, on continue d'ajouter des chiffres
If Grille_Etat > Grille_Etat_Max ; Pour calculer la progression de la recherche de la nouvelle grille
Grille_Etat_Max = Grille_Etat
SetGadgetState(#Barre, 100 * Grille_Etat_Max * Grille_Etat_Max) ; On affiche la progression
EndIf
RestaurerGrille(2)
EndIf
Else
; Valeur fausse, elle donne lieu à une résolution fausse, on l'efface
RestaurerGrille(2)
Sudoku(x, y)\Valeur = #Case_ValeurDefaut
Sudoku(x, y)\Original = 0
Break
EndIf
Next
EndIf
Else ; Si la valeur n'est pas possible, on l'efface
Sudoku(x, y)\Valeur = #Case_ValeurDefaut
EndIf
EndIf
Until Compteur > #Case_Nb * #Case_Nb / 2 ; Si on a mis trop de chiffre, on arrête et on recommence
If Grille_OK = 0 ; On efface la grille pour recommencer
Vider(1, 0)
EndIf
Until Grille_OK
; On masque la barre de progression
For x = 1 To #Case_Nb - 2
HideGadget(Sudoku(x, Int(#Case_Nb / 2))\Gadget, 0)
Next
HideGadget(#Barre, 1)
Analyse_Afficher()
EndProcedure
;- Début du programme
Police_Normal = LoadWindowFont()
Police_Gras = LoadWindowFont(1)
; Détermination de la taille des cases en fonction de la police utilisée sous windows
#Image_Taille = 40
Image = CreateImage(#PB_Any, #Image_Taille, #Image_Taille)
StartDrawing(ImageOutput(Image))
DrawingFont(Police_Normal)
; Analyse de nombre de case
; On va dessiner une matrice SousCase_Nb*SousCase_Nb
SousCase_Nb = Round(Sqr(Len(#Case_ValeurDefaut)), #PB_Round_Up)
; Taille des sous case
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(Police_Normal)
Box(0, 0, #Image_Taille, #Image_Taille, $FFFFFF)
For Index = 1 To Len(#Case_ValeurDefaut)
Texte.s = Mid(#Case_ValeurDefaut, Index, 1)
DrawText(0, 0, Texte, $000000)
Next
; Largeur du caractere
; On n'utilise pas TextWidth() pour coller au plus près au dessin du caractère
x = 0
For n = 0 To #Image_Taille - 1
For nn = 0 To #Image_Taille - 1
If Point(n, nn) <> $FFFFFF
x + 1
Break
EndIf
Next
Next
; Hauteur du caractere
y = 0
For nn = 0 To #Image_Taille - 1
For n = 0 To #Image_Taille - 1
If Point(n, nn) <> $FFFFFF
y + 1
Break
EndIf
Next
Next
; On garde le plus grand entre x et y
If x > y
SousCase_T = x + 3
Else
SousCase_T = y + 3
EndIf
; Taille de la case totale
Case_T = SousCase_T * SousCase_Nb
StopDrawing()
FreeImage(Image)
; Création de la fenêtre et de la GadgetList
If OpenWindow(0, 0, 0, Case_T * #Case_Nb + #Case_Nb / #Case_Separation * #Case_Espace + #Case_Espace + 1, Case_T * #Case_Nb + #Case_Nb / #Case_Separation * #Case_Espace + #Case_Espace + 1 + MenuHeight(), "Sudoku", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget) = 0 Or CreateGadgetList(WindowID(0)) = 0
End
EndIf
StickyWindow(0, 1)
SetWindowColor(0, $000000)
If CreateMenu(0, WindowID(0))
MenuTitle("Grille")
OpenSubMenu("Nouvelle grille")
MenuItem(#Nouvelle_Facile, "Facile")
MenuItem(#Nouvelle_Moyenne, "Moyenne")
MenuItem(#Nouvelle_Difficile, "Difficile")
MenuItem(#Nouvelle_TresDifficile, "Très difficile")
CloseSubMenu()
OpenSubMenu("Effacer")
MenuItem(#ViderReponses, "Les réponses")
MenuItem(#ViderTout, "Toutes les cases")
CloseSubMenu()
MenuBar()
MenuItem(#Verifier, "Vérifier")
MenuItem(#Rechercher, "Résoudre")
MenuBar()
MenuItem(#Charger, "Ouvrir")
MenuItem(#Sauver, "Enregistrer")
MenuTitle("?")
MenuItem(#Info, "Licence et développeur")
EndIf
x_Compteur = 0
x_Decalage = #Case_Espace
For x = 0 To #Case_Nb - 1
x_Compteur + 1
If x_Compteur > #Case_Separation
x_Compteur = 1
x_Decalage + #Case_Espace
EndIf
y_Compteur = 0
y_Decalage = #Case_Espace
For y = 0 To #Case_Nb - 1
y_Compteur + 1
If y_Compteur > #Case_Separation
y_Compteur = 1
y_Decalage + #Case_Espace
EndIf
Sudoku(x, y)\Valeur = #Case_ValeurDefaut
Sudoku(x, y)\Image = CreateImage(#PB_Any, Case_T, Case_T)
Sudoku(x, y)\Gadget = ImageGadget(#PB_Any, x * Case_T + x_Decalage, y * Case_T + y_Decalage, Case_T, Case_T, ImageID(Sudoku(x, y)\Image))
DessinCase(x, y)
Next
Next
; Barre de progression
ProgressBarGadget(#Barre, #Case_Espace + Case_T, #Case_Espace + Int(#Case_Nb / 2) * Case_T + Int(Int(#Case_Nb / 2) / #Case_Separation) * #Case_Espace, WindowWidth(0) - (Case_T + #Case_Espace) * 2, Case_T, 0, 100)
HideGadget(#Barre, 1)
Repeat
Event = WaitWindowEvent(100)
Select Event
Case 0, #WM_MOUSEMOVE
; Suivant la position de la souris, l'affichage des cases est différents pour une meilleur lisibilié
; Toutes les 100 ms, on regarde. ou quand la souris bouge
CaseSouris()
Case #PB_Event_Menu
Select EventMenu()
Case #Sauver
Sauver()
Case #Charger
Charger()
Case #ViderTout
Vider(1)
Case #ViderReponses
Vider(0)
Case #Rechercher
; On recherche la solution
Solution()
Case #Verifier
Verifier()
Case #Nouvelle_Facile
Nouvelle(1)
Case #Nouvelle_Moyenne
Nouvelle(2)
Case #Nouvelle_Difficile
Nouvelle(3)
Case #Nouvelle_TresDifficile
Nouvelle(4)
Case #Info
Information()
EndSelect
Case #PB_Event_Gadget
; Quand on édite une case
For x = 0 To #Case_Nb - 1
For y = 0 To #Case_Nb - 1
If EventGadget() = Sudoku(x, y)\Gadget
CaseSelection(x, y)
EndIf
Next
Next
EndSelect
Until Event = #PB_Event_CloseWindow
; On supprime les polices chargées
If Police_Normal
DeleteObject_(Police_Normal)
EndIf
If Police_Gras
DeleteObject_(Police_Gras)
EndIf
End
