Mon pc sait compter!

Soyez le premier à donner votre avis sur cette source.

Snippet vu 3 623 fois - Téléchargée 33 fois

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

Ajouter un commentaire Commentaires
OverDarck Messages postés 116 Date d'inscription jeudi 12 juillet 2001 Statut Membre Dernière intervention 23 juin 2005
11 nov. 2003 à 19:18
Impressionant !!! juste ski me fallai pr mon bot, il y a bien d'autre module de maths mais je doit dire aucuns ne fait tant de choses, au passage tu devrai rajouter la fonction ² (une astuce tu fait :
strreplace("²", "^2", cal) comme sa sa tevite de crée une fonction et sa fait pareil... , par contre comme je suis sur PHP la je sais pas si la vrai fonction de remplacement c bien strreplace....

Frenchement bravo
cs_ng Messages postés 31 Date d'inscription mardi 11 novembre 2003 Statut Membre Dernière intervention 28 juin 2005
11 nov. 2003 à 21:11
en vb il s'agit de Replace(sExpression,sCherche,sRemplace)
cs_max12 Messages postés 1491 Date d'inscription dimanche 19 novembre 2000 Statut Modérateur Dernière intervention 7 juillet 2014
12 nov. 2003 à 03:30
Il faudrais prendre en charge absolu || et [ ] Int sinon cé pas mal :) On vois qu'il y a eu du travail derrière sa.
etilegr Messages postés 70 Date d'inscription vendredi 22 février 2002 Statut Membre Dernière intervention 13 novembre 2003
13 nov. 2003 à 18:47
il manque pi
cs_dtom Messages postés 30 Date d'inscription mercredi 22 janvier 2003 Statut Membre Dernière intervention 16 novembre 2003
13 nov. 2003 à 20:04
pi=4*atn(1) ;-)
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)