求解一元二次方程的程序vb

直接将代码复制到窗体中测试即可Private Sub Form_Load()

Dim a, b, c, x1, x2 As Single

Dim str As String

a = Val(InputBox("请输入一元二次方程的二次项系数"))

b = Val(InputBox("请输入一元二次方程的一次项系数"))

c = Val(InputBox("请输入一元二次方程的常数项"))

If a = 0 Then

If c <0 Then

str = b &"x" &c &"=0"

Else

str = b &"x+" &c &"=0"

End If

If MsgBox("你输入的方程为" &str &"，是否要求解?", vbOKCancel) = vbOK Then

If b = 0 Then

MsgBox "此方程无解！"

Else

x1 = -c / b

MsgBox "方程只有一个解,x=" &x1

End If

End If

Else

If b <0 Then

If c <0 Then

str = a &"x^2" &b &"x" &c &"=0"

Else

str = a &"x^2" &b &"x+" &c &"=0"

End If

Else

If c <0 Then

str = a &"x^2+" &b &"x" &c &"=0"

Else

str = a &"x^2+" &b &"x+" &c &"=0"

End If

End If

If MsgBox("你输入的方程为" &str &"，是否要求解?", vbOKCancel) = vbOK Then

If b ^ 2 - 4 * a * c <0 Then

MsgBox "方程" &str &"无解！"

Else

If b ^ 2 - 4 * a * c = 0 Then

x1 = (-b + Sqr(b ^ 2 - 4 * a * c)) / (2 * a)

MsgBox "方程" &str &"有两个相等的解,x1=" &x1 &",x2=" &x1

Else

x1 = (-b + Sqr(b ^ 2 - 4 * a * c)) / (2 * a)

x2 = (-b - Sqr(b ^ 2 - 4 * a * c)) / (2 * a)

MsgBox "方程" &str &"有两个不相等的解,x1=" &x1 &",x2=" &x2

End If

End If

End IfEnd If

End

End Sub

创建text1,text2,text3

dim a,b,c,x1,x2 '声明变量

val(text1.text)=a

val(text2.text)=b

val(text3.text)=c '给变量赋值

if b^2-4ac>=0 then

x1=(-b+sqr(b^2-4ac))/2a

x2=(-b-sqr(b^2-4ac))/2a '利用求根公式计算

print "方程的解为：" &x1 &"" &x2

else

print "方程没有实数解"

end if '判断并输出结果

Private Sub Command1_Click()

Dim a As Integer, b As Integer, c As Integer, d As Integer

a = Val(Text1.Text)

b = Val(Text2.Text)

c = Val(Text3.Text)

d = b * b - 4 * a * c

If d <0 Then

Label4.Caption = "此方程无解"

ElseIf d = 0 Then

Label4.Caption = "此方程有两个相等的根，x1=" &Str(-b / (2 * a))

'x=[-b]/2a

ElseIf d >0 Then

Label4.Caption = "此方程有两个不相等的根，x1=" &Str(Round((-b + Sqr(d)) / (2 * a), 0)) _

&" x2=" &Str(Round((-b - Sqr(d)) / (2 * a), 0))

End If

End Sub

张志晨

---