试验1.txt

是有关曲线拟合方面的内容

 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 = 138: pc1.CurrentY = 82
 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(10 * Rnd + 20 * (i + 1))
 b(i) = Int((70 - 20) * Rnd + 20)
 pc1.Circle (a(i), b(i)), 0.5, vbYellow
 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 = 1
    pc1.Line (CurrentX, CurrentY)-(k, l), vbYellow
    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 Integer, a1(10) As Double, C1(10) As Double, d1(10) As Double, s1 As Double, s2(10) As Double, b1(10) As Double

     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(0) = 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 = 1
     pc1.Line (CurrentX, CurrentY)-(k, s), vbBlue
    CurrentX = k: CurrentY = s
 Call delay(100)
  Next k
Next i
 
End Function