Sudoku 3x3 automatique

Télécharger le projet
Commenter

Description

Ce code vous permettra de résoudre tous les sudoku 3x3.
Une particularité : le code est identique à celui du 2x2 déjà publié,
seuls les paramètres de taille (hauteur, ordre...) changent à l'initialisation.

Source / Exemple : 


unit princ;

interface

uses
  Windows,declarations,calculs_pointeurs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, StdCtrls, Menus, ExtCtrls, ImgList,dessin;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    chainage: TButton;
    procedure ListBox1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure ListBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure chainageClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
// case sélectionnée.
i,j : integer;

function couleur(n_bloc : integer) : tcolor;
var
k,p : integer;
begin

if not(odd(ordre)) then
  begin
  // ordre pair
  k:= (n_bloc-1) mod ordre;
  p:= (n_bloc-1) div ordre;
    if odd(p) then
    begin
        if odd(k) then result:=clred else result:=clblack;
    end else
    begin
         if odd(k) then result:=clblack else result:=clred;
    end;
  end else
  begin
  // ordre impair
        if odd(n_bloc) then
        begin
        result:=clblack;
        end else
        begin
        result:=clred;
        end;
  end;

end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
valeur: string;
n_bloc,posx,posy : integer;
tp : pcell;
begin
n_bloc:=bloc(i,j);
valeur:= listbox1.Items[listbox1.itemindex];
canvas.Font.Color:=couleur(n_bloc);

tp:=extraire(ligne_index,i,j);
tp.valeur:=strtoint(valeur);
posx:=posi(i,j).x;
posy:=posi(i,j).y;
if (i=0) or (j=0) then valeur:='  ';
//affich_coul(valeur,posx,posy,couleur(n_bloc));
 //  valeur:=f_ens.valeur;
 //         aff:=inttostr(valeur);
          canvas.Font.Height:=35;
          canvas.Font.name:='papyrus';
          canvas.TextOut(posx,posy,valeur);

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
n_bloc : integer;
f_par,ens : pensemble;
tp : pcell;

begin
// ////////////Calcul du numero de bloc. ///////////////
j:=((x-pt_depart.x)div taille_case)+1;
i:=((y-pt_depart.y)div taille_case)+1;
 if (i>ordre*ordre) or (i<1)or(j>ordre*ordre) or (j<1) then
 begin
  i:=0 ;
  j:=0;
 end;
 if ((x-pt_depart.x)<0) or ((y-pt_depart.y)<0) then
 begin
  i:=0 ;
  j:=0;
 end;
 n_bloc:=bloc(i,j);
//////////// fin du calcul de n_bloc////////////
//posx:=posi(i,j).x;
//posy:=posi(i,j).y;
//if (i<>0) and (j<>0) then
//begin
//canvas.Font.Height:=hauteur_texte;
//end;

if effacement=false then
begin
// Ecriture des valeurs possibles pour une case.
//**********************************************
listbox1.Visible:=true;
listbox1.Clear;
ens:=valeurs_possibles(i,j);
f_par:=ens;

while f_par<>nil do
  begin
  listbox1.Items.Add(inttostr(f_par.valeur));
  f_par:=f_par.suiv;
  end;

end else
begin

tp:=extraire(ligne_index,i,j);
tp.valeur:=10;
//effacement:=efface(ligne_index);

end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
affich_grille;
end;

procedure TForm1.ListBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
listbox1.Visible:=false;
end;

procedure TForm1.chainageClick(Sender: TObject);
var
f_par,cellprec,c_index : pcell;
i,j,valeur :integer;
ens,temp,f_ens : pensemble;
val_trouvee,sudoku_termine,sudoku_impossible : boolean;
posx,posy : integer;
aff : string;

begin
if automatique then
begin
automatique:=false;
chainage.Caption:='recommencer un sudoku';

// Chainage des cases vides.
chainage_index:=nil;
 for i:=1 to ordre*ordre do
    for j:=1 to ordre*ordre do
    begin
        if extraire(ligne_index,i,j).valeur=10 then
        begin
           if chainage_index=nil then
           begin
              //cas de la première cellule chainée
              chainage_index:= extraire(ligne_index,i,j);
              chainage_index.cell_suiv:=nil;
              chainage_index.cell_prec:=nil;
           end else
           begin
               //cas des autres cellules chainées
               f_par:=chainage_index;
               while f_par.cell_suiv<>nil do
               begin
               cellprec:=f_par;
               f_par:=f_par.cell_suiv;
               f_par.cell_prec:=cellprec;
               end;
               f_par.cell_suiv:=extraire(ligne_index,i,j);
               extraire(ligne_index,i,j).cell_prec:=f_par;
               extraire(ligne_index,i,j).cell_suiv:=nil;
           end;
        end;
    end;

