Sudoku pascal
Contenu du snippet
on est arrivé à la nouvelle version de SUDOKU pascal,
aprés une longue periode d'étude bien sur , j'ai l'honneur de vous porté l'un de mes travaux, on tout les cas, c'est mon projet de fin d'année issi en Alger,,,,
bon, pour le moment il y a un seul problème ,concernant le graphe ne paniquer pas , sa plante pas essayer le et donner votre avis ,,,,,,,,,
et voila le programme tout complet, je croie que c bon
aprés une longue periode d'étude bien sur , j'ai l'honneur de vous porté l'un de mes travaux, on tout les cas, c'est mon projet de fin d'année issi en Alger,,,,
bon, pour le moment il y a un seul problème ,concernant le graphe ne paniquer pas , sa plante pas essayer le et donner votre avis ,,,,,,,,,
Source / Exemple :
{ ce n'est pas facile de le faire , mais oui, il faut la dire,,;,,,
editeur: Louifi abdelmoumene ( c'est moi )
benzouaoui mohamed ( c lui (binome))
louis_fi@hotmail.com // si vous voullez me contacter ?,,,
passez un agréable moment sur mon pro ( nos pro pardon )*
}
program sud_solver;
uses crt,graph;
type tab=array[1..9,1..9]of integer;
type grille=record
tableau:tab;
nom_fichier:string[15];
mot_de_passe:longint;
end;
const chemin : string = 'C:\tmp\';
var ligne, colonne, i, j, cpt : integer;
colonne0, ligne0 : integer;
code,mode:integer;
s, sav ,res : array [1..9,1..9] of integer;
init : array [1..9,1..9] of boolean;
fin, impossible : boolean;
compteur, vide ,cpt1: integer;
u:string;
c,quit:char;
suite,appel:boolean;
{############################################################################################################################}
{----------------------------------------------------------------}
{----- LA PAGE1 DE REPRESENTATION -----}
{----------------------------------------------------------------}
procedure _page;
BEGIN
{ .... cette boucle permet d'afficher les ?toiles .... }
repeat
putpixel(random(1000),random(600),random(200));
i:=i+1;
if i>600 then
begin
i:=0;
j:=j+1;
end;
delay(1);
until j=20;
{ .... dessiner le cadre .... }
setcolor(9);
rectangle(15,15,623,463);
rectangle(16,16,622,462);
rectangle(16,75,41,103);
rectangle(16,76,40,102);
rectangle(598,75,622,103);
rectangle(599,76,622,102);
rectangle(15,432,123,463);
rectangle(16,433,122,462);
rectangle(501,432,623,463);
rectangle(502,433,622,462);
rectangle(126,432,498,433);
rectangle(126,435,498,435);
rectangle(126,460,498,460);
{ .... effacer les ?toiles qui g?nent .... }
setcolor(0);
for i:=0 to 301 do rectangle(319-i,17,319+i,48);
for i:=0 to 277 do rectangle(319-i,77,319+i,101);
for i:=1 to 185 do rectangle(312-i,436,311+i,459);
{ .... afficher les trois grands titres de cette page .... }
{ .... le premier .... }
setcolor(12);
settextstyle(7,0,1);
moveto(20,20);
u:='LA REPUBLIQUE ALGERIENNE DEMOCRATIQUE ET POPULAIRE';
for i:=1 to length(u) do
begin
outtext(u[i]);
delay(40);
end;
{ .... cette boucle pour encadrer ce titre ...
... c'est la m?me chose pour les deux autres titre .... }
setcolor(9);
for i:=1 to 300 do
begin
rectangle(17,49,20+i,49);
rectangle(17,48,20+i,48);
rectangle(621-i,49,621,49);
rectangle(621-i,48,621,48);
delay(3);
end;
{ .... le deuxi?me .... }
setcolor(12);
settextstyle(8,0,1);
moveto(50,74);
u:='INSTITUT NATIONAL DE FORMATION EN INFORMATIQUE';
for i:=1 to length(u) do
begin
outtext(u[i]);
delay(40);
end;
setcolor(9);
for i:=1 to 278 do
begin
rectangle(319-i,75,319+i,76);
rectangle(319-i,103,319+i,102);
delay(3);
end;
{ .... et le troisi?me .... }
setcolor(10);
settextstyle(7,0,4);
moveto(75,160);
u:='PROJET DU FIN DE L`ANNEE';
for i:=1 to length(u) do
begin
outtext(u[i]);
delay(60);
end;
for i:=1 to 4 do
begin
setcolor(10);
outtextxy(75+i,160+i,'PROGET DU FIN DE L`ANNEE');
setcolor(green);
outtextxy(75,160,'PROGET DU FIN DE L`ANNEE');
delay(35);
end;
{ .... ce que je vais faire c'est pour preparer
le chemin pour les noms de binome , rien d'autre .... }
setcolor(0);
for i:=0 to 38 do
begin
rectangle(134,391-i,503,391+i);
delay(20);
end;
{ .... dans la suite , vous trouvez l'appelle de toutes
les informations nec?ssaires sur le binome ...
... elles sont dans l'ordre suivant : .... }
{d'abord , les noms des amis formant le binome}
for i:=1 to 85 do
begin
setcolor(9);
settextstyle(7,0,1);
outtextxy(240,379-i,'BENZOUAOUI_MOHAMED');
outtextxy(240,401-i,'LOUIFI_ABDELMOUMEN');
setcolor(0);
outtextxy(240,380-i,'BENZOUAOUI_MOHAMED');
outtextxy(240,402-i,'LOUIFI_ABDELMOUMEN');
settextstyle(7,0,1);
setcolor(12);
outtextxy(i+53,260,'REALISER PAR :');
setcolor(0);
outtextxy(i+52,260,'REALISER PAR :');
delay(1);
end;
{ .... encadrer les noms .... }
setcolor(10);
rectangle(129,351,506,250);
rectangle(128,352,507,249);
{ .... cette boucle est faite pour netoyer
les ?toiles qui existent dans le cadre .... }
for j:=1 to 50 do
begin
setcolor(0);
rectangle(130,350,505,250+j);
rectangle(130,350-j,505,350);
settextstyle(7,0,1);
setcolor(1);
outtextxy(241,380-i,'BENZOUAOUI_MOHAMED');
outtextxy(242,402-i,'LOUIFI_ABDELMOUMEN');
outtextxy(242,381-i,'BENZOUAOUI_MOHAMED');
outtextxy(242,403-i,'LOUIFI_ABDELMOUMEN');
setcolor(9);
outtextxy(240,379-i,'BENZOUAOUI_MOHAMED');
outtextxy(240,401-i,'LOUIFI_ABDELMOUMEN');
settextstyle(7,0,1);
setcolor(red);
outtextxy(i+53,260,'REALISER PAR :');
outtextxy(i+54,261,'REALISER PAR :');
setcolor(12);
outtextxy(i+52,259,'REALISER PAR :');
delay(1);
end;
{ .... et l? , le goupe et la section ...
... on se prepare pour les appeler .... }
setcolor(10);
for i:=0 to 350 do
begin
rectangle(145,410,145+i,410);
rectangle(145,413,145+i,413);
rectangle(145,375,145+i,375);
rectangle(145,378,145+i,378);
delay(5);
end;
{ .... l'appelle est effectu?e en partie comme suite .... }
for i:=0 to 350 do
begin
setcolor(red);
delay(15);
rectangle(145,410,145+i,413);
rectangle(145,375,145+i,378);
case i of
80: begin
setcolor(1);
outtextxy(147,381,'SECTION :');
outtextxy(148,382,'SECTION :');
setcolor(9);
outtextxy(146,380,'SECTION :');
end;
130: begin
setcolor(red);
outtextxy(261,381,'B');
outtextxy(262,382,'B');
setcolor(12);
outtextxy(260,380,'B');
end;
180: begin
setcolor(10);
outtextxy(310,380,'/');
end;
285: begin
setcolor(1);
outtextxy(371,381,'GROUPE :');
outtextxy(372,382,'GROUPE :');
setcolor(9);
outtextxy(370,380,'GROUPE :');
end;
330: begin
setcolor(red);
outtextxy(474,381,'07');
outtextxy(475,382,'07');
setcolor(12);
outtextxy(473,380,'07');
end;
end;
end;
{ .... ce qui reste est ajout? pour finir la page .... }
repeat setcolor(red);
outtextxy(160,434,'VEUILLEZ APPUYER SUR ENTER');
delay(0);
setcolor(10);
outtextxy(160,434,'VEUILLEZ APPUYER SUR ENTER');
delay(0);
until keypressed;
END;
{################################################################################}
procedure afficher(u:string);
var i,j:longint;
begin
setcolor(10);
settextstyle(1,0,3);
moveto(210,50);
for i:=1 to length(u) do
begin
outtext(u[i]);
delay(30);
end;
setcolor(3);
rectangle(168,110,475,417);
setcolor(lightgreen);
i:=34; j:=34;
repeat rectangle(136+i,78+j,167+i,109+j);
delay(30);
i:=i+34;
if i=340 then
begin
j:=j+34;
i:=34;
end;
until j=340;
i:=0; j:=0;
setcolor(3);
repeat rectangle(169+i,111+j,270+i,212+j);
i:=i+102;
if i=306 then
begin
j:=j+102;
i:=0;
end;
until j=306;
for i:=1 to 9 do
for j:=1 to 9 do
if s[i,j]<>0 then
begin
str(s[i,j],u);
setcolor(1);
settextstyle(7,0,1);
outtextxy(147+i*34,82+j*34,u);
delay(20);
end;
end;
{############################################################################################################################}
procedure jouer;
var i,j,x:longint;
t:string;
d:integer;
begin
t:='';
i:=34; j:=34;
setcolor(11);
rectangle(136+i,78+j,167+i,109+j);
repeat if not init[i div 34,j div 34] then
repeat setcolor(9);
rectangle(147+i,103+j,156+i,104+j);
delay(10);
setcolor(white);
rectangle(147+i,103+j,156+i,104+j);
delay(10);
until keypressed;
c:=readkey;
case c of
#77: begin
setcolor(9);
rectangle(147+i,103+j,156+i,104+j);
setcolor(lightgreen);
rectangle(136+i,78+j,167+i,109+j);
i:=i+34;
if i=340 then i:=34;
end;
#75: begin
setcolor(9);
rectangle(147+i,103+j,156+i,104+j);
setcolor(lightgreen);
rectangle(136+i,78+j,167+i,109+j);
i:=i-34;
if i=0 then i:=306;
end;
#80: begin
setcolor(9);
rectangle(147+i,103+j,156+i,104+j);
setcolor(lightgreen);
rectangle(136+i,78+j,167+i,109+j);
j:=j+34;
if j=340 then j:=34;
end;
#72: begin
setcolor(9);
rectangle(147+i,103+j,156+i,104+j);
setcolor(lightgreen);
rectangle(136+i,78+j,167+i,109+j);
j:=j-34;
if j=0 then j:=306;
end;
#8: begin
if not init[i div 34,j div 34] then
begin
setfillstyle(0,1);
bar(140+i,80+j,164+i,101+j);
s[i div 34,j div 34]:=0;
end
else
begin
setcolor(red);
outtextxy(100,20,'ERREUR');
end;
end;
'1'..'9': begin
if not init[i div 34,j div 34] then
begin
t:=c;
setfillstyle(0,1);
bar(140+i,80+j,164+i,101+j);
val(t, s[i div 34,j div 34] ,d);
setcolor(12);
settextstyle(7,0,1);
outtextxy(147+i,82+j,t);
end
else
begin
setcolor(red);
outtextxy(250,400,'ERREUR');
end;
end;
end;
{77:d,75:g,72:h,80:b,13:entr,27:esc,8:ret}
setcolor(11);
rectangle(136+i,78+j,167+i,109+j);
until (c=#13);
setcolor(9);
rectangle(147+i,103+j,156+i,104+j);
end;
{############################################################################################################################}
{############################################################################################################################}
function verif_ligne(li : integer) : boolean;
var t : array [0..9] of integer; j : integer;
begin
for j := 1 to 9 do t[j] := 0;
for j := 1 to 9 do t[s[li,j]] := t[s[li,j]] + 1;
verif_ligne := true;
for j := 1 to 9 do
if t[j] > 1 then verif_ligne := false;
end;
{############################################################################################################################}
function verif_colonne(co : integer) : boolean;
var t : array [0..9] of integer; j : integer;
begin
for j := 1 to 9 do t[j] := 0;
for j := 1 to 9 do t[s[j,co]] := t[s[j,co]] + 1;
verif_colonne := true;
for j := 1 to 9 do
if t[j] > 1 then verif_colonne := false;
end;
{############################################################################################################################}
function verif_carre (li, co : integer) : boolean;
var t : array [0..9] of integer; ch, cv, j : integer;
begin
cv := (li-1) div 3;
ch := (co-1) div 3;
for j := 1 to 9 do t[j] := 0;
for co := 1 to 3 do
for li := 1 to 3 do
t[s[li+cv*3,co+ch*3]] := t[s[li+cv*3,co+ch*3]] + 1;
verif_carre := true;
for j := 1 to 9 do
if t[j] > 1 then verif_carre := false;
end;
{################################################################################################################}
function avancer : boolean;
var t: boolean;
begin
if colonne = 9 then begin
ligne := ligne + 1;
colonne := 1;
end else
colonne := colonne + 1;
if ligne = 10 then t := false
else t := true;
avancer := t;
if init[ligne,colonne] and t then avancer := avancer;
end;
{#################################################################################################################}
function reculer : boolean;
var t : boolean;
begin
if colonne = 1 then begin
ligne := ligne - 1;
colonne := 9;
end else
colonne := colonne - 1;
if ligne = 0 then begin
t := false;
end else t := true;
reculer := t;
if init[ligne,colonne] and t then reculer := reculer;
end;
{###############################################################################################################}
function sudoku : boolean;
begin
fin := false; impossible := false;
while not fin and not impossible do begin
if s[ligne,colonne] < 9 then begin
repeat
s[ligne,colonne] := s[ligne,colonne] + 1;
until (verif_ligne(ligne) and verif_colonne(colonne)
and verif_carre(ligne,colonne))
or (s[ligne,colonne] = 10);
if s[ligne,colonne] < 10 then fin := not avancer;
end else begin
s[ligne,colonne] := 0;
impossible := not reculer;
end;
end;
if fin then sudoku := true;
if impossible then sudoku := false;
end;
{################################################################################################################}
function verif : boolean;
var t : boolean;
begin
t := true;
for ligne := 1 to 9 do
for colonne := 1 to 9 do begin
t := t and verif_ligne(ligne);
t := t and verif_colonne(colonne);
t := t and verif_carre(ligne,colonne);
end;
verif := t;
end;
{################################################################################################################}
procedure generer;
var vide:integer;
begin
randomize;
vide:=18;
repeat
repeat
for ligne := 1 to 9 do
for colonne :=1 to 9 do begin
s[ligne,colonne] := 0;
init[ligne,colonne] := false;
end;
for i := 1 to 10 do begin
ligne := random(9) + 1;
colonne := random(9) + 1;
s[ligne,colonne] := random(9) + 1;
init[ligne,colonne] := true;
end;
until verif;
ligne := 0; colonne := 9;
avancer;
until sudoku;
for i:=1 to 9do
for j:=1 to 9 do
begin
sav[i,j]:=s[i,j];
init[i,j]:=true;
end;
for i:=1 to 9 do
for j:=1 to 9 do
begin
str(s[i,j],u);
outtextxy(20+i*15,20+j*15,u);
end;
cpt:=0;
while cpt<vide do
begin
i:=random(9)+1;
j:=random(9)+1;
if s[i,j]<> 0 then
begin
s[i,j]:=0;
init[i,j]:=false;
cpt:=cpt+1;
s[10-i,10-j]:=0;
init[10-i,10-j]:=false;
end;
end;
for i:=1 to 9 do
for j:=1 to 9 do
if s[i,j]=0 then res[i,j]:=sav[i,j]
else
res[i,j]:=0;
end;
{################################################################################################################}
Procedure page_demarrage;
var i,y:integer;
s,q,l:string;
begin
textcolor(11);
setfillstyle(1,2);
outtextxy(220,30,' Patientez svp ');
setcolor(10);
rectangle(210,40,365,43);
setcolor(white);
i:=1;
repeat
i:=i+1;
bar(210,40,251+i*2,43);
delay(80);
until (i>56);
delay(100);
end;
{################################################################################################################}
procedure help;
var k:integer;
begin
k:=0;
for i:=1 to 9 do
for j:=1 to 9 do
if s[i,j]=0 then k:=k+1;
if k>3 then k:=1;
for cpt:=1 to k do
begin
i:=random(9)+1;
j:=random(9)+1;
if s[i,j]=0 then
begin
str(res[i,j],u);
s[i,j]:=res[i,j];
init[i,j]:=true;
setcolor(10);
settextstyle(7,0,1);
outtextxy(147+i*34,82+j*34,u);
end
else cpt:=cpt-1;
end;
for i:=1 to 9 do
for j:=1 to 9 do
begin
if (s[i,j]<>0) and (res[i,j]<>0) then
begin
if s[i,j]=res[i,j] then
begin
setcolor(10);
init[i,j]:=true;
end
else
setcolor(red);
str(s[i,j],u);
settextstyle(7,0,1);
outtextxy(147+i*34,82+j*34,u);
end;
end;
end;
{################################################################################################################}
procedure solution;
var i,j:integer;
begin
for i:=1 to 9 do begin
for j:=1 to 9 do
begin
setfillstyle(0,1);
bar(140+i*34,80+j*34,164+i*34,101+j*34);
str(sav[i,j],u);
setcolor(lightgreen);
delay(20);
settextstyle(7,0,1);
outtextxy(147+i*34,82+j*34,u);
end;
end;
end;
{#################################################################################################################}
procedure save_partie(t:tab);
label donnes;
var
fichier:file of grille;
sav1,sav2:grille;
n,a:char;
chaine,ch,cle:string;
i,r,q,j:longint;c:integer;
bool:boolean;
begin
clearDevice;
{ tout ce qui vien concerne l'interface de cette procedure }
setcolor(blue);
rectangle(10,10,600,470);
rectangle(12,12,600-2,470-2);
setcolor(blue);
rectangle(85,120,500,170);
rectangle(84,119,501,171);
setcolor(9);
OutTextXY(90,130,'Nom de fichier:');
OutTextxy(90,150,'Cl? :');
setcolor(red);
rectangle(210,125,450,140);
rectangle(210,145,450,160);
{ note importante }
setcolor(red);
Outtextxy(90,180,'NOTE:');
setcolor(white);
Outtextxy(90,190,'Enregistre votre cl? c''est tr?s important');
Outtextxy(90,200,'pour facilit? l''accer ? votre fichier la prochaine fois');
i:=0; q:=3;
{ lecture des donn?s } donnes:
repeat setcolor(white);
line(215+i,138,215+i+8,138);
n:=readkey;
case n of
'a'..'z': begin
chaine:=n;
setcolor(q);
outtextxy(215+i,130,chaine);
setcolor(0);line(215+i,138,215+8+i,138);
i:=i+8;
ch:=ch+n;
end;
'A'..'Z': begin
chaine:=n;
setcolor(q);
outtextxy(215+i,130,chaine);
setcolor(0);line(215+i,138,215+8+i,138);
i:=i+8;
ch:=ch+n;
end;
#13: begin
break;
end;
end;
settextstyle(0,0,0);
until((n=#27)or(i=80));
{ val(ch,r,c);}sav1.nom_fichier:=ch;
setcolor(0);
line(215+i,138,215+8+i,138);setcolor(9);
i:=0;
repeat
setcolor(white);
line(215+i,158,215+8+i,158);
n:=readkey;
case n of
'0'..'9':begin
chaine:=n;
setcolor(q);
OuttextXY(215+i,150,chaine);
setcolor(0);line(215+i,158,215+8+i,158);
i:=i+8; { on decale un peut pour ecrire la prochaine lettre}
cle:=cle+n;
end;
#13:begin
break;
end;
end;
setcolor(0);
line(215+i,158,215+8+i,158);setcolor(9);
until((n=#27)or(i=60));
val(cle,r,c);
sav1.mot_de_passe:=r;
sav1.tableau:=t;
{ enregistrement des donnees dans le fichier }
Assign(fichier,'c:\test.txt');
{$i-}
reset(fichier);
{$i+}
seek(fichier,0);
bool:=false;
while (not eof(fichier) and (not bool )) do
begin
read(fichier,sav2);
if sav2.nom_fichier=sav1.nom_fichier then bool:=true;
if bool then
begin
sound(1500);delay(500);nosound;
setcolor(red);
Outtextxy(230,270,' CE NOM EXISTE DEJA ');
delay(1000);
goto donnes;
end
else
begin
seek(fichier,filesize(fichier)-1);
write(fichier,sav1);
end;
close(fichier);
end;
page_Demarrage;
{ la fin de l'interface}
{ on attaque maintenant les choses importantes ..... essah ga3 mazal}
end;
{#################################################################################################################}
{---------------------------------------------------------------------------------------------------------------------------}
{ ---------------------------- INTERFACE GRAPHIQUE ---------------------------------------------------------------}
{------------------------------------------------------------------------------------------------------------------------}
procedure entour;
var s,j:integer;
begin
s:=0;
j:=0;
setfillstyle(1,1);
repeat
bar(0,0,Getmaxx,s);
s:=s+1;
delay(20);
bar(0,getmaxy,getmaxx,getmaxy-j);
j:=j+1;
delay(20);
until(s>60);
end;
{###############################################################################}
procedure entour_inv;
var s,j:integer;
begin
s:=60;
j:=60;
setfillstyle(1,1);
repeat
bar(0,0,Getmaxx,s);
s:=s+1;
delay(10);
bar(0,getmaxy,getmaxx,getmaxy-j);
j:=j+1;
delay(10);
until(s>250);
end;
{#############################################################################}
procedure windows;
var i,k,j,h,cpt:integer;
begin
clearDevice;
setbkcolor(0);
setcolor(white);
setTextstyle(7,0,5);
Outtextxy(200,200,' SudoKu');
settextstyle(11,0,5);
Outtextxy(0,450,'Copyright @ tout droit r?serv? @ ');
outTextxy(500,450,' service Pack 2');
circle(400,210,3);
circle(400,210,5);
setcolor(0);
arc(400,210,310,70,3);
i:=0;j:=0;k:=100;
setcolor(1); { carr? bleu }
for j:=1 to 19 do begin rectangle(260-k div 2,250-k,260-k div 2+j,250-k+j);
end;
setcolor(2); { carr? vert }
for j:=1 to 19 do begin rectangle(285-k div 2,250-k,285-k div 2+j,250-k+j);
end;
setcolor(4); { carr? rouge }
for j:=1 to 19 do begin rectangle(260-k div 2,275-k,260-k div 2+j,275-k+j);
end;
setcolor(14); { carr? jaune }
for j:=1 to 19 do begin rectangle(285-k div 2,275-k,285-k div 2+j,275-k+j);
end;
setcolor(9);
h:=0;
cpt:=0;
k:= 250;
rectangle(5+k,10+k,120+k,20+k);
repeat
for i:=1 to 95 do begin
setcolor(0);
for j:=1 to 6 do begin for h:=1 to 8 do begin
rectangle(11+k+i-5,11+k,11+k+j+i-5,11+k+h);
end;end;
setcolor(red);
for j:=1 to 6 do begin for h:=1 to 8 do begin
rectangle(11+k+i,11+k,11+k+i+5+j,11+k+h);
end;end;
end;
setcolor(0);
for j:=1 to 6 do begin for h:=1 to 8 do begin
rectangle(11+k+i,11+k,11+k+j+i+5,11+k+h);
end;end;
for i:=90 downto 1 do begin
setcolor(red);
for j:=1 to 6 do begin for h:=1 to 8 do begin
rectangle(10+k+i,11+k,10+k+i+j,11+k+h);
end;end;
setcolor(0);
for j:=1 to 6 do begin for h:=1 to 8 do begin
rectangle(10+k+i+5,11+k,10+k+j+i+5,11+k+h);
end; end;
end;
delay(30);
cpt:=cpt+1;
until(cpt>5);
Cleardevice;
end;
{###############################################################################}
procedure Menu(var suite:boolean);
var i,j,k,p,l,code,mode:integer;
key,a:char;
u:string;
begin
entour;
u:='';
setcolor(1);
settextstyle(7,0,4);
circle(143,105,5);
circle(143,105,3);
setcolor(9);
arc(143,105,310,70,3);
setcolor(1);
Outtextxy(20,100,'Sudoku 8.8 ');
Outtextxy(20,101,'Sudoku 8.8 ');
Outtextxy(20,99,'Sudoku 8.8 ');
settextstyle(2,0,4);
setcolor(11);
outtextxy(40,140,'Ce Projet est Pr?sent? par : ');
settextstyle(7,0,1);outtextxy(60,150,'Louifi & Benzouaoui');
settextstyle(2,0,4);Outtextxy(10,Getmaxy-75,'Sudoku professional');
outtextxy(getmaxx-110,getmaxy-75,'Service Pack 2');
settextstyle(0,0,0);
{ l'encadrement des choix.....}
setfillstyle(1,1); l:=160;
bar(200,200,400,220);
bar(200,240,400,260);
bar(200,120+l,400,140+l);
bar(200,160+l,400,180+l);
bar(200,200+l,400,220+l);
{ on affiche les elements de ce Menu}
setcolor(white);
OuttextXY(238,205,' Facile ');
OutTextXY(237,245,' Moyenne ');
OutTextxy(235,285,' Difficile ');
Outtextxy(245,325,' Pro ');
Outtextxy(245,365,' Exit ');
j:=200;
setfillstyle(1,lightgreen);
bar(200,200,400,202);
bar(200,200,202,220);
bar(400,200,402,220);
bar(200,220,402,222);
setcolor(9);
repeat
key:= readkey;
case key of
#80: begin { si la fleche haut est presse alors..}
p:=j;
sound(450);delay(50);nosound;
{setcolor(0);rectangle(198,j-2,402,j+22); }
setfillstyle(1,3);
bar(200,j,400,j+2);
bar(200,j,202,j+20);
bar(400,j,402,j+20);
bar(200,j+20,402,j+22);
j:=j+40;
if j>360 then j:=200;
if (j<>p) then begin setfillstyle(1,lightgreen);
bar(200,j,400,j+2);
bar(200,j,202,j+20);
bar(400,j,402,j+20);
bar(200,j+20,402,j+22);
end;
a:=readkey;
if((a=#13)and(j=200))then begin u:='FACILE';break;end;
if((a=#13)and(j=240)) then begin u:='MOYENNE';break;end;
if((a=#13)and(j=280)) then begin u:='DIFFICILE';break;end;
if((a=#13)and(j=320)) then begin u:='PRO';break;end;
if((a=#13)and(j=360)) then begin suite:=false;break;end;
end;
#72: begin { si la fleche bas est presse alors...}
k:=j;
sound(450);delay(50);nosound;
setfillstyle(1,3);
bar(200,j,400,j+2);
bar(200,j,202,j+20);
bar(400,j,402,j+20);
bar(200,j+20,402,j+22);
j:=j-40;
if j<200 then j:=360;
if (j<>k) then begin
setfillstyle(1,lightgreen);
bar(200,j,400,j+2);
bar(200,j,202,j+20);
bar(400,j,402,j+20);
bar(200,j+20,402,j+22);
end;
a:=readkey;
if((a=#13)and(j=200)) then begin u:='FACILE';break;end;
if((a=#13)and(j=240)) then begin u:='MOYENNE';break;end;
if((a=#13)and(j=280)) then begin u:='DIFFICILE';break;end;
IF((a=#13)and(j=320)) then begin u:='PRO';break;end;
if((a=#13)and(j=360)) then begin suite:=false;break; end;
end;
{ la fin de case of }
end;
until(key= #27);
end;
{######################################################################################################}
procedure en_joue(var appel:boolean);
var i,j,k,p:integer;
key,a:char;
begin
{ insertion du temps }
setfillstyle(1,2);
bar(50,100,110,120);
bar(50,140,110,160);
bar(50,180,110,200);
settextstyle(0,0,0);
setcolor(1);
Outtextxy(55,110,'Solu.');
Outtextxy(55,150,'Help.');
Outtextxy(55,190,'Exit.');
j:=100;
setfillstyle(1,blue);
bar(50,100,110,101);
bar(50,100,51,120);
bar(110,100,111,120);
bar(50,120,111,121);
repeat
key:=readkey;
case key of
#80: begin
p:=j;
setfillstyle(1,lightgreen);
bar(50,j,110,j+1);
bar(50,j,51,j+20);
bar(110,j,111,j+20);
bar(50,j+20,111,j+21);
j:=j+40;
if j>180 then j:=100;
if j<>p then begin
setfillstyle(1,1);
bar(50,j,110,j+1);
bar(50,j,51,j+20);
bar(110,j,111,j+20);
bar(50,j+20,111,j+21);end;
a:=readkey;
if ((a=#13)and(j=100)) then begin page_demarrage;solution;appel:=false;break;end;
if ((a=#13)and(j=140)) then begin help;break;end;
if ((a=#13)and(j=180)) then begin appel:=false;exit;break;end;
end;
#72: begin
k:=j; setfillstyle(1,lightgreen);
bar(50,j,110,j+1);
bar(50,j,51,j+20);
bar(110,j,111,j+20);
bar(50,j+20,111,j+21);
j:=j-40;
if j<100 then j:=180;
if j<>k then begin setfillstyle(1,1);
bar(50,j,110,j+1);
bar(50,j,51,j+20);
bar(110,j,111,j+20);
bar(50,j+20,111,j+21);end;
a:=readkey;
if ((a=#13)and(j=100)) then begin page_demarrage;solution;appel:=false;break;end;
if ((a=#13)and(j=140)) then begin help;break;end;
if ((a=#13)and(j=180)) then begin appel:=false;exit;break;end;
end;
end;
until(key=#27);
end;
{######################################################################################################}
begin
clrscr;
{ initialisation de mode graphique..}
code:=detect;
initgraph(code,mode,'C:\tp7\bgi');
{ on commance le jeux }
suite := true;
_page; cleardevice;
windows;
setbkcolor(9);
Menu(suite); if suite then begin
repeat cleardevice;
setcolor(11); { bordure .....}
rectangle(5,5,getmaxx-10,getmaxy-10);
rectangle(4,4,getmaxx-9,getmaxy-9);
appel:=true;
setcolor(8);
outtextxy(100,getmaxy-50,' Si tu es terminer de jouer appuyer sur entré pour');
outtextxy(100,getmaxy-40,' avoir la solution ou l''aide .');
setcolor(9);
generer;
afficher(u);
repeat
jouer;
en_joue(appel);
until(appel=false);
cleardevice;setcolor(red); settextstyle(4,0,4);
outtextxy(140,200,'Appuyer sur Q pour quiter');
settextstyle(0,0,0);
quit:=readkey;
until((quit='Q')or(quit='q'));
end;
entour_inv;
closegraph;
end.
Conclusion :
et voila le programme tout complet, je croie que c bon
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.