Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1649 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Correction programme vb équation 3 em degrés

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Correction programme vb équation 3 em degrés

n°1555817
malabar13
Posté le 05-05-2007 à 19:21:47  profilanswer
 

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

mood
Publicité
Posté le 05-05-2007 à 19:21:47  profilanswer
 

n°1555822
jpcheck
Pioupiou
Posté le 05-05-2007 à 19:54:41  profilanswer
 

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 :o
 
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.

n°1555904
ingenieurc​esi
Posté le 06-05-2007 à 00:55:10  profilanswer
 

il te sert à quoi ton a0 ? tu le calcule mais tu l'utilise nulle part

n°1555906
ingenieurc​esi
Posté le 06-05-2007 à 01:07:34  profilanswer
 

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


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Correction programme vb équation 3 em degrés

 

Sujets relatifs
[C] petit programme qui fonctionne pas.....Vérifier la présence d'un programme local
[Python] Packager un programmeprogramme qui se déclenche automatiquement
Besoin d'aide pour ce programmeréouvrir son programme une fois qu'il est lancé...
Créer un batch pour redémarrer un programme [résolu]Correction d'une requete SQL Delete....
arret du programme sur touche entreeWrapping Programme C++/Qt4 vers Python/Qt4
Plus de sujets relatifs à : Correction programme vb équation 3 em degrés


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR