📄 方程求根.frm
字号:
VERSION 5.00
Begin VB.Form 方程求根
BackColor = &H0000FFFF&
Caption = "Form1"
ClientHeight = 8655
ClientLeft = 135
ClientTop = 405
ClientWidth = 12045
LinkTopic = "Form1"
ScaleHeight = 8655
ScaleWidth = 12045
StartUpPosition = 3 '窗口缺省
Begin VB.ListBox List3
Height = 240
Left = 3840
TabIndex = 9
Top = 8040
Width = 2652
End
Begin VB.ListBox List2
Height = 240
Left = 3840
TabIndex = 8
Top = 7620
Width = 2652
End
Begin VB.ListBox List1
Height = 240
Left = 3840
TabIndex = 7
Top = 7200
Width = 2652
End
Begin VB.CommandButton Command6
Caption = "退出"
Height = 612
Left = 360
TabIndex = 6
Top = 5760
Width = 1812
End
Begin VB.CommandButton Command5
Caption = "重新运行"
Height = 612
Left = 360
TabIndex = 5
Top = 4800
Width = 1812
End
Begin VB.CommandButton Command4
Caption = "弦截法"
Height = 612
Left = 360
TabIndex = 4
Top = 3840
Width = 1812
End
Begin VB.CommandButton Command3
Caption = "牛顿法"
Height = 612
Left = 360
TabIndex = 3
Top = 2880
Width = 1812
End
Begin VB.CommandButton Command2
Caption = "二分法"
Height = 612
Left = 360
TabIndex = 2
Top = 1920
Width = 1812
End
Begin VB.CommandButton Command1
Caption = "产生坐标系"
Height = 612
Left = 360
TabIndex = 1
Top = 960
Width = 1812
End
Begin VB.PictureBox Picture1
BackColor = &H0000C0C0&
Height = 6492
Left = 2640
ScaleHeight = 6435
ScaleWidth = 8355
TabIndex = 0
Top = 480
Width = 8412
End
Begin VB.Label Label3
Caption = "弦截法："
Height = 252
Left = 3000
TabIndex = 12
Top = 8040
Width = 732
End
Begin VB.Label Label2
Caption = "牛顿法："
Height = 252
Left = 3000
TabIndex = 11
Top = 7620
Width = 732
End
Begin VB.Label Label1
Caption = "二分法："
Height = 252
Left = 3000
TabIndex = 10
Top = 7200
Width = 732
End
End
Attribute VB_Name = "方程求根"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Command1.Enabled = False
Call zuobiao
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
End Sub
Private Function zuobiao()
Picture1.DrawWidth = 2
Picture1.ScaleMode = 6
Picture1.Line (8, 8)-(8, 120), vbRed
Picture1.Line (8, 90)-(140, 90), vbRed
Picture1.Line (7, 11)-(8, 8), vbRed
Picture1.Line (9, 11)-(8, 8), vbRed
Picture1.Line (138, 89)-(140, 90), vbRed
Picture1.Line (138, 91)-(140, 90), vbRed
Picture1.ForeColor = vbRed
Picture1.FontBold = True
Picture1.FontSize = 18
Picture1.CurrentX = 3: Picture1.CurrentY = 6
Picture1.Print "Y"
Picture1.CurrentX = 3: Picture1.CurrentY = 90
Picture1.Print "O"
Picture1.CurrentX = 138: Picture1.CurrentY = 92
Picture1.Print "X"
End Function
Private Sub Command2_Click()
Command2.Enabled = False
Call erfen
End Sub
Private Sub Command3_Click()
Command3.Enabled = False
Call newton
End Sub
Private Sub Command4_Click()
Command4.Enabled = False
Call xuanjie
End Sub
Private Sub Command5_Click()
Picture1.Cls
Command1.Enabled = True
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
Command6.Enabled = True
End Sub
Private Sub Command6_Click()
方程求根.Hide
Form1.Show
End Sub
Public Function f(ByVal x As Double) As Double
f = x - 2 * Sin(x)
End Function
Public Function erfen()
Dim a#, b#, e#, y0#, x#, Y#
a = InputBox("输入区间a的值", "二分法", 3)
b = InputBox("输入区间b的值", "二分法", 0)
e = InputBox("输入e的值", "二分法", 0.0001)
y0 = f(a)
For x = 0 To 3 Step 0.001
Picture1.Line (x * 45 + 8, 90 - f(x) * 30)-((x + 0.01) * 45 + 8, 90 - f(x + 0.01) * 30), QBColor(7)
Next
Do
x = (a + b) / 2: Y = f(x)
Picture1.Line (x * 45 + 8, 90)-(x * 45 + 8, 90 - Y * 30), QBColor(3)
Call delay(150)
If (Y * y0 > 0) Then
a = x
End If
If (Y * y0 <= 0) Then
b = x
End If
Loop While (Abs(b - a) >= e)
List1.AddItem (x)
End Function
Public Function newton()
Dim x0#, n%, e#, k%, x1#, x#
x0 = InputBox("请输入x0", "牛顿法", 3)
n = InputBox("请输入N", "牛顿法", 10)
e = InputBox("请输入e", "牛顿法", 0.0001)
k = 1
For x = 0 To 3 Step 0.001
Picture1.Line (x * 45 + 8, 90 - f(x) * 30)-((x + 0.01) * 45 + 8, 90 - f(x + 0.01) * 30), QBColor(8)
Next
q:
If (1 - 2 * Cos(x0) <> 0) Then
x1 = x0 - f(x0) / (1 - 2 * Cos(x0))
Picture1.Line (x1 * 45 + 8, 90)-(x1 * 45 + 8, 90 - f(x1) * 30), QBColor(13)
Call delay(150)
If (Abs(x1 - x0) >= e) Then
If k <> n Then
k = k + 1: x0 = x1
GoTo q
Else
MsgBox "迭代失败!"
End If
Else
List2.AddItem (x1)
End If
Else
MsgBox "x0即是方程的解"
End If
End Function
Public Function xuanjie()
Dim x0#, n%, e#, k%, x1#, x2#
x0 = InputBox("请输入x0", "弦截法", 1)
x1 = InputBox("请输入x0", "弦截法", 3)
n = InputBox("请输入N", "弦截法", 10)
e = InputBox("请输入e", "弦截法", 0.0001)
k = 1
For x = 0 To 3 Step 0.001
Picture1.Line (x * 45 + 8, 90 - f(x) * 30)-((x + 0.01) * 45 + 8, 90 - f(x + 0.01) * 30), QBColor(11)
Next
q:
x2 = x1 - f(x1) * (x1 - x0) / (f(x1) - f(x0))
Picture1.Line (x2 * 45 + 8, 90)-(x2 * 45 + 8, 90 - f(x2) * 30), QBColor(14)
Call delay(150)
If (Abs(x2 - x1) >= e) Then
If (k <> n) Then
k = k + 1: x0 = x1: x1 = x2
GoTo q
Else
MsgBox "迭代失败!"
End If
Else
List3.AddItem (x2)
End If
End Function
Private Sub form_load()
Form1.Left = 200
Form1.Top = 250
End Sub
Public Function delay(ByVal m As Integer)
Dim i%, j%
For i = 0 To 9999
For j = 0 To m
Next
Next
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -