Soyez le premier à donner votre avis sur cette source.
Vue 5 977 fois - Téléchargée 444 fois
{ 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;
Merci pour m'avoir dit l'erreur
(2+3)*(4+6)
Mais ce projet est plus qu' interessant !
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.