EVALUATEUR D'EXPRESSION MATHÉMATIQUE (PARENTHESE, PUISSANCE, MODULO, +-*/)

Function TVARS.GetValExpr(Sender : TObject ; Value : string; posi : integer; avant : boolean) : string;
const
  operation = '*/\+-^{}';  //
var
  i : integer;
  go : boolean;
  s : string;
begin
  // extrait l'expression avant=True : avant la position  ou avant=false : aprés la position
  if avant then
    i := -1
  else
    i := 1;
  s := '';
  // condition pour continuer
  go := true;
  if (posi + i < 0) or (posi + i > length(Value)) then
    go := false;
  if Go then
  Begin
    // faire la boucle pour extraire la valeur à retourner
    while go and ((pos(Value[posi + i], operation) < 1)) do  // And (i > 1)
    begin
      if avant then
      begin
        s := Value[posi + i] + s;
        dec(i);
        // récupérer le signe pour faire l'opération suivante...
        If Value[posi + i] = '-' then
          s := '-' + s;
      end
      else
      begin
        s := s + Value[posi + i];
        inc(i);
      end;
      if (posi + i < 0) or (posi + i > length(Value)) then
        go := false;
    end;
  end;
  // retourner la valeur
  GetValExpr := s;
end;


Function TVARS.EvalExpression(Sender : TObject ; var Value : string) : string;
var
  i : integer;
  posi : integer;
  s1, s2 : string;
//  premier : boolean;
  retour : string;   // Valeur de retour : le résultat du calcul
  startparent : integer;  // position dans Value de la première parenthése ouverte
  Endparent : integer;    // position dans Value de la parenthése fermée
  ouvreparent : integer;  // nombre de parenthèses ouvertes
  fermeparent : integer;  // nombre de parenthèses  fermées
begin
  // Auteur : fabien FERT  ==> adress Mail : fabien.fert@wanadoo.fr
  //   version 0.8 : 11/07/2004 : gestion d'un calcul unique (suppressions des espaces sur les valeur retournées avant le calcul)
  //   version 0.9 : 17/07/2004 : gestion de plusieurs calculs cumulés
  //   version 1.0 : 17/07/2004 : gestion des parenthèses
  //   version 1.1 : 19/07/2004 : gestion des espaces (début et fin de chaîne) : Erreur soulevée par Japee sur www.delphifr.com
  //   version 1.2 : 25/07/2004 : Remplacement des () par les {} pour la compatibilité SQL
  //   version 1.3 : 30/07/2004 : Correction Bug - comme signe rencontré dans les expressions : -{-0.1-2},  -2+1, 3-{4-3*4},  5+{-2}, 1+125+{25-36}
  //   version 1.4 : 12/08/2004 : Correstion Bug - Ln{2} = Ln0

  // TODO : gestion des fonctions : Sin, cos, Tan, Exp, Ln, 1/n, Sqr
  // vous pouvez réutilisez ce code à votre guise à condition de ne pas effacer les lignes ci-dessus.

