Delphi Les 8 reines

 (CD-ROMDelphi.Les8Reines)



: Les projets Delphi



Objectif : interrompre une récursivité par ProcessMessages et temporisation pendant l'interruption avec un Ttimer (exercice récapitulatif) Comment placer 8 reines sur un échiquier sans qu'elles soient en prise.
 

Le programme pascal d'affichage des 8 reines.

Interruption de la récursivité à l'aide de la méthode ProcessMessages en Delphi.

Un exemple de temporisation pendant l'interruption à l'aide de la classe Ttimer en Delphi.
 


Le programme Pascal classique :

EXECUTION DU PROGRAMME PASCAL : 
 program echec;

 {comment placer 8 reines sur un
échiquier sans qu'elles soient en prise,
le programme fournit 92 solutions.
}
const
     Faux=false;
     Vrai=true;
type
 echiquier=array[1..8,1..8] of boolean;
 diagonale_1=array[-7..7] of boolean;
 diagonale_2=array[2..16] of boolean;
 line=array[1..8] of boolean;
var
   press,flag_exit:boolean;
   k:integer;

 procedure ecrire(Queen:echiquier);
var
   i,j:integer;
begin
     k:=k+1;
     writeln;

      writeln('Solution N° : ',k:3);
     writeln('-------------');
     writeln;
     for i:=1 to 8 do
     begin
          for j:=1 to 8 do
             if Queen[i,j]=Vrai then write('* ')
             else write('. ');
          writeln
     end
end;{ecrire}

 procedure placer(var diag1:diagonale_1;var diag2:diagonale_2;
                    var ligne:line;var reine:echiquier;
                    var j:integer);
var
   i0,i:integer;
begin
  if flag_exit then exit;
  if j=9 then ecrire(reine)
  else
    for i0:=1 to 8 do
    begin
      i:=i0;
      if(ligne[i]=Faux)and(diag1[i-j]=Faux)and(diag2[i+j]=Faux) then
      begin
        ligne[i]:=Vrai;
        diag1[i-j]:=Vrai;
        diag2[i+j]:=Vrai;
        reine[i,j]:=Vrai;
        j:=j+1;
        placer(diag1,diag2,ligne,reine,j);
        j:=j-1;
        ligne[i]:=Faux;
        diag1[i-j]:=Faux;
        diag2[i+j]:=Faux;
        reine[i,j]:=Faux;
      end
    end
end;{placer}

 procedure Reines_8;
var
   i,j:integer;
   diag1:diagonale_1;
   diag2:diagonale_2;
   ligne:line;
   reine:echiquier;
begin
  for i:=1 to 8 do
  begin
    ligne[i]:=Faux;
    for j:=1 to 8 do
    begin
      diag1[i-j]:=Faux;
      diag2[i+j]:=Faux;
      reine[i,j]:=Faux;
    end
  end;
  j:=1;
  k:=0;
  placer(diag1,diag2,ligne,reine,j);
end;

begin
  Reines_8
end.                                                                        Remonter 
 



L'interruption de la récursivité en Delphi :

EXECUTION DU PROGRAMME Delphi : 
 

UNITE CONTENANT LES OBJETS DE BASE DE L'INTERFACE
unit Uechec;

 interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Grids, ExtCtrls, StdCtrls, Menus;

 type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image6: TImage;
    Image8: TImage;
    Image1: TImage;
    Image5: TImage;
    Image7: TImage;
    Image9: TImage;
    Image10: TImage;
    Image11: TImage;
    Image12: TImage;
    Image13: TImage;
    Image14: TImage;
    Image15: TImage;
    Image16: TImage;
    Image17: TImage;
    Image18: TImage;
    Image19: TImage;
    Image20: TImage;
    Image21: TImage;
    Image22: TImage;
    Image23: TImage;
    Image24: TImage;
    Image25: TImage;
    Image26: TImage;
    Image27: TImage;
    Image28: TImage;
    Image29: TImage;
    Image30: TImage;
    Image31: TImage;
    Image32: TImage;
    Image33: TImage;
    Image34: TImage;
    Image35: TImage;
    Image36: TImage;
    Image37: TImage;
    Image38: TImage;
    Image39: TImage;
    Image40: TImage;
    Image41: TImage;
    Image42: TImage;
    Image43: TImage;
    Image44: TImage;
    Image45: TImage;
    Image46: TImage;
    Image47: TImage;
    Image48: TImage;
    Image49: TImage;
    Image50: TImage;
    Image51: TImage;
    Image52: TImage;
    Image53: TImage;
    Image54: TImage;
    Image55: TImage;
    Image56: TImage;
    Image57: TImage;
    Image58: TImage;
    Image59: TImage;
    Image60: TImage;
    Image61: TImage;
    Image62: TImage;
    Image63: TImage;
    Image64: TImage;
    Buttonsuite: TButton;
    Buttonstop: TButton;
    Labelnum_sol: TLabel;
    Labelinfo: TLabel;
    Bevel1: TBevel;
    MainMenu1: TMainMenu;
    Informations1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure ButtonsuiteClick(Sender: TObject);
    procedure ButtonstopClick(Sender: TObject);
    procedure Informations1Click(Sender: TObject);
  private
    { Déclarations private }
  public
    { Déclarations public }
  end;
