Evaluateur de formules

Description

Voila Un évaluateur de formules mais assez différent de ceux que j'ai déjà vu.
Il intègre la définition:
- de variables
- d'expressions
- de listes
- de fonctions utilisateur
- de fonctions prédéfinies étendues
Il ya 2 projets dans le ZIp,:
- Une DLL qui une fois compilée peux être instancié dans n'iporte quelle appli VB
- Une Exe de test
Le groupe de projet permet d'ouvri les 2 en même temps
Une fois lancée le test,
le bouton "Aide" affiche la liste des fonctions disponibles
le bouton "Lisez moi" affiche un aide à l'utilisation du projet de test

Exemple de formules utilisée dans l'exemple de test
---------------------------------------------------
obEval.Param("togodo") = 123
obEval.Param("annee") = 800
obEval.Param("trimestre") = 3
obEval.Param("nbEnr") = 2
obEval.Param("nbDecimal") = 2
obEval.Param("a") = 3
obEval.Param("b") = 4
obEval.Param("Suite") = 123456789
obEval.Param("Suite") = 987654321
obEval.Param("Premier") = "1;3;5;7;11;13"

obEval.Param("MonCarre") = "a ^ 2 + 1"
obEval.Param("Pytagore") = "(a ^ 2) + ( b ^ 2)"

'------------------------------------------------------------------
obEval.Fonction("bidule") = "(a;b;c)|($a ^ 2 + $b * 2 + $c)"
obEval.Fonction("truc") = "(a;b;c)|round ($a ^ 2 + $b * 2 + sqr ($c) ;2)"
obEval.Fonction("mx") = "(a)|(Max([$a]))"
' obEval.Fonction("Delta") = "(a)|(Max([$a])- Min([$a]))"
obEval.Fonction("Delta") = "(a)|(Max($a)- Min($a))"
obEval.Fonction("MoyenneCorrigee") = "(a;b)|(moyenne($b) * $a)"
obEval.Fonction("InList") = "(a;b)|($a<Max($b)) && ($a>min($b))"
obEval.Fonction("EstDansliste") = "(a;b)|($a<Max($b)) && ($a>min($b))"
'------------------------------------------------------------------

lstCollection.ListIndex = 0

v = obEval.value ("-25 + 01 * 54 + 19 - 5")
v = obEval.value ("654 + 321")
v = obEval.value ("togodo + 321")
v = obEval.value ("10!+3*5")
v = obEval.value (" 2 * ( 3 + 4 )")
v = obEval.value (" 2 * (( 10-5) + (12 / 2) )")
v = obEval.value (" 2 * ( 3 + ((12 / 2) * {5+2}) )")
v = obEval.value ("2 * Int(400 / 3)")
v = obEval.value ("10 * @Int(100 / 3)")
v = obEval.value ("round(2,123456;2)")
v = obEval.value ("@int(3.14116)")
v = obEval.value ("nbEnr * Int(annee / trimestre)")
v = obEval.value ("nbEnr * Int( round(annee / trimestre; nbDecimal))")
v = obEval.value ("max(a ; b)")
v = obEval.value ("min(a ; b)")
v = obEval.value ("sqr(5)")
v = obEval.value ("somme_theosophique(123456789;1)")
v = obEval.value ("produit_theosophique(suite;1)")
v = obEval.value ("max(1;2;3;6;5;4)")
v = obEval.value ("Choose(get('a';2);2;5;4;6;8)")
v = obEval.value ("5!+8!")
v = obEval.value ("21 / 321 * 3221 - 32 + 343432 / 43243.5454 / 54354 * 345 / (543 - 45 / 43 + 343)")
v = obEval.value ("3 / 4 * 2")
v = obEval.value ("3 / (4 * 2)")
v = obEval.value ("5 + MonCarre")
v = obEval.value ("Sqr(Pytagore)")
v = obEval.value ("Pytagore ^ 2")
v = obEval.value ("4 ^ 2 + 5 * 2 + 6")
v = obEval.value ("bidule(4;5;6)")
v = obEval.value ("truc(4;5;6)")
v = obEval.value ("somme(4;5;6;7;8;9)")
v = obEval.value ("Delta(4;5;6;7;8;9)")
v = obEval.value ("let([a];45)")
v = obEval.value ("(let([a];45)^2)-(a/2)")
v = obEval.value ("(get(""a"";b)^2)-(a/2)")
v = obEval.value ("(get('a')^2)-(a/2)")
v = obEval.value ("45>=45")
v = obEval.value ("let('x';15)" & vbCrLf & "let('y';3)" & vbCrLf & "x * y")
v = obEval.value ("(45>=get('a';45))*(Pytagore+5!)/a+somme(choose(2;5;4;3;1);5;7)")
v = obEval.value ("MoyenneCorrigee(5;1;3;5;7)")
v = obEval.value ("truc(bidule(4;5;6);5; bidule(4;5;truc(9;9;9)))")
-----------------------------------------------------------------------------------------
Merci de vos commentaires

Source / Exemple :


'------------------------------------------------------------
'Cet exemple montre une utilisation du composant
'Il calcul l'hypotenuse d'un triangle rectangle pour une variation d'un des petit cote.
'Il y a d'autres exemples plus complexes dans le projets de test
'------------------------------------------------------------
Private Sub cmdEval_Click()
Dim obEval As clsEval
Dim h As Long
Dim tResultat() As String
Dim nbResultat As String
Dim Cote1 As Long
Dim v As Double
Dim Message As String

    On Error GoTo GestionErr
    '-------------------------------
    nbResultat = 20
    ReDim tResultat(0 To nbResultat)
    Cote1 = 10
    Set obEval = New clsEval
    obEval.Param("a") = Cote1
    obEval.Formule = "sqr((a^2)+(b^2))"
    '---------------------------------------
    For h = 1 To nbResultat
        obEval.Param("b") = h
        v = obEval.Value
        tResultat(h) = "a = " & Cote1 & " - " & "b = " & h & " - " & "Hypoténuse = " & Format$(v, "0.00")
      
    Next
    
    Set obEval = Nothing
    Message = Join(tResultat, vbCrLf)
    MsgBox Message
    
Exit Sub
'--------------------
GestionErr:
    MsgBox Err.Description
    Resume
End Sub
'**************************************************************

Codes Sources

A voir également

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.