Sudoku d'ordre 2x2 en chiffres romains.

Télécharger le projet
Commenter

Description

Ce programme vous permet de résoudre n'importe quel sudoku d'ordre 2x2 que vous remplissez intégralement ou non.

3 cas peuvent se produire lors du remplissage (il suffit de cliquer sur une case) :

- Les cases remplies sont peu nombreuses : une multitude de sudoku sont alors possibles. Mon programme calcule une solution en remplissant la grille de gauche à droite et de haut en bas par des valeurs croissantes.

- Lors de votre remplissage vous avez généré un sudoku impossible à compléter. Il est déclaré impossible.

- Lorsqu'une solution unique est attendue (tous les sudokus proposés dans les rubriques de jeux sont dans ce cas), celle-ci est trouvée par élimination des valeurs impossibles.

Veuillez quitter le programme puis le relancer pour démarrer un nouveau sudoku.

Bon amusement !

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;
    Memo1: TMemo;
    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 val_possiblesClick(Sender: TObject);
    procedure chainageClick(Sender: TObject);
//    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
//      Rect: TRect; State: TGridDrawState);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
//  function couleur(i : integer) : tcolor;
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 parite(ordre) then
  begin
  // ordre pair
  k:= (n_bloc-1) mod ordre;
  p:= (n_bloc-1) div ordre;
    if parite(p) then
    begin
        if parite(k) then result:=clred else result:=clblack;
    end else
    begin
         if parite(k) then result:=clblack else result:=clred;
    end;
  end else
  begin
  // ordre impair

  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:='  ';
canvas.TextOut(posx,posy,valeur);
// Calcul de effacement.

effacement:=efface(ligne_index);
if  effacement then
begin
canvas.TextOut(200,400,'Sudoku impossible');
end else
begin
canvas.textout(200,400,'                                     ');
end;

end;

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

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
canvas.TextOut(posx,posy,'     ');

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,u,v,valeur :integer;
ens,temp,f_ens : pensemble;
val_trouvee,sudoku_termine,sudoku_impossible : boolean;
posx,posy : integer;
aff : string;

begin
// Chainage des cases vides.
chainage_index:=nil;
 for i:=1 to ordre*ordre do
    for j:=1 to ordre*ordre do
    begin
//    memo1.Lines.Add('****___________*****');
        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);
//               f_par.cell_prec:=cellprec;
               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;

chainage.Visible:=false;

///!!!!!!!!!!!!!!!!!!!
//////////////++++++++++++++++++++///////////////////////////
//------Calcul Automatique -------------
// memo1.Clear;
 memo1.Lines.Add('---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;
         //memo1.Lines.Add('Valeur trouvée');
         canvas.Font.Color:=clblue;
         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;
         //memo1.Lines.Add('Valeur trouvée');
         canvas.Font.Color:=clblue;
         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
  //memo1.Lines.Add('Avancer dans le chainage');
       if c_index.cell_suiv=nil then
       begin
       sudoku_termine:=true;
       memo1.Lines.Add('*******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
        //  memo1.Lines.Add('Reculer dans le chainage');
          if c_index.cell_prec=nil then
          begin
          sudoku_impossible:=true;
          memo1.Lines.Add('*******Sudoku impossible*****');
          end else
          begin
          c_index:=c_index.cell_prec;
          c_index.valeur:=10;
          end;
        end;
  end;
end;

///////////+++++++++++/////////////////////////////////////////////

////!!!!!!!!!!!!!!!!!
end;

end.

Conclusion :


Le sudoku 3x3 arrive bientôt.
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)