type
    tableau_image=array[1..64]of Timage;
    Tableau_coul=array[1..64]of (blanc,noir,la_reine);
var
  Form1: TForm1;
  T_image:tableau_image; {tableau des images réelles}
  press:boolean;
       {indicateur d'appui sur Buttonsuite}
  flag_exit:boolean;     {indicateur d'appui sur Buttonstop}
  T_coul,Tgen:Tableau_coul; {tableaux globaux des liens d'images }
  app_path:string;      {chemin de l'application}
  num_sol:integer;      {numéro de la solution affichée}

implementation
{$R *.DFM}

 procedure evalue_App_path;
{donne le chemin de l'application dans la variable globale "app_path"}
begin
 app_path:=Extractfilepath(Application.exename);
end;

 procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
 procedure intit_coul1(depart,arrivee:integer);
 {permet de d'initialiseer le lien "T_coul" de couleurs lignes impaires}
 var i:integer;
 begin
   i:=depart;
   repeat
    T_coul[i]:=noir;
    T_coul[i+1]:=blanc;
    i:=i+2
   until i>=arrivee;
 end;

 procedure intit_coul2(depart,arrivee:integer);
 {permet de d'initialiseer le lien "T_coul" de couleurs lignes paires}
 var i:integer;
 begin
   i:=depart;
   repeat
    T_coul[i]:=blanc;
    T_coul[i+1]:=noir;
   i:=i+2
   until i>=arrivee;
 end;
begin
 {initialisation de tous les objets image dans le tableau T_image}
 T_image[1]:=image1;T_image[2]:=image2;T_image[3]:=image3;T_image[4]:=image4;
 T_image[5]:=image5;T_image[6]:=image6;T_image[7]:=image7;T_image[8]:=image8;
 T_image[9]:=image9;T_image[10]:=image10;T_image[11]:=image11;T_image[12]:=image12;
 T_image[13]:=image13;T_image[14]:=image14;T_image[15]:=image15;T_image[16]:=image16;
 T_image[17]:=image17;T_image[18]:=image18;T_image[19]:=image19;T_image[20]:=image20;
 T_image[21]:=image21;T_image[22]:=image22;T_image[23]:=image23;T_image[24]:=image24;
 T_image[25]:=image25;T_image[26]:=image26;T_image[27]:=image27;T_image[28]:=image28;
 T_image[29]:=image29;T_image[30]:=image30;T_image[31]:=image31;T_image[32]:=image32;
 T_image[33]:=image33;T_image[34]:=image34;T_image[35]:=image35;T_image[36]:=image36;
 T_image[37]:=image37;T_image[38]:=image38;T_image[39]:=image39;T_image[40]:=image40;
 T_image[41]:=image41;T_image[42]:=image42;T_image[43]:=image43;T_image[44]:=image44;
 T_image[45]:=image45;T_image[46]:=image46;T_image[47]:=image47;T_image[48]:=image48;
 T_image[49]:=image49;T_image[50]:=image50;T_image[51]:=image51;T_image[52]:=image52;
 T_image[53]:=image53;T_image[54]:=image54;T_image[55]:=image55;T_image[56]:=image56;
 T_image[57]:=image57;T_image[58]:=image58;T_image[59]:=image59;T_image[60]:=image60;
 T_image[61]:=image61;T_image[62]:=image62;T_image[63]:=image63;T_image[64]:=image64;
 i:=1;
 repeat
  intit_coul1(i,i+7);     {les lignes impaires noir,blanc,...,blanc}
  intit_coul2(i+8,i+15);  {les lignes paires blanc,noir,...,noir}
  i:=i+16
 until i>=64;
 evalue_App_path;
 flag_exit:=false;        {flag stop baissé: RAZ}
 self.show
 end;

 procedure TForm1.ButtonsuiteClick(Sender: TObject);
{on souhaite relancer un calcul afin de voir la solution suivante}
begin
 if num_sol<=91 then
 begin
  press:=true;
         {flag suite levé}
  num_sol:=num_sol+1;
  Labelnum_sol.caption:=inttostr(num_sol) {affiche numéro suivant}
 end
end;

 procedure TForm1.ButtonstopClick(Sender: TObject);
begin
 flag_exit:=true;       {flag stop levé}
 Buttonsuite.enabled:=true;
end;

 procedure TForm1.Informations1Click(Sender: TObject);
const crlf=#10+#13;
var info:string;
begin
 info:='Donne toutes les solutions permettant'+crlf
      +'de placer 8 reines sur un échiquier'+crlf
      +'sans qu''elles ne soient en prise.'+crlf+crlf
      +'Appuyez sur Arrêt lorsque vous en avez assez !';
 MessageDlg(info, mtInformation,[mbOk], 0);
end;

 end.                                                                            Remonter 

UNITE CONTENANT LE PROGRAMME DE CALCUL
unit Unit2;

 interface
uses Uechec,Forms;
const
     Faux=false;
     Vrai=true;
type
 echiquier=array[1..8,1..8] of boolean;
 diagonale_1=array[-7..7] of boolean;
 diagonale_2=array[2..16] of boolean;
 line=array[1..8] of boolean;

 procedure ecrire(Queen:echiquier);
procedure placer(var diag1:diagonale_1;var diag2:diagonale_2;
                    var ligne:line;var reine:echiquier;
                    var j:integer);
procedure Reines_8;

 implementation

procedure rafraichir(var T:Tableau_coul);
 {Interface humaine: recharge l'état de T à partir de T_coul}
 var i,j:integer;
 begin
  for i:=1 to 8 do
   for j:=1 to 8 do
     T[8*(i-1)+j]:=T_coul[8*(i-1)+j]
 end;

 procedure ecrire(Queen:echiquier);
var
   i,j:integer;
begin
 press:=false;  {flag suite baissé: RAZ}
 rafraichir(Tgen); {nécessaire car T a été modifié pour un calcul}
 for i:=1 to 8 do
 begin
  for j:=1 to 8 do
   if Queen[i,j]=Vrai then
   begin
    Tgen[8*(i-1)+j]:=la_reine;
    T_image[8*(i-1)+j].picture.loadfromfile(App_path+'reine8.ico') {affiche l'icone reine8}
   end
 end;
 repeat
    Application.processmessages  {boucles de messages à windows essentielle !!}
 until (press=true)or(flag_exit);
 for i:=1 to 8 do
  for j:=1 to 8 do
   if Tgen[8*(i-1)+j]=la_reine then
   {remplacer la reine par l'image initiale}
   begin
    if T_coul[8*(i-1)+j]=noir then
      T_image[8*(i-1)+j].picture.loadfromfile(App_path+'casenoir.ico')
    else
      T_image[8*(i-1)+j].picture.loadfromfile(App_path+'caseb.ico')
   end
end;{ecrire}

 procedure placer(var diag1:diagonale_1;var diag2:diagonale_2;
                    var ligne:line;var reine:echiquier;
                    var j:integer);
var
   i0,i:integer;
begin
 if flag_exit then
  form1.close
 else
 begin
  if j=9 then ecrire(reine)
  else
    for i0:=1 to 8 do
    begin
      i:=i0;
      if(ligne[i]=Faux)and(diag1[i-j]=Faux)and(diag2[i+j]=Faux) then
      begin
        ligne[i]:=Vrai;
        diag1[i-j]:=Vrai;
        diag2[i+j]:=Vrai;
        reine[i,j]:=Vrai;
        j:=j+1;
        placer(diag1,diag2,ligne,reine,j);
        j:=j-1;
        ligne[i]:=Faux;
        diag1[i-j]:=Faux;
        diag2[i+j]:=Faux;
        reine[i,j]:=Faux;
      end
    end
  end
end;{placer}

 procedure Reines_8;
var
   i,j:integer;
   diag1:diagonale_1;
   diag2:diagonale_2;
   ligne:line;
   reine:echiquier;
begin
  num_sol:=1;
  for i:=1 to 8 do
  begin
    ligne[i]:=Faux;
    for j:=1 to 8 do
    begin
      diag1[i-j]:=Faux;
      diag2[i+j]:=Faux;
      reine[i,j]:=Faux;
    end
  end;
  j:=1;
  placer(diag1,diag2,ligne,reine,j);
end;
end.                                                                      Remonter 


Une temporisation pendant l'interruption en Delphi :

 Objectif : lorsque l'utilisateur clique sur une reine le logiciel affiche pendant environ 1 s toutes les lignes qui sont en prise pour cette reine (les cases correspondantes sont temporairement affichées en rouge):

Pour réaliser cette action nous procédons à :

Une insertion de nouveau code dans la unit "Echec" du programme précédent.

Une réutilisation sans changement de la unit2 contenant le programme de calcul du programme précédent.

EXECUTION DU PROGRAMME Delphi : 

                                                                                      Remonter 

{******************************************************
----  Nouveau code pour la partie visualisation des cases occupées  ----
        à insérer dans la Unit Echec
*******************************************************}
{---  Flash en rouge des cases interdites pour cette reine ----}

procedure ConvertCouple(entier:byte;var ligne,colonne:byte);
{convertit un numéro compris entre 1 et 64 en un couple ligne,colonne}
begin
  if entier mod 8 <>0 then
  begin
   ligne:=entier div 8 +1;
   colonne:=entier mod 8
  end
  else
  begin
    ligne:=entier div 8;
    colonne:=8
  end
end;

 procedure FlashLigne(ligne,colonne:byte);
{toute la ligne est en rouge sauf la reine}
var i:byte;
begin
 for i:=1 to 8 do
 if i<>colonne then
  T_image[8*(ligne-1)+i].picture.loadfromfile(App_path+'casered.ico')
end;

 procedure FlashColonne(ligne,colonne:byte);
{toute la colonne est en rouge sauf la reine}
var i:byte;
begin
 for i:=1 to 8 do
 if i<>ligne then
  T_image[8*(i-1)+colonne].picture.loadfromfile(App_path+'casered.ico')
end;

 procedure FlashDiag1(ligne,colonne:byte);
{toute la diagonale descendante est en rouge sauf la reine}
var L,K:byte;
begin
 L:=ligne;
 K:=colonne;
 {partie inférieure de la diagonale}
 repeat
  if (L<>8)and(K<>8)then
  begin
   L:=L+1;
   K:=K+1;
   T_image[8*(L-1)+K].picture.loadfromfile(App_path+'casered.ico')
  end
 until (L=8)or(K=8);
 L:=ligne;
 K:=colonne;
 {partie supérieure de la diagonale}
 repeat
  if (L<>1)and(K<>1)then
  begin
   L:=L-1;
   K:=K-1;
   T_image[8*(L-1)+K].picture.loadfromfile(App_path+'casered.ico');
  end;
 until (L=1)or(K=1);
end;

 procedure FlashDiag2(ligne,colonne:byte);
{toute la diagonale montante est en rouge sauf la reine}
var L,K:byte;
begin
 L:=ligne;
 K:=colonne;
 {partie inférieure de la diagonale}
 repeat
  if (L<>1)and(K<>8)then
  begin
   L:=L-1;
   K:=K+1;
   T_image[8*(L-1)+K].picture.loadfromfile(App_path+'casered.ico')
  end
 until (L=1)or(K=8);
 L:=ligne;
 K:=colonne;
 {partie supérieure de la diagonale}
 repeat
  if (L<>8)and(K<>1)then
  begin
   L:=L+1;
   K:=K-1;
   T_image[8*(L-1)+K].picture.loadfromfile(App_path+'casered.ico');
  end;
 until (L=8)or(K=1);
end;

 procedure TForm1.ImageClick(Sender: TObject);
{l'utilisateur clicke dans une case quelconque de l'échiquier}
var ligne,colonne,i:byte;

  procedure redessine(T:Tableau_coul);
 {redessine tout l'échiquier à l'état précédent}
 var i:byte;
 begin
  for i:=1 to 64 do
  if Tgen[i]=noir then
   T_image[i].picture.loadfromfile(App_path+'casenoir.ico')
  else if Tgen[i]=blanc then
   T_image[i].picture.loadfromfile(App_path+'caseb.ico')
  else if Tgen[i]=la_reine then
   T_image[i].picture.loadfromfile(App_path+'reine8.ico')
 end;

 begin {ImageClick}
  with sender as Timage do
  begin
   ConvertCouple(tag,ligne,colonne);
   if Tgen[8*(ligne-1)+colonne]=la_reine then
   begin
    FlashLigne(ligne,colonne);
    FlashColonne(ligne,colonne);
    FlashDiag1(ligne,colonne);
    FlashDiag2(ligne,colonne);
    timer1.enabled:=true;
    timing:=0;
    repeat
     Application.processmessages  {boucles de messages à windows}
    until (timer1.enabled=false);
    redessine(Tgen);
   end
  end;
end;{ImageClick}

procedure TForm1.Timer1Timer(Sender: TObject);
{attente et persistence des lignes occupées 1s environ}
begin
 inc(timing);
 if timing=4 then
  timer1.enabled:=false
end;

 procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
{le curseur change de forme lorsqu'il passe sur une case occupée par une
  reine. }
begin
 with sender as Timage do
  if Tgen[tag]=la_reine then
    cursor:=crHelp
  else
    cursor:=crDefault
end;                                                                                 Remonter