如何用VB对”一元三次方程求根”问题进行编程

针对方程"ax^3+bx^2+cx+d=0"的求根程序。

云城网站制作公司哪家好，找创新互联！从网页设计、网站建设、微信开发、APP开发、响应式网站建设等网站项目制作，到程序开发，运营维护。创新互联从2013年开始到现在10年的时间，我们拥有了丰富的建站经验和运维经验，来保证我们的工作的顺利进行。专注于网站建设就选创新互联。

控件只需一个Command1，结果显示在“立即”中。

代码如下。（参考）

========================

Private Sub Command1_Click()

Dim x1r As Double, x1i As Double, x2r As Double, x2i As Double, x3r As Double, x3i As Double

Dim ret As String

Const eq = "ax^3+bx^2+cx+d=0"

a = InputBox("请输入a", eq)

b = InputBox("请输入b", eq)

c = InputBox("请输入c", eq)

d = InputBox("请输入d", eq)

ret = CubicEquation(a, b, c, d, x1r, x1i, x2r, x2i, x3r, x3i) '5x^3+4x^2+3x-12=0

Debug.Print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" ret

Debug.Print x1r; " + "; x1i; " i"

Debug.Print x2r; " + "; x2i; " i"

Debug.Print x3r; " + "; x3i; " i"

End Sub

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

'Cubic equation(v2.2), coded by btef (please let this line remain)

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

VB.NET 求一元二次方程的程序

(-b+(b^2-4ac))/(2a) (-b+(b^2-4ac))/(2a) 是2个根

Delta = b * b - 4 * a * c '求得b*b-4*a*c并存放在变量Delta中

If Delta = 0 Then '如果Delta的值为0

Re = -b / (2 * a)

b * b - 4 * a * c＝b^2-4ac=0

-b/(2a)是唯一解

vb.net 四则运算代码

Dim s1!, s2!, a$ '为小数点的叠加，s1,s2必须定义为单精度型

Dim flag As Boolean 'flag它是过程及的变量，在通用里必须声明

'在数字按钮控件单击数组单击事件中获取操作数（没有区分是哪一个操作数）

Private Sub Command1_Click(Index As Integer)

x = Text1.Text

If flag = True Or x = "0" Then '查看数字是否输入完毕或者是否清零了

Text1.Text = CStr(Index) 'CStr将数值转换字符

Else

Text1.Text = Text1.Text + CStr(Index) '"+"在这里这个是对字符串的操作的叠加，CStr(Index)是接的数据

End If

flag = False '时刻准备数字的输入

End Sub

'2.单击运算符，确定s1，并且要选定运算

Private Sub Command2_Click(Index As Integer)

flag = True

s1 = Val(Text1.Text)

Select Case Index

Case 0

a = "+"

Case 1

a = "-"

Case 2

a = "*"

Case 3

a = "/"

End Select

End Sub

'3."="的单击事件

Private Sub Command3_Click()

flag = True

s2 = Val(Text1.Text)

Select Case a

Case "+"

Text1.Text = s1 + s2

Case "-"

Text1.Text = s1 - s2

Case "*"

Text1.Text = s1 * s2

Case "/"

Text1.Text = s1 / s2 '分母不能为0

End Select

s1 = 0: s2 = 0: a = ""

End Sub

'4.清屏

Private Sub Command4_Click()

Text1.Text = "0"

s1 = 0

s2 = 0

a = ""

flag = False

End Sub

'5.删除最后输入的一个字符，换句话说，将本文框中的字符串取字符（从左往右取left(string,length)），将最后一个字符不取就先行

Private Sub Command5_Click()

If Text1.Text = "" Then

Else

Command5.Enabled = True

Text1.Text = Left(Text1.Text, Len(Text1.Text) - 1)

'len求字符串的长度，left(text1.len(text1)-1减1是取字符串从左往右减去一个字符串

End If

End Sub

'小数点 1）显示出"."(注意前面输入过的整数必须显示) 2）小数后能继续接受数字的输入

Private Sub Command6_Click()

Text1 = Text1 "."

End Sub

'7加入正负号--单击“+、-”,产生一个"-"，而且处于一种等待数字输入的一种状态

Private Sub Command7_Click()

Dim temp As Double

temp = -Val(Text1.Text)

Text1.Text = temp

If d = " " Then s1 = temp Else s2 = temp

End Sub

Private Sub Command8_Click() '退出

End

End Sub

Private Sub Form_Load() '窗体初始化

Text1.Text = 0

Text1.Locked = True

End Sub

VB解方程

解一元一次方程：

设置4个文本框，分别代表一元一次方程中的参数k,b,x,y

分别命名txtk,txtb,txtx,txty.计算按钮命名为cmdCalc。

在代码窗口里粘贴如下代码:

Private Sub cmdCalc_Click()

Dim k, b As Long

k = txtk.Text

b = txtb.Text

If txtx.Text = "x" Then

MsgBox "x的值为:" (txty.Text - b) / k

ElseIf txty.Text = "y" Then

MsgBox "y的值为:" k * txtx.Text + b

End If

End Sub

计算时求x则在txtx那里输入一个x，

求y则在txty那里输入一个y，

在各文本框中输入参数，

然后按下按钮，

就有提示框弹出，显示结果。

一元二次方程：

privat sub command1_click()

dim a,b,c,x1,x2,d as sigle

a=val(textl.text)

b=val(text2.text)

c=val(text3.text)

d=b^2-4*a*c

