📄 shiyan1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Appearance = 0 'Flat
BackColor = &H00C0C000&
Caption = "Form1"
ClientHeight = 3108
ClientLeft = 60
ClientTop = 432
ClientWidth = 4680
FillColor = &H00FF8080&
FillStyle = 2 'Horizontal Line
BeginProperty Font
Name = "幼圆"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0080FF80&
LinkTopic = "Form1"
ScaleHeight = 3108
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.PictureBox pc1
BackColor = &H00C0FFFF&
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 6012
Left = 1920
ScaleHeight = 5964
ScaleWidth = 8964
TabIndex = 6
Top = 240
Width = 9012
End
Begin VB.CommandButton C6
BackColor = &H0080FFFF&
Caption = "退出"
Height = 495
Left = 480
Style = 1 'Graphical
TabIndex = 5
Top = 5400
Width = 1215
End
Begin VB.CommandButton C5
BackColor = &H0080FFFF&
Caption = "样条"
Height = 495
Left = 480
Style = 1 'Graphical
TabIndex = 4
Top = 4440
Width = 1215
End
Begin VB.CommandButton C4
BackColor = &H0080FFFF&
Caption = "牛顿"
Height = 495
Left = 480
Style = 1 'Graphical
TabIndex = 3
Top = 3240
Width = 1215
End
Begin VB.CommandButton C3
BackColor = &H0080FFFF&
Caption = "拉格朗日"
Height = 495
Left = 480
Style = 1 'Graphical
TabIndex = 2
Top = 2280
Width = 1215
End
Begin VB.CommandButton C2
BackColor = &H0080FFFF&
Caption = "重新运行"
Height = 495
Left = 480
Style = 1 'Graphical
TabIndex = 1
Top = 1440
Width = 1215
End
Begin VB.CommandButton C1
Appearance = 0 'Flat
BackColor = &H0080FFFF&
Caption = "随机生成点"
Height = 495
Left = 480
MaskColor = &H00FF80FF&
Style = 1 'Graphical
TabIndex = 0
Top = 480
UseMaskColor = -1 'True
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim m As Integer, flag As Integer, cx As Integer, cy As Integer
Dim a(10) As Integer, b(10) As Integer
Private Function zuobiao()
pc1.DrawWidth = 2
pc1.ScaleMode = 6
pc1.Line (8, 8)-(8, 80), vbRed
pc1.Line (8, 80)-(140, 80), vbRed
pc1.Line (7, 11)-(8, 8), vbRed
pc1.Line (9, 11)-(8, 8), vbRed
pc1.Line (138, 79)-(140, 80), vbRed
pc1.Line (138, 81)-(140, 80), vbRed
pc1.ForeColor = vbRed
pc1.FontBold = True
pc1.FontSize = 18
pc1.CurrentX = 3: pc1.CurrentY = 6
pc1.Print "Y"
pc1.CurrentX = 3: pc1.CurrentY = 80
pc1.Print "O"
pc1.CurrentX = 150: pc1.CurrentY = 120
pc1.Print "X"
End Function
Private Sub C1_Click()
C1.Enabled = False
Call zuobiao
On Error GoTo end1
m = InputBox("请输入随机数的个数", "插值", 5, 5000, 3000)
If (m < 3 Or m > 8) Then
Beep
MsgBox "输入数据有误，请重新输入", vbCritical, "警告"
Exit Sub
End If
Randomize
For i = 0 To m - 1
a(i) = Int(5 * Rnd + 20 * (i + 1))
b(i) = Int((70 - 20) * Rnd + 20)
pc1.Circle (a(i), b(i)), 0.5, vbBlue
CurrentX = cx + 4: CurrentY = cx + 4
pc1.FontSize = 8: pc1.ForeColor = vbRed
pc1.Print "(" & a(i) - 8 & "," & 80 - b(i) & ")"
Next i
C3.Enabled = True
C4.Enabled = True
C5.Enabled = True
flag = 1
Exit Sub
end1: If (MsgBox("你想退出吗？", vbOKCancel) = vbOK) Then
Unload Form1
End If
End Sub
Private Sub C2_Click()
pc1.Cls
C1.Enabled = True
C2.Enabled = True
C3.Enabled = False
C4.Enabled = False
C5.Enabled = False
End Sub
Private Sub C3_Click()
C3.Enabled = False
Call lag
End Sub
Private Sub C4_Click()
C4.Enabled = False
Call newton
End Sub
Private Sub C5_Click()
C5.Enabled = False
Call yangtiao
End Sub
Private Sub C6_Click()
End
End Sub
Private Sub form_load()
Form1.Left = 200
Form1.Top = 250
End Sub
Public Function delay(ByVal m As Integer)
Dim i As Integer, j As Integer
For i = 0 To 9999
For j = 0 To m
Next j
Next i
End Function
Public Function lag()
Dim k As Integer, l As Double
CurrentX = a(0): CurrentY = b(0)
For k = a(0) To a(m - 1) Step 1
l = 0
For i1 = 0 To m - 1
l1 = 1
For j = 0 To m - 1
If (j <> i1) Then
l1 = l1 * (k - a(j)) / (a(i1) - a(j))
End If
Next j
l = l + l1 * b(i1)
Next i1
pc1.DrawWidth = 3
pc1.Line (CurrentX, CurrentY)-(k, l), vbBlack
CurrentX = k: CurrentY = l
Call delay(100)
Next k
End Function
Private Function newton()
Dim f1(10) As Double
CurrentX = a(0): CurrentY = b(0)
For k = a(0) To a(m - 1)
For i1 = 0 To m - 1
f1(i1) = b(i1)
Next i1
l = b(0): t = 1
For j = 1 To m - 1
t = t * (k - a(j - 1))
For i = 0 To m - 1 - j
f1(i) = (f1(i + 1) - f1(i)) / (a(j + i) - a(i))
Next i
l = l + f1(0) * t
Next j
pc1.DrawWidth = 1
pc1.Line (CurrentX, CurrentY)-(k, l), vbGreen
CurrentX = k: CurrentY = l
Call delay(100)
Next k
End Function
Public Function yangtiao()
Dim k As Integer, s As Double, i As Integer, h(10) As Double, a1(10) As Double, C1(10) As Double, d1(10) As Double, s1 As Double, s2(10) As Double, b1(10) As Double
CurrentX = a(0): CurrentY = b(0)
For i = 0 To m - 2
h(i) = a(i + 1) - a(i)
Next i
a1(1) = 2 * (h(0) + h(1))
For i = 2 To m - 2
a1(i) = 2 * (h(i - 1) + h(i)) - h(i - 1) ^ 2 / a1(i - 1)
Next i
For i = 1 To m - 1
C1(i) = (b(i) - b(i - 1)) / h(i - 1)
Next i
For i = 1 To m - 2
d1(i) = 6 * (C1(i + 1) - C1(i))
Next i
b1(1) = d1(1)
For i = 2 To m - 2
b1(i) = d1(i) - b1(i - 1) * h(i - 1) / a1(i - 1)
Next i
s2(m - 2) = b1(m - 2) / a1(m - 2)
For i = m - 3 To 1 Step -1
s2(i) = (b1(i) - h(i) * s2(i + 1)) / a1(i)
Next i
s2(0) = 0: s2(m - 1) = 0
For i = 0 To m - 2
For k = a(i) To a(i + 1)
s1 = C1(i + 1) - s2(i + 1) * h(i) / 6 - s2(i) * h(i) / 3
s = b(i) + s1 * (k - a(i)) + s2(i) * (k - a(i)) ^ 2 / 2 + (s2(i + 1) - s2(i)) * (k - a(i)) ^ 3 / (6 * h(i))
pc1.DrawWidth = 2
pc1.Line (CurrentX, CurrentY)-(k, s), vbBlue
CurrentX = k: CurrentY = s
Call delay(100)
Next k
Next i
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -