到我的空间里面看看，有这方面的做法：QQ412495313
在VB中建立text1，text2，text3，text4和text5五个文本框和command1命令按钮。text1，text2，text3，text4为对应的a、b、c、d系数输入框，text5为方程解的输出框，command1按钮为操作按钮（先输入系数再计算）。在代码窗口中输入以下代码：
Private Function cubic(ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal d As Double) As String
Dim x1r As Double, x1i As Double, x2r As Double, x2i As Double, x3r As Double, x3i As Double
Dim ret As String
Dim J1 As String, J2 As String, J3 As String, J As String
hh = Chr(13) + Chr(10)
ret = CubicEquation(a, b, c, d, x1r, x1i, x2r, x2i, x3r, x3i)
If x1i = 0 Then
J1 = "X1=" & Format$(x1r, "#0.0###############") & ";" + hh
End If
If x1i > 0 Then
J1 = "X1=" & Format$(x1r, "#0.0###############") & " + " & Format$(x1i, "#0.0###############") & " i" & ";" + hh
End If
If x1i < 0 Then
J1 = "X1=" & Format$(x1r, "#0.0###############") & Format$(x1i, "#0.0###############") & " i" & ";" + hh
End If
If x2i = 0 Then
J2 = "X2=" & Format$(x2r, "#0.0###############") & ";" + hh
End If
If x2i > 0 Then
J2 = "X2=" & Format$(x2r, "#0.0###############") & " + " & Format$(x2i, "#0.0###############") & " i" & ";" + hh
End If
If x2i < 0 Then
J2 = "X2=" & Format$(x2r, "#0.0###############") & Format$(x2i, "#0.0###############") & " i" & ";" + hh
End If
If x3i = 0 Then
J3 = "X3=" & Format$(x3r, "#0.0###############") & ";" + hh
End If
If x3i > 0 Then
J3 = "X3=" & Format$(x3r, "#0.0###############") & " + " & Format$(x3i, "#0.0###############") & " i" & ";" + hh
End If
If x3i < 0 Then
J3 = "X3=" & Format$(x3r, "#0.0###############") & Format$(x3i, "#0.0###############") & " i" & ";" + hh
End If
J = J1 + J2 + J3
cubic = J
End Function
Private Function CubicEquation _
(ByVal a As Double, ByVal b As Double, ByVal c As Double, ByVal d As Double, _
x1r As Double, x1i As Double, x2r As Double, x2i As Double, x3r As Double, x3i As Double) As String
Dim e As Double, f As Double, g As Double, h As Double, delta As Double
Dim r As Double, sita As Double, pi As Double, rr As Double, ri As Double
If a = 0 Then
CubicEquation = "Not a cubic equation: a = 0"
Exit Function
End If
'pi = 3.14159265358979
pi = 4 * Atn(1)
b = b / a 'simplify to a=1: x^3+bx^2+cx+d=0
c = c / a
d = d / a
e = -b ^ 2 / 3 + c 'substitute x=y-b/3: y^3+ey+f=0
f = (2 * b ^ 2 - 9 * c) * b / 27 + d
If e = 0 And f = 0 Then
x1r = -b / 3
x2r = x1r
x3r = x1r
CubicEquation = "3 same real roots:"
ElseIf e = 0 Then 'need to deal with e = 0, or it will cause z = 0 later.
r = -f 'y^3+f=0, y^3=-f
r = Cur(r)
x1r = r - b / 3 'a real root
If r > 0 Then 'r never = 0 since g=f/2, f never = 0 there
sita = 2 * pi / 3
x2r = r * Cos(sita) - b / 3
x2i = r * Sin(sita)
Else
sita = pi / 3
x2r = -r * Cos(sita) - b / 3
x2i = -r * Sin(sita)
End If
x3r = x2r
x3i = -x2i
CubicEquation = "1 real root and 2 image roots:"
Else 'substitute y=z-e/3/z: (z^3)^2+fz^3-(e/3)^3=0, z^3=-g+sqr(delta)
g = f / 2 '-q-sqr(delta) is ignored
h = e / 3
delta = g ^ 2 + h ^ 3
If delta < 0 Then
r = Sqr(g ^ 2 - delta)
sita = Argument(-g, Sqr(-delta)) 'z^3=r(con(sita)+isin(sita))
r = Cur(r)
rr = r - h / r
sita = sita / 3 'z1=r(cos(sita)+isin(sita))
x1r = rr * Cos(sita) - b / 3 'y1=(r-h/r)cos(sita)+i(r+h/r)sin(sita), x1=y1-b/3
sita = sita + 2 * pi / 3 'no image part since r+h/r = 0
x2r = rr * Cos(sita) - b / 3
sita = sita + 2 * pi / 3
x3r = rr * Cos(sita) - b / 3
CubicEquation = "3 real roots:"
Else 'delta >= 0
r = -g + Sqr(delta)
r = Cur(r)
rr = r - h / r
ri = r + h / r
If ri = 0 Then
CubicEquation = "3 real roots:"
Else
CubicEquation = "1 real root and 2 image roots:"
End If
x1r = rr - b / 3 'a real root
If r > 0 Then 'r never = 0 since g=f/2, f never = 0 there
sita = 2 * pi / 3
x2r = rr * Cos(sita) - b / 3
x2i = ri * Sin(sita)
Else 'r < 0
sita = pi / 3
x2r = -rr * Cos(sita) - b / 3
x2i = -ri * Sin(sita)
End If
x3r = x2r
x3i = -x2i
End If
End If
End Function
Private Function Cur(v As Double) As Double
If v < 0 Then
Cur = -(-v) ^ (1 / 3)
Else
Cur = v ^ (1 / 3)
End If
End Function
Private Function Argument(a As Double, b As Double) As Double
Dim sita As Double, pi As Double
'pi = 3.14159265358979
pi = 4 * Atn(1)
If a = 0 Then
If b >= 0 Then
Argument = pi / 2
Else
Argument = -pi / 2
End If
Else
sita = Atn(Abs(b / a))
If a > 0 Then
If b >= 0 Then
Argument = sita
Else
Argument = -sita
End If
ElseIf a < 0 Then
If b >= 0 Then
Argument = pi - sita
Else
Argument = pi + sita
End If
End If
End If
End Function
Private Sub Command1_Click()
Dim a As Double, b As Double, c As Double, d As Double
Dim J As String, J1 As String, J2 As String, P As Double
Dim xr As Double, xi As Double
hh = Chr(13) + Chr(10)
a = Val(Text1.Text)
b = Val(Text2.Text)
c = Val(Text3.Text)
d = Val(Text4.Text)
If a <> 0 Then
Text5.Text = cubic(a, b, c, d)
End If
If a = 0 And b <> 0 Then
P = c ^ 2 - 4 * b * d
xr = -c / (2 * b)
Select Case P
Case Is = 0
x = xr
J = "X=" & Format$(x, "#0.0###############")
Text5.Text = J
Case Is > 0
xi = Sqr(Abs(P)) / (2 * b)
J1 = xr + Sqr(Abs(P)) / (2 * b)
J2 = xr - Sqr(Abs(P)) / (2 * b)
J = "X1=" & Format$(J1, "#0.0###############") & hh & "X2=" & Format$(J2, "#0.0###############")
Text5.Text = J
Case Is < 0
xi = Sqr(Abs(P)) / (2 * b)
J1 = "X1=" & Format$(xr, "#0.0###############") & "+" & Format$(xi, "#0.0###############") & "i;" + hh
J2 = "X2=" & Format$(xr, "#0.0###############") & "-" & Format$(xi, "#0.0###############") & "i;"
J = J1 + J2
Text5.Text = J
End Select
End If
If a = 0 And b = 0 And c <> 0 Then
x = d / c
J = "X=" & Format$(x, "#0.0###############")
Text5.Text = J
End If
If a = 0 And b = 0 And c = 0 Then
MsgBox "方程无意义，请重新输入！", , "温馨提示"
End If
End Sub
代码中有什么就补充什么。
如有command1 就加一个 按钮， 有 Text1 就加一个文本框，等等
内容全部来源于网络收集，如有侵权，请联系网站删除：QQ：24596024