Ce programme sert a résoudre une équation de deuxième degré.
En utilisant une interface simple.
Source / Exemple :
{*****************************}
{ UDL }
{ Facultee des sciences }
{ Departement d'informatique }
{ El Antri Abdellah }
{ Email: El_Emir_2002@yahoo.fr }
{ 19/04/2004 02:30 }
{Compiler avec Tp3 }
{*****************************}
{Ce programme resout des equations de deuxieme degre dans R }
{avec des coefficients entieres }
{Ce programme est devlopper pour des raisons pedagogiques }
{Il n'est ni optimale(gestion des couleurs), ni efficace }
{ (pas de coefficients reels) }
{
Remarque:
Pour les nombres le programme va automatiquement ajoute des parentheses
}
{N'hesiter pas a m'appeler pour tout vos questions ou sugestions}
uses Dos, Crt;
var A,B,C: LongInt ; { Coeficients de l'equation }
var D,X1,X2: real ; { D pour delta X1,X2 pour les solutions}
{***************************************************}
procedure couleurs(Text,Fond:Integer);
begin
Textcolor(Text);
Textbackground(Fond);
end;
{***************************************************}
{***************************************************}
procedure vide(X,Y: LongInt);
begin
gotoxy(X,Y);
textcolor (RED);
textbackground (YELLOW);
write(' ');
textcolor (WHITE);
textbackground (BLACK);
end;
{***************************************************}
{***************************************************}
procedure aread(var val:Longint);
var signe : boolean;
var cpt: Integer;
var c,ancien_c: char ; { En va lire les coefficienta par caractere(c)}
{ ancien_c est utilise en cas de supression }
{ pour la reevaluation de l'entier lu }
var sauver_coord_x: Integer; { pour sauver la position x, lors l'affichage }
{ de l'erreur entier trop grand }
begin
cpt := 0;
val := 0;
signe := false ;
Repeat
begin
ancien_c := c;
c := ReadKey;
if(cpt <= 8) then { Les coefficients doivent etre moins de 9 chiffres}
begin
if ( (ord(c) >= 48) and (ord(c) <= 57) ) then
{On accepte que les chiffres}
begin
couleurs(RED,YELLOW);
write(c);
couleurs(WHITE,BLACK);
val := val*10 + (ord(c)-48);
cpt := cpt + 1;
end
else if ((ord(c) = 8) and ((cpt > 0) or ((cpt = 0) and (signe))) ) then
{ Pour la supression(8 est le code ascii de Backspace)}
begin
if(cpt > 0) then
begin
gotoxy(wherex - 1,wherey);
couleurs(RED,YELLOW);
write(' ');
couleurs(WHITE,BLACK);
gotoxy(wherex - 1,wherey);
val := val - ord(ancien_c)+48;
val := val Div 10;
cpt := cpt - 1;
end;
if((cpt = 0) and signe) then
{Pour effacer '(-'}
begin
signe := false;
gotoxy(wherex - 2,wherey);
couleurs(RED,YELLOW);
write(' ');
gotoxy(wherex - 2,wherey);
couleurs(WHITE,BLACK);
end;
end
else if((ord(c) = 13) and (cpt = 0)) then
{ valeur par defaut des coefficients = 0}
begin
couleurs(RED,YELLOW);
write('0');
couleurs(WHITE,BLACK);
val := 0;
end
else if( (c = '-') and (cpt = 0) ) then
{ pour le signe}
begin
if(signe) then
begin
couleurs(RED,YELLOW);
gotoxy(wherex - 2,wherey);
write(' ');
gotoxy(wherex - 2,wherey);
couleurs(WHITE,BLACK);
end
else
begin
couleurs(RED,YELLOW);
write('(-');
end;
couleurs(WHITE,BLACK);
signe := not signe;
end;
end
else
{Plus que 9 chiffres}
begin
sauver_coord_x := wherex;
textcolor(BLUE);
gotoxy(30,20);
writeln('Entier trop grand');
delay(10000);
textcolor(BLACK);
gotoxy(30,20);
writeln('Entier trop grand');
textcolor(WHITE);
gotoxy(sauver_coord_x,10);
end;
end;
until (ord(c) = 13); { Jusqu' a la frappe de la touche entrer}
if(signe) then
begin
val := -val;
couleurs(RED,YELLOW);
write(')');
couleurs(WHITE,BLACK);
end;
end;
{***************************************************}
{*************** Prog principal ****************}
begin
clrscr;
vide(1,10);
write('Xý +');
vide(18,10);
write('X +');
vide(34,10);
write(' = 0');
gotoxy(1,10);
aread(A);
gotoxy(18,10);
aread(B);
gotoxy(34,10);
aread(C);
clrscr;
if( (A = 0) and (B = 0) and (C = 0)) then
begin
writeln('L''ensemble des solutions est: R');
exit;
end
else if((A = 0) and (B = 0) and (C <> 0)) then
begin
writeln('Contradictoire!!!');
exit;
end;
D := sqr(B) - 4*A*C;
if(D = 0) then
begin
writeln('Delta = ',d);
writeln('Puisque Delta = 0 alors l''equation admet une seul solution:',-B/2*A);
end
else
if(D > 0) then
begin
writeln('Delta = ',d);
writeln('Puisque Delta > 0 alors l''equation admet deux solutions:');
X1 := (-B-sqr(D))/2*A;
X2 := (-B-sqr(D))/2*A;
writeln('X1 = ',X1 );
writeln('X2 = ',X2 );
end
else
begin
writeln('Delta = ',d);
writeln('Puisque Delta < 0 alors: l''equation n''admet aucune solution dans R');
end;
readln;
end.
Conclusion :
La source est trés claire.
Pour tout vos questions, suggestions contacter moi sur el_emir_2002@yahoo.fr
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.