//  Premier := false;  // le premier chiffre est finit ? : non   // Attention suppression à vérifier !!!
  s1 := '';
  s2 := '';
  // vérifie que toutes les parenthèse ouvertes sont fermées...
  i := 1;
  Value := Trim(Value);
  ouvreparent := 0;
  fermeparent := 0;
  while i < length(Value)+1 do
  begin
    if Value[i] = '{' then
    begin
      inc(ouvreparent);
    end
    else if Value[i] = '}' then
    begin
      inc(fermeparent);
    end;
    inc(i);
  end;
  // s'il y a un problème de paranthése : on complète ( en début ou ) à la fin
  if ouvreparent > fermeparent then
  begin
    i := 0;
    while i < ouvreparent-fermeparent Do
    begin
      Value := Value + '}';
      inc(i);
    end;
  end
  else if ouvreparent < fermeparent then
  begin
    // ouvre la parenthése
    for i := ouvreparent to fermeparent Do
    begin
      Value := '{' + Value;
    end;
  end;

  // Gére les parenthèse ou les reste....
  if pos('{', Value) > 0 then
  Begin
    // s'il y a des parenthèse on les gère ici
    // faire un appel récursif du contenu des parenthèses
    startParent := 0;
    EndParent := 0;
    ouvreparent :=0;
    fermeparent :=0;
    i := 1;
    while i < length(Value)+1 do
    begin
      if Value[i] = '{' then
      begin
        inc(ouvreparent);
        If StartParent = 0 then StartParent := i;
      end
      else if Value[i] = '}' then
      begin
        inc(fermeparent);
        If (endParent = 0) and (fermeparent = ouvreparent) then EndParent := i;
      end;
      inc(i);
    end;
    // Evaluer la chaine contenue dans les parenthèses
    if StartParent + 1 <= EndParent - 1 Then
    begin
      Retour := copy(Value, startParent + 1, EndParent -1 - startparent);
      EvalExpression(Sender, Retour);
    end
    else
      retour := '0';
    // concaténé le resultat
    if (EndParent + 1 < Length(Value)) and (StartParent > 0) then
      Value := copy(Value, 0, StartParent -1) + retour + copy(Value, EndParent+1, length(value))
    else if startParent = 0 then
      Value := retour + copy(Value, EndParent+1, length(value))
    else if (EndParent + 1 > Length(Value)) then
      Value := copy(Value, 0, StartParent -1) + retour;
    // faire un appel récursif pour évaluer la chaine résultante
    EvalExpression(Sender, Value);
  end
  else if pos('@', uppercase(Value)) > 0 then
  begin
{  PAS UTILISE ICI : sert pour l'exécution de fonctions : envois de Mail, Liste les variables, exécuter des applications extérieures, etc... fonctions avancées...
    // retourner l'expression littérale... si elle contient des lettres de l'alphabet
    posi := pos('@', Value);
    Value := VarEvalFunction(Sender, Value);
}
  end
  else if pos('$', uppercase(Value)) > 0 then
  begin
{   PAS UTILISE ICI : Sert pour la gestion des variables interne
    // retourner l'expression littérale... si elle contient des lettres de l'alphabet
    posi := pos('$', Value);
    s1 := GetVarName(sender, Value);
    // affecte et retourne la valeur....
    Value := GetVarStrAffect(Sender, copy(Value, pos(s1, uppercase(Value)) + length(s1), length(Value)), s1);
    // supprimer l'affectation si il y a lieu
//    Value :=  copy(Value, 0, pos(s1, uppercase(Value)) + length(s1)) + Copy(Value, pos(s1, uppercase(Value)) + length(s1) + posi2, length(Value));
}
  end
  else if pos('A', uppercase(Value)) + pos('B', uppercase(Value)) + pos('C', uppercase(Value)) + pos('D', uppercase(Value)) + pos('E', uppercase(Value)) + pos('F', uppercase(Value)) + pos('G', uppercase(Value)) + pos('H', uppercase(Value)) + pos('I', uppercase(Value)) + pos('J', uppercase(Value)) + pos('K', uppercase(Value)) + pos('L', uppercase(Value)) + pos('M', uppercase(Value)) + pos('N', uppercase(Value)) + pos('O', uppercase(Value)) + pos('P', uppercase(Value)) + pos('Q', uppercase(Value)) + pos('R', uppercase(Value)) + pos('S', uppercase(Value)) + pos('T', uppercase(Value)) + pos('U', uppercase(Value)) + pos('V', uppercase(Value)) + pos('W', uppercase(Value)) +   pos('X', uppercase(Value)) +   pos('Y', uppercase(Value)) +  pos('Z', uppercase(Value)) +  pos('"', uppercase(Value)) +  pos(':', uppercase(Value)) +  pos('=', uppercase(Value)) > 0 then
  begin
    // retourner l'expression littérale... si elle contient des lettres de l'alphabet
    Value := Value;
  end
  else if pos('*', Value) + pos('/', Value) + pos('\', Value) + pos('+', Value) + pos('-', Value) + pos('^', Value) > 0 then
  begin
    if pos('^', Value) > 0 then
    begin
      // extraire la partie droite et gauche du signe
      posi := pos('^', Value);
      s1 := GetValExpr(sender, Value, posi, True);
      If Value[Posi + 1] = '-' then
      Begin
        Value[Posi + 1] := '0';
        s2 := '-' + GetValExpr(sender, Value, posi, False);
      end
      Else
      Begin
        s2 := GetValExpr(sender, Value, posi, False);
      End;
      retour := FloatToStr(Power(strToFloat(trim(s1)),strToFloat(trim(s2))));
      // remplacer la valeur
      s1 := s1 + '^' + s2;
      Value := copy(Value, 0, pos(s1, Value) -1) + retour + copy(Value, pos(s1, Value) + length(s1), length(value));
      // faire un appel récursif
      EvalExpression(Sender, Value);
    end
    else if pos('*', Value) > 0 then
    begin
      // extraire la partie droite et gauche du signe
      posi := pos('*', Value);
      s1 := GetValExpr(sender, Value, posi, True);
      If Value[Posi + 1] = '-' then
      Begin
        Value[Posi + 1] := '0';
        s2 := '-' + GetValExpr(sender, Value, posi, False);
      end
      Else
      Begin
        s2 := GetValExpr(sender, Value, posi, False);
      End;
      retour := FloatToStr(strToFloat(trim(s1)) * strToFloat(trim(s2)));
      // remplacer la valeur
      s1 := s1 + '*' + s2;
      Value := copy(Value, 0, pos(s1, Value) -1) + retour + copy(Value, pos(s1, Value) + length(s1), length(value));
      // faire un appel récursif
      EvalExpression(Sender, Value);
    end
    else if pos('/', Value) > 0 then
    begin
      // extraire la partie droite et gauche du signe
      posi := pos('/', Value);
      s1 := GetValExpr(sender, Value, posi, True);
      If Value[Posi + 1] = '-' then
      Begin
        Value[Posi + 1] := '0';
        s2 := '-' + GetValExpr(sender, Value, posi, False);
      end
      Else
      Begin
        s2 := GetValExpr(sender, Value, posi, False);
      End;
      if (s2 <> '0') and (s2 <> '-0') then
        retour := FloatToStr(strToFloat(trim(s1)) / strToFloat(trim(s2)))
      else
        retour := '0';
      // remplacer la valeur
      s1 := s1 + '/' + s2;
      Value := copy(Value, 0, pos(s1, Value) -1) + retour + copy(Value, pos(s1, Value) + length(s1) , length(value));
      // faire un appel récursif
      EvalExpression(Sender, Value);
    end
    else if pos('\', Value) > 0 then
    begin
      // extraire la partie droite et gauche du signe
      posi := pos('\', Value);
      s1 := GetValExpr(sender, Value, posi, True);
      If Value[Posi + 1] = '-' then
      Begin
        Value[Posi + 1] := '0';
        s2 := '-' + GetValExpr(sender, Value, posi, False);
      end
      Else
      Begin
        s2 := GetValExpr(sender, Value, posi, False);
      End;
      retour := FloatToStr(strToint(trim(s1)) Mod strToint(trim(s2))); // calcule le modulo 10 mod 3=1
      // remplacer la valeur
      s1 := s1 + '\' + s2;
      Value := copy(Value, 0, pos(s1, Value) -1) + retour + copy(Value, pos(s1, Value) + length(s1) , length(value));
      // faire un appel récursif
      EvalExpression(Sender, Value);
    end
    else if pos('+', Value) > 0 then
    begin
      // extraire la partie droite et gauche du signe
      posi := pos('+', Value);
      s1 := GetValExpr(sender, Value, posi, True);
      If Value[Posi + 1] = '-' then
      Begin
        Value[Posi + 1] := '0';
        s2 := '-' + GetValExpr(sender, Value, posi, False);
      end
      Else
      Begin
        s2 := GetValExpr(sender, Value, posi, False);
      End;
      retour := FloatToStr(strToFloat(trim(s1)) + strToFloat(trim(s2)));
      // remplacer la valeur
      s1 := s1 + '+' + s2;
      Value := copy(Value, 0, pos(s1, Value) -1) + retour + copy(Value, pos(s1, Value) + length(s1) , length(value));
      // faire un appel récursif
      EvalExpression(Sender, Value);
    end
    else if pos('-', Value) > 0 then
    begin
      // extraire la partie droite et gauche du signe
      posi := pos('-', Value);
      If posi = 1 then
        posi := 1 + pos('-', Copy(Value,2, length(Value)));
      // ne pas compter le permier signe..
      if posi > 1 then
      begin
        // si c'est bien une opération (pas le signe de la valeur résultat) : on peut calculer...
        s1 := GetValExpr(sender, Value, posi, True);
        If Value[Posi + 1] = '-' then
        Begin
          Value[Posi + 1] := '0';
          s2 := GetValExpr(sender, Value, posi, False);
        end
        Else
        Begin
          s2 := GetValExpr(sender, Value, posi, False);
        End;
        If s1 <> '' then
        begin
          retour := FloatToStr(strToFloat(trim(s1)) - strToFloat(trim(s2)));
          // remplacer la valeur
          s1 := s1 + '-' + s2;
          Value := copy(Value, 0, pos(s1, Value) -1) + retour + copy(Value, pos(s1, Value) + length(s1) , length(value));
        // faire un appel récursif
          EvalExpression(Sender, Value);
        end;
      end
    end;
    // Gérer le double Signe - du départ : le supprimer
    If Value[1] = '-' then
      If Value[2] = '-' then
        Value := '-' + Copy(Value, 3, length(Value));  // := '0';
  end;
  // Retourner la valeur
  EvalExpression := Value;
end;