form1.frm

一个能够从三次样条插值反求出X坐标的算法

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "用三次样条曲线模拟的正弦波"
   ClientHeight    =   6435
   ClientLeft      =   2505
   ClientTop       =   1185
   ClientWidth     =   12180
   LinkTopic       =   "Form1"
   ScaleHeight     =   6435
   ScaleWidth      =   12180
   Begin VB.TextBox Text2 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "0.00000"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   1
      EndProperty
      Height          =   555
      Left            =   9180
      TabIndex        =   4
      Top             =   4320
      Width           =   1155
   End
   Begin VB.TextBox Text1 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "0.00000"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   1
      EndProperty
      Height          =   555
      Left            =   9180
      TabIndex        =   3
      Top             =   3360
      Width           =   1155
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   375
      Left            =   4680
      TabIndex        =   2
      Top             =   6000
      Width           =   1575
   End
   Begin VB.CommandButton Command1 
      Caption         =   "绘图"
      Height          =   375
      Left            =   600
      TabIndex        =   1
      Top             =   6000
      Width           =   1575
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H80000008&
      Height          =   5775
      Left            =   120
      ScaleHeight     =   5745
      ScaleWidth      =   6465
      TabIndex        =   0
      Top             =   120
      Width           =   6495
   End
   Begin VB.Label Label2 
      Caption         =   "x"
      Height          =   315
      Left            =   8880
      TabIndex        =   6
      Top             =   4440
      Width           =   195
   End
   Begin VB.Label Label1 
      Caption         =   "y"
      Height          =   315
      Left            =   8880
      TabIndex        =   5
      Top             =   3480
      Width           =   195
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'示例一：作已知9个点的三次样条曲线
'由HCY制作
'三次样条曲线的缺点是必须保证　x1<x2<...xn 及缺乏几何不变性
Dim x(0 To 32) As Single, y(0 To 32) As Single
Dim b1, bn As Single, n, yy As Integer
Dim yangmourenx, yangmoureny As Single


Private Sub Command1_Click()
Dim yy As Integer

b1 = 0.01: bn = 0.01: n = 25
x(0) = 0
For yy = 1 To 26
x(yy) = x(yy - 1) + 10

Next yy

y(0) = 0
y(1) = 0.115759 * 360 / 6.28
y(2) = 0.383284 * 360 / 6.28
y(3) = 0.62964 * 360 / 6.28
y(4) = 0.826697 * 360 / 6.28
y(5) = 1.113137 * 360 / 6.28
y(6) = 1.643396 * 360 / 6.28
y(7) = 2.669096 * 360 / 6.28
y(8) = 3.358704 * 360 / 6.28
y(9) = 3.70139 * 360 / 6.28
y(10) = 3.986622 * 360 / 6.28
y(11) = 4.243423 * 360 / 6.28
y(12) = 4.514993 * 360 / 6.28
y(13) = 4.957367 * 360 / 6.28
y(14) = 6.00063 * 360 / 6.28
y(15) = 0.231091 * 360 / 6.28
y(16) = 0.481397 * 360 / 6.28
y(17) = 0.690446 * 360 / 6.28
y(18) = 0.877445 * 360 / 6.28
y(19) = 1.178849 * 360 / 6.28
y(20) = 1.727398 * 360 / 6.28
y(21) = 2.570255 * 360 / 6.28
y(22) = 3.383158 * 360 / 6.28
y(23) = 3.706742 * 360 / 6.28
y(24) = 3.968633 * 360 / 6.28


Picture1.Scale (-10, -300)-(400, 800) '定义图片框的坐标

Picture1.Cls

Call spline(n, b1, bn, x, y) '调用"样条曲线"过程
End Sub

Private Sub Command2_Click()
 End
End Sub

Private Sub spline(ByVal n As Long, ByVal b1 As Single, ByVal bn As Single, ByRef x() As Single, ByRef y() As Single)
Dim alfa(0 To 40) As Single, bata(0 To 40) As Single, h(0 To 40)
Dim i, t, m As Integer
Dim k, a11, a21, a41, u1, u2, u3, x0, y0, x1, y1 As Single
If (n > 2) Then

  For i = 2 To n
     h(i) = x(i) - x(i - 1)
     
  Next i
  For i = 2 To n - 1
     alfa(i) = h(i + 1) / (h(i) + h(i + 1)) 'alfa(i)即μi
     bata(i) = 6 * ((y(i + 1) - y(i)) / h(i + 1) - (y(i) - y(i - 1)) / h(i)) / (h(i) + h(i + 1)) 'bata(i)即Di
     Next i
     
     bata(1) = 6 * ((y(2) - y(1)) / h(2) - b1) / h(2) 'bata(1)即D1
     bata(n) = 6 * (bn - (y(n) - y(n - 1)) / h(n)) / h(n) 'bata(n)即Dn
     alfa(1) = 1 'alfa(1)即μ1
     alfa(n) = 0 'alfa(n)即μn
     bata(1) = bata(1) / 2 '用追赶法求解y"i即Mi
     k = 2
     
  For m = 1 To n - 1
        alfa(m) = alfa(m) / k
        k = 2 - (1 - alfa(m + 1)) * alfa(m)
        bata(m + 1) = (bata(m + 1) - (1 - alfa(m + 1)) * bata(m)) / k
       
      Next m
  For m = n - 1 To 1
        bata(m) = bata(m) - bata(m + 1) * alfa(m) 'bata(i)即Mi
       
      Next m
  For i = 1 To n - 1   '计算三次样条曲线的各系数，alfa(i)即bi,h(i)即ci
        alfa(i) = (y(i + 1) - y(i)) / h(i + 1) - h(i + 1) * (bata(i) / 3 + bata(i + 1) / 6)
        h(i) = (bata(i + 1) - bata(i)) / (6 * h(i + 1))
        bata(i) = bata(i) / 2
       
      Next i
  For i = 1 To n - 1
        a11 = y(i)
        a21 = alfa(i)
        a31 = bata(i)
        a41 = h(i)
        x0 = x(i)
        y0 = y(i)
        x1 = x0
        k = 0.2             '曲线的x增量
        u1 = 0
        m = (x(i + 1) - x(i)) / k  '每个子曲线段用m条直线来逼近
        For t = 1 To m - 1
            x1 = x1 + k
            u1 = u1 + k
            u2 = u1 * u1
            u3 = u1 * u2
            y1 = a11 + a21 * u1 + a31 * u2 + a41 * u3
            Picture1.Line (x0, 600 - y0)-(x1, 600 - y1), QBColor(12)
            x0 = x1
            y0 = y1
            If (y1 - yangmoureny) < 0.02 Then
            Text2.Text = x1
            End If
            
           
            Next t
       Picture1.Line (x0, (240 - y0))-(x(i + 1), (240 - y(i + 1))), QBColor(12)
       
        Next i
        
  '*  For i = 1 To n
      '   Picture1.Circle (x(i), (240 - y(i))), 2, QBColor(9)
        
      ' Next i
End If
End Sub

Private Sub Text1_Change()

yangmoureny = Text1.Text



End Sub