Question

100分寻求用VB求解一元三次方程的源码

本人做一个课题，需要计算很多一元三次方程，所以想编程解决，但是一时无法下手，在此悬赏100分，希望高手不吝赐教，要求用VB6.0，源码必须经本人调试可用才能拿到分数。

Answer 1

看来是没人会啊，建议你自己查找相关资料，先用公式法或者迭代法做，然后自己编程序，用相应的算法吧，祝你好运，下面是个c语言的，希望对你有用
#include "Stdio.h"
#include "Conio.h"
#include "math.h"

main()
{
float a,b,c,d;
float x=0;
float result;
scanf("%f%f%f%f",&a,&b,&c,&d);

result=-(a*x*x*x+b*x*x+d)/c;

while(abs(result-x)>0.001)
{ x=result;
result=-(a*x*x*x+b*x*x+d)/c;
}
printf("A base:x=%f",result);
}

Answer 2

Sub SolveCubicEquations(ByVal CubicEquation As String, Optional ByVal x As String = "x", Optional ByRef result As String)
Dim a As Single, b As Single, c As Single, d As Single, temp As String, n As Byte
Dim f As Single, g As Single, h As Single, i As Single, j As Single, alpha As Single
CubicEquation = Replace(CubicEquation, " ", "")
result = Replace(CubicEquation, "-", "+-")
s = Split(Split(result, "=")(0), "+")
For n = 0 To UBound(s)
If s(n) Like "*" & x & "^3" Then temp = Trim(Split(s(n), x)(0)): a = IIf(temp = "-", -1, IIf(temp = "", 1, Val(temp)))
If s(n) Like "*" & x & "^2" Then temp = Trim(Split(s(n), x)(0)): b = IIf(temp = "-", -1, IIf(temp = "", 1, Val(temp)))
If s(n) Like "*" & x Then temp = Trim(Split(s(n), x)(0)): c = IIf(temp = "-", -1, IIf(temp = "", 0, Val(temp)))
If IsNumeric(s(n)) Then d = s(n)
Next
f = c / a - b * b / (3 * a * a)
g = 2 * b ^ 3 / (3 * a) ^ 3 - b * c / (3 * a * a) + d / a
h = g ^ 2 / 4 + f ^ 3 / 27
Select Case Sgn(h)
Case -1 'Roots Are Real
i = Sqr(g ^ 2 / 4 - h)
j = -g / (2 * i)
If j = 1 Then alpha = 0
If j <> 1 Then alpha = (Atn(-j / Sqr(1 - j ^ 2)) + 2 * Atn(1)) / 3
result = "Cubic Equations {" & CubicEquation & "} has 3 Real Roots:" & vbCrLf & String(50, "-")
result = result & vbCrLf & x & "1=" & Format(2 * i ^ (1 / 3) * Cos(alpha) - b / (3 * a), "0.0000")
result = result & vbCrLf & x & "2=" & Format(-i ^ (1 / 3) * (Cos(alpha) + (3 ^ 0.5) * Sin(alpha)) - b / (3 * a), "0.0000")
result = result & vbCrLf & x & "3=" & Format(-i ^ (1 / 3) * (Cos(alpha) - (3 ^ 0.5) * Sin(alpha)) - b / (3 * a), "0.0000")
Case 0 'All 3 Roots Are Real and Equal
result = "Cubic Equation {" & CubicEquation & "} has 3 Equal Real Roots:" & vbCrLf & String(50, "-")
result = result & vbCrLf & x & "1=" & Format(-(d / a) ^ (1 / 3), "0.0000")
result = result & vbCrLf & x & "2=" & Format(-(d / a) ^ (1 / 3), "0.0000")
result = result & vbCrLf & x & "3=" & Format(-(d / a) ^ (1 / 3), "0.0000")
Case 1 'Only 1 Root Is Real
i = (-g / 2 + h ^ 0.5) ^ (1 / 3)
j = -(g / 2 + h ^ 0.5) ^ (1 / 3)
result = "Cubic Equations {" & CubicEquation & "} has only 1 Real Roots:" & vbCrLf & String(50, "-")
result = result & vbCrLf & x & "1=" & Format(i + j - b / (3 * a), "0.0000")
result = result & vbCrLf & x & "2=" & Format(-(i + j) / 2 - b / (3 * a), "0.0000") & "+" & Format(Abs(i - j) * 3 ^ 0.5 / 2, "0.0000") & "*i"
result = result & vbCrLf & x & "3=" & Format(-(i + j) / 2 - b / (3 * a), "0.0000") & "-" & Format(Abs(i - j) * 3 ^ 0.5 / 2, "0.0000") & "*i"
End Select
result = Replace(result, "0.0000+", "")
result = Replace(result, "0.0000-", "")
result = Replace(result, "0.0000", 0)
result = Replace(result, ".0000", "")
result = result & vbCrLf
Debug.Print result

End Sub

Sub macro1()
SolveCubicEquations "2x^3-4x^2-22x+24=0"
SolveCubicEquations "x^3 + 6x^2 + 12x + 8 = 0"
SolveCubicEquations "y^3 + 7y -9 = 0", "y"
SolveCubicEquations "3z^3 + 5z = 0", "z"
SolveCubicEquations "-2x^3 + 8x^2 = 0", "x"
End Sub