MON PC SAIT COMPTER!

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