新建 文本文档 (5).txt

这是学习 计算方法程序设计的好教程啊。

B_三次样条函数（曲线拟合）VB6代码如下：
Option Explicit
Dim t() As Single

Dim k As Integer

Dim PtX(5) As Single
Dim pty(5) As Single
Dim MaxPt As Integer

Dim bClosed As Boolean

' 
Private Function Blend(i As Integer, k As Integer, U As Single) As Single
Dim numer As Single
Dim denom As Single
Dim V1 As Single
Dim V2 As Single
Dim newU As Single

If i > 0 And bClosed Then
  newU = U - i + MaxPt + 1
  Do While newU >= MaxPt + 1
    newU = newU - (MaxPt + 1)
  Loop
  Do While newU < 0
    newU = newU + (MaxPt + 1)
  Loop
  Blend = Blend(0, k, newU)
  Exit Function
End If

'Base case for the recursion
If k = 1 Then
  If t(i) <= U And U < t(i + 1) Then
    Blend = 1
  ElseIf U = MaxPt And t(i) <= U And U <= t(i + 1) Then
    Blend = 1
  Else
    Blend = 0
  End If
  Exit Function
End If

denom = t(i + k - 1) - t(i)
If denom = 0 Then
  V1 = 0
Else
  numer = (U - t(i)) * Blend(i, k - 1, U)
  V1 = numer / denom
End If

denom = t(i + k) - t(i + 1)
If denom = 0 Then
  V2 = 0
Else
  numer = (t(i + k) - U) * Blend(i + 1, k - 1, U)
  V2 = numer / denom
End If

Blend = V1 + V2

End Function

Private Function X(U As Single) As Single
Dim i As Integer
Dim v As Single

 
  For i = 0 To MaxPt
    v = v + PtX(i) * Blend(i, k, U) '/ 2 'zoom x
  Next i
  X = v
End Function

Private Function Y(U As Single) As Single
Dim i As Integer
Dim v As Single

  For i = 0 To MaxPt
    v = v + pty(i) * Blend(i, k, U) ' / 2 'zoom y
  Next i
  Y = v
End Function

Private Sub Fill_T()
Dim i As Integer
ReDim t(MaxPt + k + 1)

If bClosed Then
  For i = 0 To UBound(t)
    t(i) = i
  Next i
Else
  For i = 0 To UBound(t)
    If i < k Then
       t(i) = 0
    ElseIf i <= MaxPt Then
       t(i) = i - k + 1
    Else
       t(i) = MaxPt - k + 2
    End If
  Next i
End If
End Sub

Private Sub DrawCurve()


On Error Resume Next
Dim i As Integer, r As Integer
Dim U As Single

'Me.Scale (0, 0)-(640, 480)
Me.Cls
Me.ForeColor = vbBlack
Me.DrawStyle = vbDot
Me.PSet (PtX(0), pty(0))
For i = 0 To MaxPt
  Me.Line -(PtX(i), pty(i))
Next i
Me.ForeColor = vbRed
Me.DrawStyle = vbSolid

Call Fill_T

If bClosed Then
  r = MaxPt + 1
Else
  r = MaxPt - k + 2
End If

Me.PSet (X(0), Y(0))

For i = 1 To r * 20 - 1
  U = i / 20
  Me.Line -(X(U), Y(U))
Next i

If bClosed Then Me.Line -(X(0), Y(0))

End Sub

Private Sub chkClosed_Click()
bClosed = -1 * chkClosed.Value
DrawCurve
End Sub

Private Sub cmbK_Click()
k = Val(cmbK.Text)
DrawCurve
End Sub

Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Source.Move X, Y
PtX(Source.indeX) = X: pty(Source.indeX) = Y
DrawCurve
End Sub

Private Sub Form_Load()

MaxPt = UBound(PtX)
k = 3
PtX(0) = 50: pty(0) = 300
PtX(1) = 150: pty(1) = 250
PtX(2) = 240: pty(2) = 310
PtX(3) = 350: pty(3) = 300

PtX(4) = 370: pty(4) = 400
PtX(5) = 550: pty(5) = 330

cmbK.ListIndex = 0

End Sub

Private Sub Form_Resize()
Dim i As Integer
  On Error GoTo endd
Me.Scale (0, 0)-(800, 600)
For i = 0 To MaxPt
  pControl(i).Move PtX(i), pty(i)
Next i
DrawCurve
endd:
End Sub