EQUATIONS DU TROISIÈME DEGRÉ

Private Sub Command1_Click()
Dim PI As Double
PI = 4 * Atn(1)
Dim w As Variant

Dim e As Double
Dim f As Double
Dim g As Double
Dim p As Double
Dim q As Double
Dim k As Double
Dim x As Double
Dim t As Double
Dim s1 As Double
Dim s2 As Double
Dim s3 As Double
Dim s4 As Double
Dim s5 As Double
Dim s6 As Double

Dim a, b, c, d As Double


a = Val(Text1.Text)
b = Val(Text2.Text)
c = Val(Text3.Text)
d = Val(Text4.Text)

'On Error Resume Next ... supprimé car s'il y a une erreur il vaud mieux le savoir et la traiter... surtout en maths!

If a = 0 Then w = MsgBox("C'est une équation du second degré!!.", vbCritical, "Trop facile!"): Exit Sub

e = b / (3 * a)
f = c / a
g = d / a
p = f - 3 * e * e
q = 2 * e * e * e - e * f + g
k = 4 * p * p * p / 27 + q * q

If Abs(k) < 0.000000001 Then k = 0 'à cause des erreurs machine, arrondi ..etc...

If k < 0 Then
   x = 3 * q / (2 * p) * Sqr(-3 / p)
   t = (Atn(-x / Sqr(-x * x + 1)) + PI / 2) / 3
   s1 = Sqr(-4 * p / 3) * Cos(t) - e
   s2 = Sqr(-4 * p / 3) * Cos(t + 2 * PI / 3) - e
   s3 = Sqr(-4 * p / 3) * Cos(t + 4 * PI / 3) - e
   Text5.Text = " Les trois solutions sont : " & s1 & " et " & s2 & " et " & s3
ElseIf k = 0 Then
   s4 = -e - Rqbik(4 * q)
   s5 = -e + Rqbik(q / 2)
   Text5.Text = " Les deux solutions sont : " & s4 & " et " & s5
Else
   s6 = -e + Rqbik(((Sqr(k) - q) / 2)) - Rqbik(((Sqr(k) + q) / 2))
   Text5.Text = " La solution est : " & s6
End If
End Sub

Télécharger le zip

02 février 2008 09:03:05 :

modifications du code de Abdelelansari pour tenir compte du fait que VB ne veut pas de nombres négatifs dans le calcul des racines impaires (fonction Rqbik) debuggage pour le cas où k=0 voir ligne If Abs(k) < 0.000000001 Then k = 0 Suppression de parenthèses inutiles.