RÉSOLUTION D'UNE ÉQUATION DE DEUXIÈME DEGRÉ

{*****************************}
{ 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.