CALCULER LA VALEUR D'UN STRING '1+2*(4/2)' [MINI PARSEUR AVEC REGLES] , EX POUR FAUST

{
 Base de regles :
 ----------------
 Regles de calculs :
   R1 : Si ($) alors res := [$];
   R2 : Si $*$ alors res := [$*$];
   R3 : Si $/$ alors res := [$/$];
   R4 : Si $+$ alors res := [$+$];
   R5 : Si $-$ alors res := [$-$];
 Regles additionnelles :
   pour mettre -3 en debut de ligne
   R6 : Si -$ alors res := [-$]; << implicitement mise dans R4 et R5

   pour permettre d'utiliser des expressions literale a la place de chiffres
   R7 : Si $<>[0..9]* alors res := $; << non implémentée

 Sur cette Base de regles on applique un systeme par priorité et par reccurence

 Problemes qui peuvent subvenir : la * et plus forte que la /, pour autant
 le probleme de 2*3/2 donnera un bon resultat. Mais ici les operations sont
 de type entier, donc 3/2 = 1 et non pas 1.5 
}

// variable globale pour savoir s'il ya eut une erreur, cette variable
// pourrait etre passé en parametre dans toutes les fonctions et renvoyer
// par exemple la position de l'erreur dans la chaine de caractere, mais bon
// ici c'est juste un exemple donc on mettra un boolean
var
   Calcul_regles_b : boolean;

// comme c'est de la reccurence on doit mettre l'entete de calcul_regles avant
// les autres fonctions
function calcul_regles (s : string) : string;

// calcul le contenu des parentheses et renvoie le resultat.
function calcul_R1 (var s : string) : boolean;
var
   i,j,k : integer;
   t,u : string;
begin
     i := AnsiPos('(',s);
   While (i > 0) do
   begin
     t := '';
     j := 0; // nombre de parenthese ouverte ajoutée en +, au cas ou : (...(..)..)
     k := i+1; // compteur
     while ( (k <=StrLen(PChar(s))) and (s[k]<>')') and (j=0)) do
     begin
          if (s[k]='(') then Inc(j);
          if (s[k]=')') then Dec(j);
          t := t + s[k];
          Inc(k);
     end;
     // si k > StrLen(PChar(s)) c'est qu'il y a probleme dans l'equation,
     // renvoie de l'erreur
     if (k > StrLen(PChar(s))) then
     begin
          calcul_R1 := false;
          exit;
     end;
     // on calcul 't' qui est l'interieur de la parenthese et on remplace la
     // parenthese par le resultat du calcul
     // i : position parenthese (, k : position parenthese )
     u := calcul_regles(t);
     // cas d'erreur de calcul.
     if u='' then
     begin
          calcul_R1 := false;
          exit;
     end;
     // on remplace t par u dans la chaine :
     t := '('+ t +')';
     s := AnsiReplaceStr(s,t,u);
     // on renvoie que l'on a correctement fini :
     i := AnsiPos('(',s);
   end;
     if i = 0 then
     begin
          // aucune parenthese trouvée, la regles est donc inutile, on passe
          // a la suivante
          calcul_R1 := true;
          exit;
     end;
end;

// calcul le terme de gauche, de droite et fais la multiplication.
function calcul_R2 (var s : string) : boolean;
var
   i,j,k : integer;
   t,u : string;
   termeG, termeD,
   termeGs, termeDs : string;
