huizhi.frm

用VB程序编写的数值分析三次样条插值函数。

VERSION 5.00
Begin VB.Form huizhi 
   Caption         =   "绘制曲线图"
   ClientHeight    =   4905
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6165
   LinkTopic       =   "Form1"
   ScaleHeight     =   4905
   ScaleWidth      =   6165
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command2 
      Caption         =   "结束"
      Height          =   495
      Left            =   1800
      TabIndex        =   2
      Top             =   60
      Width           =   1395
   End
   Begin VB.CommandButton Command1 
      Caption         =   "绘制曲线"
      Height          =   495
      Left            =   360
      TabIndex        =   1
      Top             =   60
      Width           =   1395
   End
   Begin VB.PictureBox Picture1 
      Align           =   2  'Align Bottom
      BackColor       =   &H00000000&
      FillColor       =   &H000000FF&
      ForeColor       =   &H000000FF&
      Height          =   4095
      Left            =   0
      ScaleHeight     =   4035
      ScaleWidth      =   6105
      TabIndex        =   0
      Top             =   810
      Width           =   6165
   End
End
Attribute VB_Name = "huizhi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'绘制三次参数样条插值曲线

Dim x(10) As Single, y(10) As Single, u1(4000) As Single, v1(4000) As Single
Dim num As Integer
Function hypot(ByVal x As Single, ByVal y As Single)
 hypot = Sqr(x ^ 2 + y ^ 2)
End Function

Private Sub Command1_Click()
 Picture1.Scale (0, 0)-(640, 480)
 x(0) = 80: y(0) = 280
 x(1) = 350: y(1) = 200
 x(2) = 180: y(2) = 140
 x(3) = 200: y(3) = 200
 DrawWidth = 3
 For i = 0 To 3
  Picture1.PSet (x(i), y(i))
 Next i
 DrawWidth = 1
 tspLine 3, 2, 0, 0, 0, 0
 Picture1.PSet (u1(0), v1(0))
  For i = 1 To num - 1
   Picture1.Line -(u1(i), v1(i))
  Next i
End Sub

Private Sub Command2_Click()
 End
End Sub

Sub tspLine(ByVal n As Integer, ByVal ch As Integer, ByVal tx1 As Single, ByVal tx2 As Single, ByVal ty1 As Single, ByVal ty2 As Single)
Dim a(10) As Single, b(10) As Single, c(10) As Single, dx(10) As Single, dy(10) As Single
Dim qx(10) As Single, qy(10) As Single
Dim tt As Single, bx3 As Single, bx4 As Single, by3 As Single, by4 As Single
Dim cx As Single, cy As Single, t(10) As Single, px(10) As Single, py(10) As Single
Dim u(3) As Single, v(3) As Single, i As Integer
num = 0
For i = 1 To n
 t(i) = hypot(x(i) - x(i - 1), y(i) - y(i - 1))