// Ecriture des valeurs possibles sur le chainage
f_par := chainage_index;

      while f_par.cell_suiv<>nil do
      begin
      i:=f_par.i;
      j:=f_par.j;
      ens:=valeurs_possibles(i,j);
        if f_par.ensemble=nil then
        begin
        f_par.ensemble:=ens;
        end else
        begin
        temp:= f_par.ensemble ;
        detruire(temp);
        f_par.ensemble:=ens;
        end;
      f_par:=f_par.cell_suiv;
      end;
//Ecriture de la dernière cellule chainée
      i:=f_par.i;
      j:=f_par.j;
      ens:=valeurs_possibles(i,j);
      if f_par.ensemble=nil then
      begin
        f_par.ensemble:=ens;
      end else
      begin
        temp:= f_par.ensemble ;
        detruire(temp);
        f_par.ensemble:=ens;
      end;

//------Calcul Automatique -------------

 c_index:=chainage_index;
 sudoku_termine:=false;
 sudoku_impossible:=false;

 while ((sudoku_termine=false) and (sudoku_impossible=false)) do
 begin
 // Recherche de la première valeur test avec util=false
 val_trouvee:=false;
 f_ens:=c_index.ensemble;

  if f_ens<>nil then
  begin
   while f_ens.suiv<>nil do
   begin
         if (f_ens.util=false)and(val_trouvee=false) then
         begin
          // Valeur trouvée - Affichage de cette valeur en bleu.
          f_ens.util:= true;val_trouvee:=true;
          canvas.Font.Color:=clblue;
           canvas.Font.Height:=35;
           canvas.Font.name:='papyrus';
          i:=c_index.i;
          j:=c_index.j;
          posx:=posi(i,j).x;
          posy:=posi(i,j).y;
          valeur:=f_ens.valeur;
          aff:=inttostr(valeur);
          canvas.TextOut(posx,posy,aff);
          c_index.valeur:=valeur;
         end;
   f_ens:=f_ens.suiv;
   end;
          // Test de la dernière valeur
         if (f_ens.util=false)and(val_trouvee=false) then
         begin
           // dernière valeur trouvée de l'ensemble
           // Affichage de cette valeur en bleu.
           f_ens.util:= true;val_trouvee:=true;
           canvas.Font.Color:=clblue;
           canvas.Font.Height:=35;
           canvas.Font.name:='papyrus';
           i:=c_index.i;
           j:=c_index.j;
           posx:=posi(i,j).x;
           posy:=posi(i,j).y;
           valeur:=f_ens.valeur;
           aff:=inttostr(valeur);
           canvas.TextOut(posx,posy,aff);
           c_index.valeur:=valeur;
         end;
  end;
   if val_trouvee then
   begin
   // Avancer dans le chainage
       if c_index.cell_suiv=nil then
       begin
         sudoku_termine:=true;
         canvas.Font.Color:=claqua;
         canvas.Font.name:='papyrus';
         canvas.Font.Height:=50;
         canvas.TextOut(150,20,'sudoku terminé...                ');
       end else
       begin
       f_par:=c_index.cell_suiv;
       // Recalcul des valeurs possibles des cellules suivantes.
           while f_par.cell_suiv<>nil do
           begin
             i:=f_par.i;j:=f_par.j;
             ens:=f_par.ensemble;
             detruire(ens);
             ens:=valeurs_possibles(i,j);
             f_par.ensemble:=ens;
             f_par:=f_par.cell_suiv;
           end;
           //Recalcul de la dernière cellule.
           i:=f_par.i;j:=f_par.j;
           ens:=f_par.ensemble;
           detruire(ens);
           ens:=valeurs_possibles(i,j);
           f_par.ensemble:=ens;
           // Avancer
           c_index:=c_index.cell_suiv;
       end;
  end else
  begin
  // Pas de valeur trouvée.Reculer dans le chainage
        if sudoku_termine=false then
        begin
          if c_index.cell_prec=nil then
          begin
            sudoku_impossible:=true;
            canvas.Font.Color:=claqua;
            canvas.Font.name:='papyrus';
            canvas.Font.Height:=50;
            canvas.TextOut(150,20,'sudoku impossible...         ');
          end else
          begin
            c_index:=c_index.cell_prec;
            c_index.valeur:=10;
          end;
        end;
    end;
  end;
 end else
 begin
   // Initialisation d'un nouveau sudoku
   automatique:=true;
   chainage.Caption:='  calcul automatique  ';
   ligne_index:=tableau(ordre*ordre);
    for i:=1 to 9 do
    begin
       for j:=1 to 9 do
       begin
         posx:=posi(i,j).x;
         posy:=posi(i,j).y;
         canvas.Font.Height:=35;
         canvas.TextOut(posx,posy,'  ');

       end;
    end;
          canvas.Font.Color:=clblue;
          canvas.Font.name:='papyrus';
          canvas.Font.Height:=50;
          canvas.TextOut(150,20,'cliquer sur une case... ');
 end;
end;

end.

Conclusion :


Désolé pour le manque de commentaires sur le source...
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (tim62)