如何用VB對(duì)”一元三次方程求根”問題進(jìn)行編程

針對(duì)方程"ax^3+bx^2+cx+d=0"的求根程序。

云城網(wǎng)站制作公司哪家好，找創(chuàng)新互聯(lián)！從網(wǎng)頁設(shè)計(jì)、網(wǎng)站建設(shè)、微信開發(fā)、APP開發(fā)、響應(yīng)式網(wǎng)站建設(shè)等網(wǎng)站項(xiàng)目制作，到程序開發(fā)，運(yùn)營維護(hù)。創(chuàng)新互聯(lián)從2013年開始到現(xiàn)在10年的時(shí)間，我們擁有了豐富的建站經(jīng)驗(yàn)和運(yùn)維經(jīng)驗(yàn)，來保證我們的工作的順利進(jìn)行。專注于網(wǎng)站建設(shè)就選創(chuàng)新互聯(lián)。

控件只需一個(gè)Command1，結(jié)果顯示在“立即”中。

代碼如下。（參考）

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

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("請(qǐng)輸入a", eq)

b = InputBox("請(qǐng)輸入b", eq)

c = InputBox("請(qǐng)輸入c", eq)

d = InputBox("請(qǐng)輸入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個(gè)根

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 四則運(yùn)算代碼

Dim s1!, s2!, a$ '為小數(shù)點(diǎn)的疊加，s1,s2必須定義為單精度型

Dim flag As Boolean 'flag它是過程及的變量，在通用里必須聲明

'在數(shù)字按鈕控件單擊數(shù)組單擊事件中獲取操作數(shù)（沒有區(qū)分是哪一個(gè)操作數(shù)）

Private Sub Command1_Click(Index As Integer)

x = Text1.Text

If flag = True Or x = "0" Then '查看數(shù)字是否輸入完畢或者是否清零了

Text1.Text = CStr(Index) 'CStr將數(shù)值轉(zhuǎn)換字符

Else

Text1.Text = Text1.Text + CStr(Index) '"+"在這里這個(gè)是對(duì)字符串的操作的疊加，CStr(Index)是接的數(shù)據(jù)

End If

flag = False '時(shí)刻準(zhǔn)備數(shù)字的輸入

End Sub

'2.單擊運(yùn)算符，確定s1，并且要選定運(yùn)算

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.刪除最后輸入的一個(gè)字符，換句話說，將本文框中的字符串取字符（從左往右取left(string,length)），將最后一個(gè)字符不取就先行

Private Sub Command5_Click()

If Text1.Text = "" Then

Else

Command5.Enabled = True

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

'len求字符串的長(zhǎng)度，left(text1.len(text1)-1減1是取字符串從左往右減去一個(gè)字符串

End If

End Sub

'小數(shù)點(diǎn) 1）顯示出"."(注意前面輸入過的整數(shù)必須顯示) 2）小數(shù)后能繼續(xù)接受數(shù)字的輸入

Private Sub Command6_Click()

Text1 = Text1 "."

End Sub

'7加入正負(fù)號(hào)--單擊“+、-”,產(chǎn)生一個(gè)"-"，而且處于一種等待數(shù)字輸入的一種狀態(tài)

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解方程

解一元一次方程：

設(shè)置4個(gè)文本框，分別代表一元一次方程中的參數(shù)k,b,x,y

分別命名txtk,txtb,txtx,txty.計(jì)算按鈕命名為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

計(jì)算時(shí)求x則在txtx那里輸入一個(gè)x，

求y則在txty那里輸入一個(gè)y，

在各文本框中輸入?yún)?shù)，

然后按下按鈕，

就有提示框彈出，顯示結(jié)果。

一元二次方程：

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"方程沒有實(shí)根"

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

一元三次方程：

針對(duì)方程"ax^3+bx^2+cx+d=0"的求根程序。

控件只需一個(gè)Command1，結(jié)果顯示在“立即”中。

代碼如下。（參考）

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

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("請(qǐng)輸入a", eq)

b = InputBox("請(qǐng)輸入b", eq)

c = InputBox("請(qǐng)輸入c", eq)

d = InputBox("請(qǐng)輸入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("輸入二次項(xiàng)系數(shù)"))

b = Val(InputBox("輸入一次項(xiàng)系數(shù)"))

c = Val(InputBox("輸入常數(shù)項(xiàng)"))

d = b ^ 2 - 4 * a * c

If d 0 Then

MsgBox "方程無解"

ElseIf d = 0 Then

x = -b / (2 * a)

MsgBox "方程有一個(gè)解：" x

Else

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

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

MsgBox "方程有兩個(gè)解：" 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為未知數(shù),a,a',a",b,b',b",c,c',c",d,d',d",為用戶輸入的數(shù)值

解N元一次方程，indat為N+1行、N列的數(shù)組，outdat為N個(gè)元素的數(shù)組

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的開方運(yùn)算

VB的運(yùn)算順序是：先乘除、后加減，有括號(hào)的先算括號(hào)內(nèi)，有負(fù)號(hào)的先算負(fù)號(hào)。

請(qǐng)你比較一下這個(gè)運(yùn)算中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)

這樣就會(huì)發(fā)現(xiàn)，你的代碼中括號(hào)的位置錯(cuò)了。

正確的應(yīng)該是： Math.Sqrt((n + 1) / n - 1)

用VB.NET編寫一個(gè)程序 ：編一求階乘的函數(shù)f(n),主調(diào)程序求組合數(shù)的程序，分別調(diào)用f(n),用來計(jì)算組合數(shù)的值

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