[RESOLVED] Quadratic Formula

[yomama07024]

Hey guys. I am trying to make a program that will solve a quadratic equation.
How would I go about doing that?

[Code Doc]

Build a form with three text boxes for the coefficients and a command button to trigger the calculations:

Dim A As Single, B As Single, C As Single
Dim X1 As Single, X2 As Single

Private Sub Command1_Click()
A = Val(Text1.Text) ' First Coefficient on X squared
B = Val(Text2.Text) ' Second Coefficient on X
C = Val(Text3.Text) ' Constant Term
' Check for imaginary, equal, and unequal roots
If B ^ 2 - 4 * A * C < 0 Then
    MsgBox "Roots are imaginary."
ElseIf B ^ 2 - 4 * A * C = 0 Then
    X1 = (-B + Sqr(B ^ 2 - 4 * A * C)) / (2 * A)
    MsgBox "The two roots are " & Str$(X1) * " (equal)."
Else: X1 = (-B + Sqr(B ^ 2 - 4 * A * C)) / (2 * A)
    X2 = (-B - Sqr(B ^ 2 - 4 * A * C)) / (2 * A)
    MsgBox "The two roots are " & Str$(X1) & " and " & Str$(X2)
End If
End Sub

Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub

[03myersd]

I wrote this a long time ago. Not tried it since. Should be what you need though:

Private Sub Command1_Click()
Dim a As Variant
Dim b As Variant
Dim c As Variant
Dim x1pos As Integer
Dim x2pos As Integer
Dim xa As Variant
Dim xb As Variant

Dim formula As Variant

On Error GoTo Formulaerror

formula = Text6

x1pos = 0
x2pos = 4

Do
x1pos = x1pos + 1
Loop Until Mid(formula, x1pos, 1) = "x"

If x1pos > 1 Then
a = Left(formula, x1pos - 1)
Else
a = 1
End If

Do
x2pos = x2pos + 1
Loop Until Mid(formula, x2pos, 1) = "x"

If x2pos > 5 Then
b = Mid(formula, x1pos + 4, 1)
Else
b = 1
End If

c = Mid(formula, x2pos + 2)



xa = (-b + Sqr(((b * b) - (4 * a * c)))) / (2 * a)
xb = (-b - Sqr(((b * b) - (4 * a * c)))) / (2 * a)

Text4 = xa
Text5 = xb

Formulaerror:

MsgBox "Not a valid formula!", vbOKOnly, "Invalid": Text4.Text = "": Text5.Text = "": Text6.Text = ""

End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call Command1_Click
End Sub

[yomama07024]

Wow you guys are amazing. hey Code Doc how long did it take you to write that?

[03myersd]

Ill maybe point out that the entire forumla just needs to be put into a text box for mine to work. Its not perfect but still works....

[Code Doc]

Wow you guys are amazing. hey Code Doc how long did it take you to write that?

Well, your post and mine were about 30 minutes apart. I found it to be an interesting challenge, especially with the imaginary root filter. I suspect there might be a way of handling the imaginary roots, but VB tends to burp when it comes time to find the square root of -1.