Correction programme vb équation 3 em degrés - VB/VBA/VBS - Programmation
Marsh Posté le 05-05-2007 à 19:54:41
malabar13 a écrit : pouvez vous me dire les fautes que jai faites pour ce programme en vb d'équation de troisième degrés: |
Tu n'as pas commenté ton code, et on est pas motivés pour suivre le raisonnement
ton programme est sensé résoudre l'équation ou donné un résultat pour une valeur précise ?
balancer du code comme ca c'est pas le plus judicieux.
Marsh Posté le 06-05-2007 à 00:55:10
il te sert à quoi ton a0 ? tu le calcule mais tu l'utilise nulle part
Marsh Posté le 06-05-2007 à 01:07:34
ca te va ?
Public Function Rac3(ByVal P3 As Double) As Double
Rac3 = Math.Pow(Math.Abs(P3), 1 / 3) * Math.Sign(P3)
End Function
Public Function RacineDegré3(ByVal a, ByVal b, ByVal c, ByVal d) As Collection
'Resolution d'une équation du troisieme degre
'a x^3 + b x^2 + c x + d = 0
Dim q, Dtrm As Double
Dim y, p, Cosinus, alpha As Double
RacineDegré3 = New Collection
y = -b / (3 * a)
p = c / a - b ^ 2 / (3 * a ^ 2)
q = b ^ 3 / (a ^ 3 * 13.5) + (d / a) - b * c / (3 * a ^ 2)
Dtrm = (q ^ 2 / 4) + (p ^ 3 / 27)
If Math.Abs(p) < 0.0000000001 Then p = 0
If Math.Abs(Dtrm) < 0.0000000001 Then Dtrm = 0
If (Dtrm < 0) Then ' Trois racines
If (p <> 0) Then Cosinus = (-q / 2) / Math.Sqrt(-p ^ 3 / 27)
If (Math.Abs(Cosinus) > 1) Then Cosinus = Math.Sign(Cosinus)
For k As Short = 0 To 2
RacineDegré3.Add(2 * Math.Sqrt(-p / 3) * Math.Cos((Math.Acos(Cosinus) + 2 * k * Pi) / 3) + y)
Next k
ElseIf Dtrm = 0 Then ' Deux racines
RacineDegré3.Add((-3 * q) / (2 * p) + y)
RacineDegré3.Add(3 * q / p + y)
Else ' une racine
RacineDegré3.Add(Rac3(-q / 2 + Math.Sqrt(Dtrm)) + Rac3(-q / 2 - Math.Sqrt(Dtrm)) + y)
End If
End Function
Marsh Posté le 05-05-2007 à 19:21:47
pouvez vous me dire les fautes que jai faites pour ce programme en vb d'équation de troisième degrés:
Option Explicit
Dim XX As Integer
Dim Fot As String
Private Sub cmdCalcul_Click()
Dim A, b, c, d, X3, X2, X1 As Double
Dim a0, a1, a2, a3, y, p, q, w, E, b1, u, s, u1, c1, u2, i As Double
Dim REP As String
A = Val(txtcoA.txt)
b = Val(txtcoB.txt)
c = Val(txtcoC.txt)
d = Val(txtcoD.txt)
If A = 0 Then
REP = vbCrLf & " Equation du second degrés"
Select Case b
Case 0
REP = vbCrLf & " Equation impossible"
lblREP.Caption = REP
Exit Sub
End Select
End If
a0 = A / A
a1 = b / A
a2 = c / A
a3 = d / A
y = X1 + (a3 / 3)
p = a2 - ((a1 * a1) / 3)
q = a3 - ((a1 * a2) / 3) + ((2 * a1 * a1) / 27)
b1 = a1 / 3
R = (q / 2) ^ 2 + (p / 3) ^ 3
If R < 0 Then
REP = REP & vbCrLf & " trois racines réelles"
lbl.Caption = REP
Exit Sub
End If
E = Tan(w) = (-2 * Sqr(-R)) / q
s = 2 * Sqr(-(p / 3))
u = w / 3
X1 = scos(u) - b1
X1 = Format(X1, "######,#####" )
X2 = scos(u + 120) - b1
X2 = Format(X2, "######,#####" )
X3 = scos(u + 240)
X3 = Format(X3, "######,#####" )
If R > 0 Then
REP = vbCrLf & "1 racine réelle et 2 complexes"
lblCaption = REP
Exit Sub
End If
u1 = spr((-q / 2) + Sqr(R)) ^ 3
i*i = -1
X1 = u1 - c1 - b1
X1 = Format(X1, "######,#####" )
X2 = (0.5 * (c1 - u1)) - (b1 + (0.5 * Sqr(3) * (u1 + c1)))i
X2 = Format(X2, "######,#####" )
X3 = im(X2)
X3 = Format(X3, "######,#####" )
If R = 0 Then
REP = vbCrLf & " 1 simple et une double ou bien une triple si q=p=0"
lbl.Caption = REP
Exit Sub
End If
V1 = -2 * u1
u2 = -Sqr(-(q / 2)) ^ 2
X1 = u1 - b1
X1 = Format(X1, "######,#####" )
X2 = X3 = u2 - b1
X2 = Format(X2, "######,#####" )
End If
With lblREP
.Caption = REP
.FontSize = 16
End With
End Sub
Private Sub cmdFin_Click()
End
End Sub
Private Sub cmdrefaire_Click()
txtcoA.Text = ""
txtcoB.Text = ""
txtcoC.Text = ""
txtcoD.Text = ""
lbl.Caption = ""
lbl.FOTCaption = ""
Fot = ""
XX = 0
txtcoA.SetFocus
End Sub
Private Sub txtcoA_keyPress(KeyAscii As Integer)
Dim A As Integer
A = KeyAscii
Select Case A
Case 48 To 57
Case 43, 45
If Len(txtcoA.Text) > 0 Then
GoSub Sottise
lblREP.Caption = lblREP.Caption & vbCrLf & _
" signe +/- incohérent ! "
End If
Case 46
If InStr(1, txtcoA.Text, "." ) <> 0 Then
GoSub Sottise
lblREP.Caption = lblREP.Caption & vbCrLf & _
" Point décimal incohérent! "
End If
Case Else
GoSub Sottise
lblREP.Caption = lblREP.Caption & vbCrLf & _
" 1 réel cohérent Merci ! "
End Select
Exit Sub
Sottise:
KeyAscii = 0
Fot = Fot & " X X"
lblFOT.Caption = Fot
XX = XX + 1
If XX > 5 Then
XX = 0
Fot = "X X"
lblREP.Caption = ""
End If
Return
End Sub
Private Sub txtcoB_keyPress(KeyAscii As Integer)
Dim A As Integer
A = KeyAscii
Select Case A
Case 48 To 57
Case 43, 45
If Len(txtcoB.Text) > 0 Then
GoSub Sottise
lblREP.Caption = lblREP.Caption & vbCrLf & _
" signe +/- incohérent ! "
End If
Case 46
If InStr(1, txtcoA.Text, "." ) <> 0 Then
GoSub Sottise
lblREP.Caption = lblREP.Caption & vbCrLf & _
" Point décimal incohérent! "
End If
Case Else
GoSub Sottise
lblREP.Caption = lblREP.Caption & vbCrLf & _
" 1 réel cohérent Merci ! "
End Select
Exit Sub
Sottise:
KeyAscii = 0
Fot = Fot & " X X"
lblFOT.Caption = Fot
XX = XX + 1
If XX > 5 Then
XX = 0
Fot = "X X"
lblREP.Caption = ""
End If
Return
End Sub
Private Sub txtcoC_keyPress(KeyAscii As Integer)
Dim A As Integer
A = KeyAscii
Select Case A
Case 48 To 57
Case 43, 45
If Len(txtcoC.Text) > 0 Then
GoSub Sottise
lblREP.Caption = lblREP.Caption & vbCrLf & _
" signe +/- incohérent ! "
End If
Case 46
If InStr(1, txtcoA.Text, "." ) <> 0 Then
GoSub Sottise
lblREP.Caption = lblREP.Caption & vbCrLf & _
" Point décimal incohérent! "
End If
Case Else
GoSub Sottise
lblREP.Caption = lblREP.Caption & vbCrLf & _
" 1 réel cohérent Merci ! "
End Select
Exit Sub
Sottise:
KeyAscii = 0
Fot = Fot & " X X"
lblFOT.Caption = Fot
XX = XX + 1
If XX > 5 Then
XX = 0
Fot = "X X"
lblREP.Caption = ""
End If
Return
End Sub
Private Sub txtcoD_keyPress(KeyAscii As Integer)
Dim A As Integer
A = KeyAscii
Select Case A
Case 48 To 57
Case 43, 45
If Len(txtcoD.Text) > 0 Then
GoSub Sottise
lblREP.Caption = lblREP.Caption & vbCrLf & _
" signe +/- incohérent ! "
End If
Case 46
If InStr(1, txtcoA.Text, "." ) <> 0 Then
GoSub Sottise
lblREP.Caption = lblREP.Caption & vbCrLf & _
" Point décimal incohérent! "
End If
Case Else
GoSub Sottise
lblREP.Caption = lblREP.Caption & vbCrLf & _
" 1 réel cohérent Merci ! "
End Select
Exit Sub
Sottise:
KeyAscii = 0
Fot = Fot & " X X"
lblFOT.Caption = Fot
XX = XX + 1
If XX > 5 Then
XX = 0
Fot = "X X"
lblREP.Caption = ""
End If
Return
End Sub