风花飘飘 发表于 2013-4-10 17:03 static/image/common/back.gif
楼主可考虑了这个公式在
(m^2-(4a^2-12b)^3) 小于零的时候，该如何考虑这个公式？
譬如
x^3+x^2-0.05=0 时候?
这时，有3个实根。
代码如下：
Private Sub Command1_Click()
Dim a1, b1, c1, k
k = Text1.Text
a1 = Text2.Text
b1 = Text3.Text
c1 = Text7.Text
Print " "; "鲍丰武原理 王彦会程序设计"
Print " "; "免费试用 贩卖必究"; " "; "WB2.9试用版"
Print " "; "编制于2013年3月28日"
If k = "" Or k = "Text1" Then
Text4.Text = "a不能为空或为0"
Else
a = Val(a1) / Val(k)
b = Val(b1) / Val(k)
c = Val(c1) / Val(k)
If c = 0 Then
Text4.Text = "a d 不能为 0"
Text5.Text = "a 或d 为 0可能已不是1元3次方程"
Else
m = 36 * Val(a) * Val(b) - 8 * Val(a) ^ 3 - 108 * Val(c)
n1 = Val(m) ^ 2 + (12 * Val(b) - 4 * Val(a) ^ 2) ^ 3
If n1 < 0 Then
n2 = Sqr(Abs(n1))
Else
n2 = Sqr(Val(n1))
End If
If n1 < 0 And m < 0 Then
jq = (Sqr(Val(m) ^ 2 + Val(n2) ^ 2)) ^ (1 / 3)
jq1 = Atn(Val(n2) / Val(m))
q = -Val(jq) * Cos(Val(jq1) / 3)
p = q
Else
If n1 < 0 And m > 0 Then
jq = (Sqr(Val(m) ^ 2 + Val(n2) ^ 2)) ^ (1 / 3)
jq1 = Atn(Val(n2) / Val(m))
q = Val(jq) * Cos(Val(jq1) / 3)
p = q
Else
If Val(m) + Val(n2) < 0 Then
p = -(Abs(Val(m) + Val(n2))) ^ (1 / 3)
Else
p = (Val(m) + Val(n2)) ^ (1 / 3)
End If
If Val(m) < Val(n2) Then
q = -(Val(n2) - Val(m)) ^ (1 / 3)
Else
q = (Val(m) - Val(n2)) ^ (1 / 3)
End If
End If
End If
If a = 0 And b = 0 Then
Text4.Text = (Val(p) + Val(q) - 2 * Val(a)) / 6
Text5.Text = -(Val(p) + Val(q) + 4 * Val(a)) / 12 & "+" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i"
Text6.Text = -(Val(p) + Val(q) + 4 * Val(a)) / 12 & "-" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i"
Else
d = (Val(p) + Val(q) - 2 * Val(a)) / 6
jb = Val(a) + Val(d)
jc = Val(b) + Val(d) * (Val(a) + Val(d))
jd = Val(jb) ^ 2 - 4 * Val(jc)
If Val(n1) <= 0 And Val(jd) >= 0 Then
Text4.Text = d
Text5.Text = -Val(jb) / 2 + Sqr(Val(jd)) / 2
Text6.Text = -Val(jb) / 2 - Sqr(Val(jd)) / 2
Else
If Val(n1) > 0 And Val(jd) < 0 Then
Text4.Text = d
Text5.Text = -Val(jb) / 2 & "+" & Sqr(Abs(jd)) / 2 & "i"
Text6.Text = -Val(jb) / 2 & "-" & Sqr(Abs(jd)) / 2 & "i"
Else
If Val(n1) > 0 Then
Text4.Text = (Val(p) + Val(q) - 2 * Val(a)) / 6
Text5.Text = -(Val(p) + Val(q) + 4 * Val(a)) / 12 & "+" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i数据太大有误差"
Text6.Text = -(Val(p) + Val(q) + 4 * Val(a)) / 12 & "-" & Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "i可选大数据高精度的"
Else
Text4.Text = (Val(p) + Val(q) - 2 * Val(a)) / 6
Text5.Text = -(Val(p) + Val(q) + 4 * Val(a)) / 12 + Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "参考值可另选高精度的"
Text6.Text = -(Val(p) + Val(q) + 4 * Val(a)) / 12 - Abs((3 ^ (1 / 2) * (Val(p) - Val(q)))) / 12 & "或可x2,3的和/2为实部,差/2为虚部"
End If
End If
End If
End If
End If
End If
End Sub
Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Form1.Cls
End Sub
本帖最后由 风花飘飘 于 2013-5-31 01:24 编辑
这个程序不是免费试用的，收一枚金币，呵呵。。。
楼上的这个东东比较实用！
本帖最后由 风花飘飘 于 2022-7-10 18:42 编辑