插值法.frm

以前学计算方法时,根据老师的要求做的一些基础实验VB.

VERSION 5.00
Begin VB.Form 插值法 
   BackColor       =   &H00FF8080&
   Caption         =   "Form1"
   ClientHeight    =   9255
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   14025
   LinkTopic       =   "Form1"
   ScaleHeight     =   9255
   ScaleWidth      =   14025
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00FFC0C0&
      Height          =   6495
      Left            =   1560
      ScaleHeight     =   6435
      ScaleWidth      =   9195
      TabIndex        =   6
      Top             =   240
      Width           =   9252
   End
   Begin VB.CommandButton Command6 
      Caption         =   "退出"
      Height          =   492
      Left            =   120
      TabIndex        =   5
      Top             =   5520
      Width           =   1332
   End
   Begin VB.CommandButton Command5 
      Caption         =   "样条"
      Height          =   492
      Left            =   120
      TabIndex        =   4
      Top             =   4560
      Width           =   1332
   End
   Begin VB.CommandButton Command4 
      Caption         =   "牛顿"
      Height          =   492
      Left            =   120
      TabIndex        =   3
      Top             =   3600
      Width           =   1332
   End
   Begin VB.CommandButton Command3 
      Caption         =   "拉格朗日"
      Height          =   492
      Left            =   120
      TabIndex        =   2
      Top             =   2640
      Width           =   1332
   End
   Begin VB.CommandButton Command2 
      Caption         =   "重新运行"
      Height          =   492
      Left            =   120
      TabIndex        =   1
      Top             =   1680
      Width           =   1332
   End
   Begin VB.CommandButton Command1 
      Caption         =   "随机产生点"
      Height          =   492
      Left            =   120
      TabIndex        =   0
      Top             =   720
      Width           =   1332
   End
End
Attribute VB_Name = "插值法"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m%, i%, flag%, cx%, cy%
Dim a(10) As Integer, b(10) As Integer
Private Function zuobiao()
Picture1.DrawWidth = 2
Picture1.ScaleMode = 6
Picture1.Line (8, 8)-(8, 80), vbRed
Picture1.Line (8, 80)-(140, 80), vbRed
Picture1.Line (7, 11)-(8, 8), vbRed
Picture1.Line (9, 11)-(8, 8), vbRed
Picture1.Line (138, 79)-(140, 80), vbRed
Picture1.Line (138, 81)-(140, 80), vbRed
Picture1.ForeColor = vbRed
Picture1.FontBold = True
Picture1.FontSize = 18
Picture1.CurrentX = 3: Picture1.CurrentY = 6
Picture1.Print "Y"
Picture1.CurrentX = 3: Picture1.CurrentY = 80
Picture1.Print "O"
Picture1.CurrentX = 138: Picture1.CurrentY = 82
Picture1.Print "X"
End Function
Private Sub Command1_Click()
Command1.Enabled = False
Call zuobiao
On Error GoTo end1
m = InputBox("请输入随机数的个数（3-8）", "插值", 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(10 * Rnd + 20 * (i + 1))
  b(i) = Int((70 - 20) * Rnd + 20)
  Picture1.Circle (a(i), b(i)), 0.5, vbYellow
  CurrentX = cx + 4: CurrentY = cx + 4
  Picture1.FontSize = 8: Picture1.ForeColor = vbRed
  Picture1.Print "(" & a(i) - 8&; "," & 80 - b(i) & ")"
Next
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
flag = 1
Exit Sub
end1: If (MsgBox("你想退出吗?", vbOKCancel) = vbOK) Then
         Unload Form1
         End If
End Sub

Private Sub Command2_Click()
Picture1.Cls
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
End Sub

Private Sub Command3_Click()
Command3.Enabled = False
Call lagrange
End Sub

Private Sub Command4_Click()
Command4.Enabled = False
Call newton
End Sub

Private Sub Command5_Click()
Command5.Enabled = False
Call yangtiao
End Sub
Public Function lagrange()
Dim l#, li#, i1%, j%, k%
CurrentX = a(0): CurrentY = b(0)
For k = a(0) To a(m - 1) Step 1
  l = 0
  For i1 = 0 To m - 1
  li = 1
     For j = 0 To m - 1
     If (j <> i1) Then
         li = li * (k - a(j)) / (a(i1) - a(j))
     End If
     Next
  l = l + li * b(i1)
  Next
  Picture1.DrawWidth = 2
  Picture1.Line (CurrentX, CurrentY)-(k, l), vbBlue
  CurrentX = k: CurrentY = l
  Call delay(100)
Next
End Function
Public Function newton()
Dim l#, t#, i%, j%, k%, f(0 To 10)
CurrentX = a(0): CurrentY = b(0)
For k = a(0) To a(m - 1) Step 1
For i = 0 To m - 1
f(i) = b(i)
Next
l = b(0): t = 1
For j = 1 To m - 1
t = t * (k - a(j - 1))
For i = 0 To (m - j)
f(i) = (f(i + 1) - f(i)) / (a(j + i) - a(i))
Next
l = l + f(0) * t
Next
Picture1.DrawWidth = 2
Picture1.Line (CurrentX, CurrentY)-(k, l), vbGreen
CurrentX = k: CurrentY = l
Call delay(100)
Next
End Function
Public Function yangtiao()
Dim l#, p#, x#, i%, k%, j%, h(0 To 10), c(0 To 10), d(0 To 10), e(0 To 10), f(0 To 10), t(0 To 10)
CurrentX = a(0): CurrentY = b(0)

For j = 0 To m - 1
h(j) = a(j + 1) - a(j)
Next
f(1) = 2 * (h(0) + h(1))
For j = 2 To m - 1
f(j) = 2 * (h(j - 1) + h(j)) - h(j - 1) * h(j - 1) / f(j - 1)
Next
For j = 1 To m
c(j) = (b(j) - b(j - 1)) / h(j - 1)
Next
For j = 1 To m - 1
d(j) = 6 * (c(j + 1) - c(j))
Next
e(1) = d(1)
For j = 2 To m - 1
e(j) = d(j) - e(j - 1) * h(j - 1) / f(j - 1)
Next
t(0) = e(m - 1) / f(m - 1)
For j = m - 2 To 1 Step -1
t(j) = (e(j) - h(j) * t(j + 1)) / f(j)
Next
t(0) = 0: t(m) = 0
For j = 0 To m - 1
For x = a(j) To a(j + 1) Step 1
p = c(j + 1) - t(j + 1) * h(j) / 6 - t(j) * h(j) / 3
l = b(j) + p * (x - a(j)) + t(j) * (x - a(j)) * (x - a(j)) / 2 + (t(j + 1) - t(j)) * (x - a(j)) * (x - a(j)) * (x - a(j)) / (6 * h(j))
Picture1.DrawWidth = 2
Picture1.Line (CurrentX, CurrentY)-(x, l), vbRed
CurrentX = x: CurrentY = l
Call delay(100)
Next
Next
End Function
Private Sub Command6_Click()
插值法.Hide
Form1.Show
End Sub
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