Accueil > > > SUDOKU PASCAL
SUDOKU PASCAL
Information sur la source
Description
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 ,,,,,,,,,
Source
- { 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.
-
-
{ 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
Historique
- 12 juin 2007 21:38:18 :
- alors,
comme j'ai dis tout a l'heur, j'ai modifier un peu la structure et l'affichage pour mieux comprandre, j'ai basé surtout sur le plant graphique, il reste quelque modifications mais, ont pas de senses sur l'ensemble de programme
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
j'ai un tp a faire ...et j'aimerais bien qu'on le fasse à ma place [ par meri_info ]
bonour, j'ai un tp a faire et a le repsenter se samedi c'est a propos les jeu en mode texte en pascal voila l'enencé de tp:ce jeu a deux joueurs
Aide speciale pour une grille [ par OLAFGA ]
Bonjour a tous :)Alors j'aurais besoin de votre, je suis relativement nouveau sur Delphi, et ce que j'aimerais c'est faire une plateau de jeu assez sp
Rafraichissement TImage [ par CptPingu ]
J'ai crée un petit programme qui résoud les Sudoku (je le posterais pas, il y en a déjà assez sur ce site).J'utilise un TImage pou
jeu multijoueur [ par aureliensm ]
Bonjour a tous.J'ai grandement besoin de votre aide. Je suis en train de realiser un rpg en multijoueur. Pour mon jeu , j'ai deja realise un chat incl
réalisation d'un jeu d'anagrammes [ par isis1be ]
Bonjour à tousJe désire réaliser un jeu d'anagrammes mais je ne sais pas comment je doit faire pour récupérer le contenu d'un edit contenant le prenom
jeu du serpent [ par persius ]
q.qu un pourrai m aider ?si vous avez des codes source sur le jeu snake en delphije dois cree le jeu serpent sur le delphi en
Calcul de la moyenne [ par mtaallah ]
Salut à tous; Je cherche à calculer la moyenne de quatre valeurs dans un DBGrid (connecté à une base de données access via un ADOQuery)... Pour exp
jeu sur réseau [ par amenbr ]
salut,je suis chargé à réaliser un jeu d'enfants (questions /reponses + affichage des scores ....) sur réseau, j'ai commencé par le coté graphique, po
programmation d'un jeu "mot à mot" [ par ptteflo ]
bonjours à tous!! je dois programmer un jeu "mot à mot" en delphi et j'avoue que je ne sais pas du tout par où commencer et comment m'y prendre!!j'aur
Page PHP [ par scorpion077 ]
Bonjour à tous.J'ai développé récement un jeu de carte sous delphi. J'ai également crée une page html concernant les règles du jeu. Seulement je n'ai
|
Derniers Blogs
[SHAREPOINT] LES SESSIONS TECHDAYS 2012.[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet
Voici donc pour ceux qui n'ont pas pu venir, ou ceux qui n'ont pas pu toutes les suivre la liste des sessions SharePoint aux TechDays 2012, que je mettrais à jour dès que les liens des vidéo seront disponibles. Ou ici : http...
Cliquez pour lire la suite de l'article par Patrick Guimonet TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice
Speaker: Bernard Ourghanlian Cette session est comme chaque jour transmise en live par BrainSonic, et j'ai donc suivi cette troisième pleinière par ce moyen sur mon iPad . Elle est dédiée comme chaque année à la mise en perspective de l'é...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE !MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE ! par Vko
Hier durant une session dédiée aux Techdays 2012, j'ai eu le plaisir d'annoncer la sortie de la Béta 2 de Mishra Reader. C'est quoi ? Pour les utilisateurs, c'est une vraie expérience de lecture de flux RSS sur Windows. Rien à voir avec les produit...
Cliquez pour lire la suite de l'article par Vko [FRAMEWORK 4] LES TASKS ET LE THREAD UI[FRAMEWORK 4] LES TASKS ET LE THREAD UI par fathi
Je viens de passer quelques temps au TechDay's et j'ai pu voir pas mal de session intéressante. Par contre une chose m'a un peu étonné lors de certaines de ces sessions qui abordaient les améliorations du framework .NET (donc le 4.5) : en gros, bea...
Cliquez pour lire la suite de l'article par fathi WORKFLOW FOUNDATION 3 A UN PIED DANS LA TOMBEWORKFLOW FOUNDATION 3 A UN PIED DANS LA TOMBE par JeremyJeanson
Depuis déjà un an, je conseille vivement les utilisateurs de Workflow Foundation 3 à migrer vers la version 4. L'information qui va suivre ne devrait donc pas trop prendre au dépourvu les personnes qui m'ont suivi. Je profite de ce poste, pour faire le re...
Cliquez pour lire la suite de l'article par JeremyJeanson
Logiciels
Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning COLLECTOR PLUS (3.00B)COLLECTOR PLUS (3.00B)COLLECTOR PLUS version 3.00B est un logiciel utilisant une base de données alimentée par :
- L... Cliquez pour télécharger COLLECTOR PLUS PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO LettresFaciles 2011 (8.0.0.1)LETTRESFACILES 2011 (8.0.0.1)LettresFaciles est un logiciel facilitant la création et la rédaction de lettres types.
Son inte... Cliquez pour télécharger LettresFaciles 2011
|