if d0 then

x1=(-b+sqr(d))/(2*a)

x2=(-b-sqr(d))/(2*a)

else if d=0 then

x1=(-b/2*a)

x2=x1

else msgbox"方程没有实根"

end if

text4.text="x1=" x1 "" "x2=" x2

end sub

sub min(byref a() as integer)

dim i,j as interger

for i=1 to 9

for j=i+1 to 10

if a a(i)a(j) then

t=a(j)

a(i)=a(j)

a(j)=t

end if

next

next

end sub

private sub command_(click)

dim b(1 to 10) as interger

dim a(1 to 10) as interger

randomize

for i=1 to 10

a(i)=int(rnd*90)+10

list1.additem a(i)

b(i)=int(rnd*90)+ 10

list2.additem b(i)

next

call min(a)

call min(b)

if a(1)b(1) then

m=a(1)

else

m=b(1)

end if

text1.text="A,B种的最小值：" vbcrlf m

end sub

一元三次方程：

针对方程"ax^3+bx^2+cx+d=0"的求根程序。

控件只需一个Command1，结果显示在“立即”中。

代码如下。（参考）

========================

Private Sub Command1_Click()

Dim x1r As Double, x1i As Double, x2r As Double, x2i As Double, x3r As Double, x3i As Double

Dim ret As String

Const eq = "ax^3+bx^2+cx+d=0"

a = InputBox("请输入a", eq)

b = InputBox("请输入b", eq)

c = InputBox("请输入c", eq)

d = InputBox("请输入d", eq)

ret = CubicEquation(a, b, c, d, x1r, x1i, x2r, x2i, x3r, x3i) '5x^3+4x^2+3x-12=0

Debug.Print "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" ret

Debug.Print x1r; " + "; x1i; " i"

Debug.Print x2r; " + "; x2i; " i"

Debug.Print x3r; " + "; x3i; " i"

End Sub

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

'Cubic equation(v2.2), coded by btef (please let this line remain)

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

二元一次方程：

Dim a, b, c As Integer

Dim x, y As Single

Dim d As Double

a = Val(InputBox("输入二次项系数"))

b = Val(InputBox("输入一次项系数"))

c = Val(InputBox("输入常数项"))

d = b ^ 2 - 4 * a * c

If d 0 Then

MsgBox "方程无解"

ElseIf d = 0 Then

x = -b / (2 * a)

MsgBox "方程有一个解：" x

Else

x = (-b + Sqr(d)) / (2 * a)

y = (-b - Sqr(d)) / (2 * a)

MsgBox "方程有两个解：" x "和" y

End If

三元一次方程：

方程组如下,

ax+by+cz=d

a'x+b'y+c'z=d'

a"x+b"y+c"z=d"

其中x,y,z为未知数,a,a',a",b,b',b",c,c',c",d,d',d",为用户输入的数值

解N元一次方程，indat为N+1行、N列的数组，outdat为N个元素的数组

Public Sub 解方程(ByRef InDat() As Double, ByVal InDatCount As Long, ByRef OutDat() As Double, ByRef OutDatCount As Long)

Dim Xt() As Double

Dim Dt As Double

Dim Ss As Long

Dim OtSCount As Long

Dim XtOut() As Double

If InDatCount 1 Then

ReDim Xt(1 To InDatCount - 1, 1 To InDatCount) As Double

For j = 1 To InDatCount - 1 '行

For i = 2 To InDatCount + 1 '列

Xt(j, i - 1) = InDat(j, i) * InDat(InDatCount, 1) / InDat(1, 1) - InDat(InDatCount, i)

Next i

Next j

OtSCount = 0

解方程 Xt, InDatCount - 1, XtOut, OtSCount

Dt = 0

For i = 1 To InDatCount - 1

Dt = Dt + InDat(InDatCount, i + 1) * XtOut(i)

Next i

Dt = Dt + InDat(InDatCount, i + 1)

ReDim Preserve OutDat(1 To 1 + OtSCount) As Double

OutDat(1) = -Dt / InDat(InDatCount, 1)

For i = 2 To OtSCount + 1

OutDat(i) = XtOut(i - 1)

Next i

OutDatCount = 1 + OtSCount

Else

ReDim OutDat(1 To 1) As Double

If InDat(1, 1) 0 Then

OutDat(1) = -InDat(1, 2) / InDat(1, 1)

Else

OutDat(1) = 0

End If

OutDatCount = 1

End If

End Sub

VB.net的开方运算

VB的运算顺序是：先乘除、后加减，有括号的先算括号内，有负号的先算负号。

请你比较一下这个运算中x和y的值：

Dim n As Single = 4

Dim x As Single

Dim y As Single

x = n + 1

x = x / n

x = x - 1

x = Math.Sqrt(x)

y = Math.Sqrt((n + 1) / n - 1)

这样就会发现，你的代码中括号的位置错了。

正确的应该是： Math.Sqrt((n + 1) / n - 1)

用VB.NET编写一个程序 ：编一求阶乘的函数f(n),主调程序求组合数的程序，分别调用f(n),用来计算组合数的值

Private Sub Command1_Click()

Dim A, B, C

A = 10

B = 3

C = f(A) / (f(B) * f(A - B))

Print C

End Sub

Private Function f(n)

Dim I As Integer

f = 1

For I = 1 To n

f = f * I

Next I

End Function

当前标题：关于vb.net解方程式的信息
分享地址：http://myzitong.com/article/hogdos.html