begin
     i := AnsiPos('*',s);
     if i = 0 then
     begin
          // aucune parenthese trouvée, la regles est donc inutile, on passe
          // a la suivante
          calcul_R2 := true;
          exit;
     end;
     // recherche le terme gauche sachant que nous n'avons plus de () grace a R1
        // t sera le terme de gauche.
        t := s;
        delete(t,i,StrLen(PChar(t)));
        k := StrLen(PChar(t));
        u := '';
        // on fait attention a la priorité de la * sur + et -, ex : 1+2*3+4
        // au final u = 2 et non pas 1+2
        while ( (k>=1) and (t[k]<>'+') and (t[k]<>'-') and (t[k]<>'/') ) do
        begin
             u := t[k] + u;
             Dec(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        delete(t,k+1,StrLen(PChar(t))-k+1);
        termeG :=  Calcul_regles(u);
        termeGs := t;

        // t sera le terme de droite
        t := s;
        delete(t,1,i);
        k := 1;
        u := '';
        // on fait attention a la priorité de la * sur + et -, ex : 1+2*3+4
        // au final u = 2 et non pas 1+2
        while ( (k<=StrLen(PChar(t))) and (t[k]<>'+') and (t[k]<>'-') and (t[k]<>'/') ) do
        begin
             u := u + t[k];
             Inc(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        delete(t,1,k-1);
        termeD :=  Calcul_regles(u);
        termeDs := t;

     // verifie le terme de droite : s'il ne contient rien c'est qu'il y a une
     // erreur dans la formule
     if TermeD = '' then
     begin
          calcul_R2 := false;
          exit;
     end;

     // on calcul la multiplication :
     t := IntToStr(  StrToInt(TermeG) * StrToInt(TermeD)  );
     s := TermeGs + t + TermeDs;
     Calcul_R2 := true;
end;

// idem que la 2 mais avec la /
function calcul_R3 (var s : string) : boolean;
var
   i,j,k : integer;
   t,u : string;
   termeG, termeD,
   termeGs, termeDs : string;
begin
     i := AnsiPos('/',s);
     if i = 0 then
     begin
          // aucune parenthese trouvée, la regles est donc inutile, on passe
          // a la suivante
          calcul_R3 := true;
          exit;
     end;
     // recherche le terme gauche sachant que nous n'avons plus de () grace a R1
        // t sera le terme de gauche.
        t := s;
        delete(t,i,StrLen(PChar(t)));
        k := StrLen(PChar(t));
        u := '';
        // on fait attention a la priorité de la * sur + et -, ex : 1+2*3+4
        // au final u = 2 et non pas 1+2
        while ( (k>=1) and (t[k]<>'+') and (t[k]<>'-') ) do
        begin
             u := t[k] + u;
             Dec(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        delete(t,k+1,StrLen(PChar(t))-k+1);
        termeG :=  Calcul_regles(u);
        termeGs := t;

        // t sera le terme de droite
        t := s;
        delete(t,1,i);
        k := 1;
        u := '';
        // on fait attention a la priorité de la * sur + et -, ex : 1+2*3+4
        // au final u = 2 et non pas 1+2
        while ( (k<=StrLen(PChar(t))) and (t[k]<>'+') and (t[k]<>'-') ) do
        begin
             u := u + t[k];
             Inc(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        delete(t,1,k-1);
        termeD :=  Calcul_regles(u);
        termeDs := t;

     // verifie le terme de droite : s'il ne contient rien c'est qu'il y a une
     // erreur dans la formule
     if TermeD = '' then
     begin
          calcul_R3 := false;
          exit;
     end;

     // on calcul la multiplication :
     t := IntToStr(  StrToInt(TermeG) DIV StrToInt(TermeD)  );
     s := TermeGs + t + TermeDs;
     Calcul_R3 := true;
end;

// idem que la 3 mais avec la +
function calcul_R4 (var s : string) : boolean;
var
   i,j,k : integer;
   t,u : string;
   termeG, termeD,
   termeGs, termeDs : string;
begin
     i := AnsiPos('+',s);
     if i = 0 then
     begin
          // aucune parenthese trouvée, la regles est donc inutile, on passe
          // a la suivante
          calcul_R4 := true;
          exit;
     end;
     // recherche le terme gauche sachant que nous n'avons plus de () grace a R1
        // t sera le terme de gauche.
        t := s;
        delete(t,i,StrLen(PChar(t)));
        k := StrLen(PChar(t));
        u := '';
        while ( (k>=1) and (t[k]<>'-') ) do
        begin
             u := t[k] + u;
             Dec(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        if ((k=1) and (t[1]='-')) then
        begin
             Dec(k);
             u := '-'+u;
        end;
        delete(t,k+1,StrLen(PChar(t))-k+1);
        termeG :=  Calcul_regles(u);
        termeGs := t;

        // t sera le terme de droite
        t := s;
        delete(t,1,i);
        k := 1;
        u := '';
        while ( (k<=StrLen(PChar(t))) and (t[k]<>'-') ) do
        begin
             u := u + t[k];
             Inc(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        delete(t,1,k-1);
        termeD :=  Calcul_regles(u);
        termeDs := t;

     // verifie le terme de droite : s'il ne contient rien c'est qu'il y a une
     // erreur dans la formule
     if TermeD = '' then
     begin
          calcul_R4 := false;
          exit;
     end;

     // on calcul la multiplication :
     t := IntToStr(  StrToInt(TermeG) + StrToInt(TermeD)  );
     s := TermeGs + t + TermeDs;
     Calcul_R4 := true;
end;

// idem que la 4 mais avec la -
function calcul_R5 (var s : string) : boolean;
var
   i,j,k : integer;
   t,u : string;
   termeG, termeD,
   termeGs, termeDs : string;
begin
     i := AnsiPos('-',s);
     if i = 0 then
     begin
          // aucune parenthese trouvée, la regles est donc inutile, on passe
          // a la suivante
          calcul_R5 := true;
          exit;
     end;
     // recherche le terme gauche sachant que nous n'avons plus de () grace a R1
        // t sera le terme de gauche.
        t := s;
        delete(t,i,StrLen(PChar(t)));
        k := StrLen(PChar(t));
        u := '';
        while ( (k>=1) and (t[k]<>'-') ) do
        begin
             u := t[k] + u;
             Dec(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
          // cas ou l'on a -3
          if (u ='') then
          begin
               // l'operation StrToInt verra parfaitement le -3 comme un negatif
               // donc on renvoie le resultat sans rien faire
               calcul_R5 := true;
               exit;
          end;

        delete(t,k+1,StrLen(PChar(t))-k+1);
        termeG :=  Calcul_regles(u);
        termeGs := t;

        // t sera le terme de droite
        t := s;
        delete(t,1,i);
        k := 1;
        u := '';
        while ( (k<=StrLen(PChar(t))) and (t[k]<>'-') ) do
        begin
             u := u + t[k];
             Inc(k);
        end;
        // u contient le terme de gauche a calculer, et k l'indice ou il
        // faudra remplacer
        delete(t,1,k-1);
        termeD :=  Calcul_regles(u);
        termeDs := t;

     // verifie le terme de droite : s'il ne contient rien c'est qu'il y a une
     // erreur dans la formule
     if TermeD = '' then
     begin
          calcul_R5 := false;
          exit;
     end;

     // on calcul la multiplication :
     t := IntToStr(  StrToInt(TermeG) - StrToInt(TermeD)  );
     s := TermeGs + t + TermeDs;
     Calcul_R5 := true;
end;

begin
     // regle 1 : (...)
     if not calcul_R1(s) then
     begin
          ShowMessage('Erreur dans l''une des () :'+s);
          calcul_regles := '0';
          Calcul_regles_b := false;
          exit;
     end;
     // regle 2 : *
     if not calcul_R2(s) then
     begin
          ShowMessage('Erreur dans l''un des termes de la * :'+s);
          calcul_regles := '0';
          Calcul_regles_b := false;
          exit;
     end;
     // regle 3 : /
     if not calcul_R3(s) then
     begin
          ShowMessage('Erreur dans l''un des termes de la / :'+s);
          calcul_regles := '0';
          Calcul_regles_b := false;
          exit;
     end;
     // regle 4 : +
     if not calcul_R4(s) then
     begin
          ShowMessage('Erreur dans l''un des termes de la + :'+s);
          calcul_regles := '0';
          Calcul_regles_b := false;
          exit;
     end;
     // regle 5 : -
     if not calcul_R5(s) then
     begin
          ShowMessage('Erreur dans l''un des termes de la - :'+s);
          calcul_regles := '0';
          Calcul_regles_b := false;
          exit;
     end;

     // si aucune regle ne peut etre appliquée alors on retourne la variable
     // de depart :
     Calcul_regles := s;
end;

function StrCalcul (s : string) : string;
var t : string;
begin
     Calcul_regles_b := true;
     t := calcul_regles(s);
     if Calcul_regles_b
        then StrCalcul := t
        else StrCalcul := 'ERREUR durant l''operation';
end;