Next i
Select Case ch
 Case 0 '抛物条件
   u(0) = (x(1) - x(0)) / t(1): u(1) = (x(2) - x(1)) / t(2)
   u(2) = (u(1) - u(0)) / (t(2) + t(1))
   tx1 = u(0) - u(2) * t(1)
   u(0) = (y(1) - y(0)) / t(1): u(1) = (y(2) - y(1)) / t(2)
   u(2) = (u(1) - u(0)) / (t(2) + t(1))
   ty1 = u(0) - u(2) * t(1)
   u(0) = (x(n) - x(n - 1)) / t(n): u(1) = (x(n - 1) - x(n - 2)) / t(n - 1)
   u(2) = (u(0) - u(1)) / (t(n) + t(n - 1))
   tx2 = u(0) + u(2) * t(n)
   u(0) = (y(n) - y(n - 1)) / t(n): u(1) = (y(n - 1) - y(n - 2)) / t(n - 1)
   u(2) = (u(0) - u(1)) / (t(n) + t(n - 1))
   ty2 = u(0) + u(2) * t(n)
 Case 1 '夹持条件
  a(0) = 1: c(0) = 0: dx(0) = tx1: dy(0) = ty1
  a(n) = 1: b(n) = 0: dx(n) = tx2: dy(n) = ty2
 Case 2 '自由条件
  a(0) = 2: c(0) = 1
  dx(0) = 3 * (x(1) - x(0)) / t(1): dy(0) = 3 * (y(1) - y(0)) / t(1)
  a(n) = 2: b(n) = 1
  dx(n) = 3 * (x(n) - x(n - 1)) / t(n): dy(n) = 3 * (y(n) - y(n - 1)) / t(n)
 Case 3 '循环条件
  a(0) = 2: c(0) = 1
  dx(0) = 3 * (x(1) - x(0)) / t(1) - (t(1) * (x(2) - x(1)) / t(2) - x(1) + x(0)) / (t(1) + t(2))
  dy(0) = 3 * (y(1) - y(0)) / t(1) - (t(1) * (y(2) - y(1)) / t(2) - y(1) + y(0)) / (t(1) + t(2))
  a(n) = 2: b(n) = 1
  dx(n) = 3 * (x(n) - x(n - 1)) / t(n)
  dx(n) = dx(n) + (x(n) - x(n - 1) - t(n) * (x(n - 1) - x(n - 2)) / t(n - 1)) / (t(n) + t(n - 1))
  dy(n) = 3 * (y(n) - y(n - 1)) / t(n)
  dy(n) = dy(n) + (y(n) - y(n - 1) - t(n) * (y(n - 1) - y(n - 2)) / t(n - 1)) / (t(n) + t(n - 1))
End Select

'计算方程组系数阵和常数阵
For i = 1 To n - 1
 a(i) = 2 * (t(i) + t(i + 1)): b(i) = t(i + 1): c(i) = t(i)
 dx(i) = 3 * (t(i) * (x(i + 1) - x(i)) / t(i + 1) + t(i + 1) * (x(i) - x(i - 1)) / t(i))
 dy(i) = 3 * (t(i) * (y(i + 1) - y(i)) / t(i + 1) + t(i + 1) * (y(i) - y(i - 1)) / t(i))
Next i

'采用追赶法解方程组
c(0) = c(0) / a(0)
For i = 1 To n - 1
 a(i) = a(i) - b(i) * c(i - 1): c(i) = c(i) / a(i)
Next i
a(n) = a(n) - b(n) * c(i - 1)
qx(0) = dx(0) / a(0): qy(0) = dy(0) / a(0)
For i = 1 To n
  qx(i) = (dx(i) - b(i) * qx(i - 1)) / a(i)
  qy(i) = (dy(i) - b(i) * qy(i - 1)) / a(i)
Next i
px(n) = qx(n): py(n) = qy(n)
For i = n - 1 To 0 Step -1
 px(i) = qx(i) - c(i) * px(i + 1)
 py(i) = qy(i) - c(i) * py(i + 1)
Next i

'计算曲线上点的坐标
For i = 0 To n - 1
 bx3 = (3 * (x(i + 1) - x(i)) / t(i + 1) - 2 * px(i) - px(i + 1)) / t(i + 1)
 bx4 = ((2 * (x(i) - x(i + 1)) / t(i + 1) + px(i) + px(i + 1)) / t(i + 1)) / t(i + 1)
 by3 = (3 * (y(i + 1) - y(i)) / t(i + 1) - 2 * py(i) - py(i + 1)) / t(i + 1)
 by4 = ((2 * (y(i) - y(i + 1)) / t(i + 1) + py(i) + py(i + 1)) / t(i + 1)) / t(i + 1)
 tt = 0
 While (tt <= t(i + 1))
  cx = x(i) + (px(i) + (bx3 + bx4 * tt) * tt) * tt
  cy = y(i) + (py(i) + (by3 + by4 * tt) * tt) * tt
  u1(num) = cx: v1(num) = cy: num = num + 1: tt = tt + 0.5
 Wend
 u1(num) = x(i + 1): v1(num) = y(i + 1): num = num + 1
Next i
End Sub