Mon pc sait compter!

Commenter

Contenu du snippet

je sais, des sources similaires sont déjà présentes.
mais je voulais quand meme apporter ma contribution.
cette source est relativement simple à comprendre.
crée une form, un label nommé txt_expr, taper votre formule dedans et presser entré. le résultat s'affiche dans ce meme label.
exemple :
sqr(3*sin(2)^4+(2*cos(-1)+2!))
=2,26528310159094 pour mon prog
=2.26528310159 pour ma graph 65 ( en remplacant cos(2)^4 par: (cos(2))^2 car pour elle cos(2)^4=cos(2^4)
note : 2!=2, je l'ai mis juste pour montrer que factirielle est pris en charge.
/!\ : ne gère pas 1/0;sqr(-1)...
j'utilise err.raise lorsqu'il y a une erreur dans la formule.

Source / Exemple : 


Option Explicit
'notes :
'-ce programmes utilises les memes règles de prioritées que la graph 65.
'=5*-3 n'est valude ni dans ce programme, ni en math, mais 5*(-3) l'est.
'signe ² acepté
'les fonction qui porten un nom(sin,cos...) doivent obligatoirement etre suivient d'une parenthèse.
'
'Opérateur :
'([{}])
',(virgule)
'a+b addition
'a-b soustraction
'a*b multiplication
'a/b division
'-a opposé
'a^b puissance
'a! factorielle
'cos(a);sin(a);tan(a);atn(a)(inverse tangente);sqr(a)(racine carré)
'cos²(a)...
Private Sub txt_expr_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then 'Si on a fait entrée alors
        txt_expr.Text = valeur(txt_expr.Text) 'on calcul la valeur de ce qui a été tappé
        txt_expr.SelStart = Len(txt_expr.Text) 'on place le curseur a la fin du resultat
        KeyAscii = 0 'ca c'est pour éviter un 'BIP'
    End If
End Sub

Private Function valeur(nb As String) As Double
    Dim i As Integer 'pour les boucles
    Dim par As Integer 'niveau de parenthèse actuel
    Dim parjustifie As Boolean 'les parenthèse externes sont-elles justifiées ?
                               '"(2+3)*(5-3)" <> "2+3)*(5-3" donc oui
                               '"(2+7*5-8)" = "2+7*5-8" donc non
'mise aux normes
    nb = Replace(nb, ",", ".")
    'i = InStr(1, LCase(nb), pi)
    'if
    nb = Replace(nb, "²", "^2")
    nb = Replace(nb, "[", "(")
    nb = Replace(nb, "]", ")")
    nb = Replace(nb, "{", "(")
    nb = Replace(nb, "}", ")")
    nb = Replace(nb, ")(", ")*(")
    For i = 0 To 9
        nb = Replace(nb, ")" & CStr(i), ")*" & CStr(i))
    Next
    For i = Asc("a") To Asc("z")
        nb = Replace(nb, ")" & Chr(i), ")*" & Chr(i))
    Next
    For i = Asc("A") To Asc("Z")
        nb = Replace(nb, ")" & Chr(i), ")*" & Chr(i))
    Next
'vérification de la validité de nb
    For i = 1 To Len(nb)
        Select Case Mid(nb, i, 1)
        Case ")": par = par - 1 'on rentre dans une parenthèse
        Case "(": par = par + 1 'on sort d'une parenthèse
        End Select
        If par < 0 Then Call Err.Raise(1, , "parenthèse incorecte")
    Next
    For i = 1 To Len(nb)
        If InStr(1, "0123456789./*-+^!()", Mid(nb, i, 1)) = 0 And (Asc(UCase(Mid(nb, i, 1))) < Asc("A") Or Asc(UCase(Mid(nb, i, 1))) > Asc("Z")) Then Call Err.Raise(1, , "caractère inconu :" & Mid(nb, i, 1))
    Next
    If InStr(1, "/*-+^!", Left(nb, 1)) = 1 Then Call Err.Raise(1, , Mid(nb, i, 1) & " trouvé en première position")
    i = 0
    Do
        i = InStr(i + 1, nb, "(")
        If i > 0 Then If InStr(i + 1, "/*-+^!", Mid(nb, i + 1, 1)) = i + 1 Then Call Err.Raise(1, , Mid(nb, i, 1) & " trouvé juste après '('.")
    Loop While i > 0
    i = 0
    Do
        i = InStr(i + 1, nb, ")")
        If i > 0 Then If InStr(i + 1, "/*-+^!", Mid(nb, i - 1, 1)) = i - 1 Then Call Err.Raise(1, , Mid(nb, i, 1) & " trouvé juste avant ')'.")
    Loop While i > 0
    For i = 1 To Len(nb) - 1
        If InStr(1, "/*-+^", Mid(nb, i, 1)) <> 0 And InStr(1, "/*-+^!", Mid(nb, i + 1, 1)) Then Call Err.Raise(1, , "2 opérateur succésif trouvé(avec le premier différent de '!').")
    Next
'suppression des parenthèses externes inutiles
    parjustifie = False
    While Not parjustifie And Left(nb, 1) = "(" And Right(nb, 1) = ")" 'tant qu'il peut y avoir des parentèses externes injustifier
        For i = 2 To Len(nb)
            Select Case Mid(nb, i, 1)
            Case ")": par = par + 1 'on rentre dans une parenthèse
            Case "(": par = par - 1 'on sort d'une parenthèse
            End Select
            If par < 0 Then parjustifie = True 'si en ommetant la première parenthèse par=-1 alors les parenthèses externes sont indispenssables
        Next
        If Not parjustifie Then nb = Mid(nb, 2, Len(nb) - 2) 'si les parenthèses externes sont supperflue, on les supprimes
    Wend
    If IsNumeric(Replace(nb, ".", ",")) Then valeur = Val(nb): Exit Function ' si nb est un nombre...
    
    '+
    par = 0
    For i = Len(nb) To 2 Step -1
        Select Case Mid(nb, i, 1)
        Case ")": par = par + 1
        Case "(": par = par - 1
        End Select
        If par = 0 Then If Mid(nb, i, 1) = "+" Then valeur = valeur(Left(nb, i - 1)) + valeur(Mid(nb, i + 1)): Exit Function
    Next
    '-
    par = 0
    For i = Len(nb) To 2 Step -1
        Select Case Mid(nb, i, 1)
        Case ")": par = par + 1
        Case "(": par = par - 1
        End Select
        If par = 0 Then
            If Mid(nb, i, 1) = "-" Then
                If i > 1 Then
                    valeur = valeur(Left(nb, i - 1)) - valeur(Mid(nb, i + 1))
                Else
                    valeur = -valeur(Mid(nb, 2))
                End If
                Exit Function
            End If
        End If
    Next
    '*
    par = 0
    For i = Len(nb) To 2 Step -1
        Select Case Mid(nb, i, 1)
        Case ")": par = par + 1
        Case "(": par = par - 1
        End Select
        If par = 0 Then If Mid(nb, i, 1) = "*" Then valeur = valeur(Left(nb, i - 1)) * valeur(Mid(nb, i + 1)): Exit Function
    Next
    '/
    par = 0
    For i = Len(nb) To 2 Step -1
        Select Case Mid(nb, i, 1)
        Case ")": par = par + 1
        Case "(": par = par - 1
        End Select
        If par = 0 Then If Mid(nb, i, 1) = "/" Then valeur = valeur(Left(nb, i - 1)) / valeur(Mid(nb, i + 1)): Exit Function
    Next
    '^
    par = 0
    For i = Len(nb) To 2 Step -1
        Select Case Mid(nb, i, 1)
        Case ")": par = par + 1
        Case "(": par = par - 1
        End Select
        If par = 0 Then If Mid(nb, i, 1) = "^" Then valeur = valeur(Left(nb, i - 1)) ^ valeur(Mid(nb, i + 1)): Exit Function
    Next
    '!(factorielle) (n!=1*2*3*...*n)
    par = 0
    For i = Len(nb) To 2 Step -1
        Select Case Mid(nb, i, 1)
        Case ")": par = par + 1
        Case "(": par = par - 1
        End Select
        If par = 0 Then
            If Mid(nb, i, 1) = "!" Then
                If i = Len(nb) Then
                    valeur = factorielle(valeur(Left(nb, Len(nb) - 1))): Exit Function
                Else
                    valeur = factorielle(valeur(Left(nb, i - 1))) * valeur(Mid(nb, i + 1)): Exit Function
                End If
            End If
        End If
    Next
    If LCase(Left(nb, 4)) = "cos(" Then valeur = Cos(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 4)) = "sin(" Then valeur = Sin(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 4)) = "tan(" Then valeur = Tan(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 4)) = "atn(" Then valeur = Atn(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 4)) = "sqr(" Then valeur = Sqr(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 4)) = "log(" Then valeur = Log(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 4)) = "exp(" Then valeur = Exp(valeur(Mid(nb, 4))): Exit Function
    If LCase(Left(nb, 5)) = "cos²(" Then valeur = Cos(valeur(Mid(nb, 5))) ^ 2: Exit Function
    If LCase(Left(nb, 5)) = "sin²(" Then valeur = Sin(valeur(Mid(nb, 5))) ^ 2: Exit Function
    If LCase(Left(nb, 5)) = "tan²(" Then valeur = Tan(valeur(Mid(nb, 5))) ^ 2: Exit Function
    If LCase(Left(nb, 5)) = "atn²(" Then valeur = Atn(valeur(Mid(nb, 5))) ^ 2: Exit Function
    If LCase(Left(nb, 5)) = "sqr²(" Then valeur = Sqr(valeur(Mid(nb, 5))) ^ 2: Exit Function
    If LCase(Left(nb, 5)) = "log²(" Then valeur = Log(valeur(Mid(nb, 5))) ^ 2: Exit Function
    If LCase(Left(nb, 5)) = "exp²(" Then valeur = Exp(valeur(Mid(nb, 5))) ^ 2: Exit Function
    
    Call Err.Raise(1, , "erreur non gérée : Ce n'est pas un nombre et aucun opérateur valide n'a été trouvé.")
End Function
Private Function factorielle(nb As Integer)
    Dim i As Integer
    factorielle = 1
    For i = 2 To nb
        factorielle = factorielle * i
    Next
End Function

Conclusion :


je compte l'intégrer un un de mes autre programme(c++) qui permet de calculer avec une précision de 10000 chiffres!

note :
taper sqr(3*sin(2)^4+(2*cos(-1)+2!)) dans google et vous obtiendrez 2.2652831

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_dtom)