Delphi.Les8Reines)Delphi.Les8Reines)
: Les projets Delphi
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 
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