Soyez le premier à donner votre avis sur cette source.
Snippet vu 15 036 fois - Téléchargée 31 fois
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;
Et merci de penser à ceux qui programment en autoditacte et dont ce n'est pas le métier, perso pour mon projet j'ai gagné un temps considérable car ta source correspond exactement à mes besoins... Note pour ma part : 15/20. A+
1) Dans le cas où il y a des contraintes de syntaxe, il faut implémenter un correcteur de syntaxe. C'est d'ailleurs ce que je ferai sur mon ID=20662.
2) ln{2}=ln2 Woaa!!
3) Que disais-je à propos du var ?
4) Pourquoi un TObject survient-il ? Je mets un NIL en paramètre pour ignorer.
5) Incohérence dans l'explication finale: parenthèses, vraiment ??
6) Il faudrait implémenter un ZIP. Ca évitera de perdre du temps déjà si précieux, ou de se tromper dans les commentaires parce que le source a été manipulé comme il ne faudrait pas.
Sinon, quand c'est voté, c'est voté. Il faudra compter sur les nouveaux visiteurs. C'est bête ça d'ailleurs de ne pas pouvoir corriger un vote. Faudra avertir Nix !! S'il nous regarde...
Donc, voilà. Sans vouloir être méchant, c'est vraiment toujours très étrange. Cependant, il est vrai qu'il y a eu de bonnes modifications. J'accorde donc virtuellement un bonus. :)
(avant que vous ne trouviez d'autres Bugs !! :)) )
Comme elle fait parti d'un grand projet : pensez à utiliser les {} au lieu des () dans vos expressions à évaluer. ou bien remplacer dans ma source les {} par des ()... au choix.
J'ai volontairement désactiver 2 zones : gestion des variables et exécution de fonctions spéciales, car la source aurait été trop volumineuse....
Mais vous retrouverez tous ceci lors de la publication du projet complet...
Merci à bientôt... si vous avez des commentaires n'hésitez pas....
Au fait xoleras, je connais pas Free Pascal, mais je n'ai rien utilisé de spécial dans cette source...
Bon utilisation de ce code !!! (PS : si cette nouvelle mouture vous convient mieux : faite remonter la note ça marque mal !!!) :)))))))))))
bye
Je vais essayer d'en tenir compte et d'y remédier...
En fait depuis que je l'ai posté, j'ai été obligé de modifier ce code... Mais je ne l'ai pas remis à jour ici !!! désolé...
Car cela fait parti d'un projet de plus grande envergure !!!! Un générateur d'application base de données !!! (avec le quel on peut faire n'importe quel type d'application sans recompiler une seule ligne !!!)... Donc désolé par manque de temps j'ai pas fait de mise à jour... J'essayerai de l'exécuter rapidement... Mais de toute façon je vais probablement publier mon projet ici... Donc...
Merci encore, à bientôt..
Expressions unaires (du type '-25', '666'): OK
Autres expressions: plantage avec un message d'erreur vide.
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.