huizhi.frm

一个三次样条插值的源代码！！经过验证

VERSION 5.00
Begin VB.Form huizhi 
   Caption         =   "绘制曲线图"
   ClientHeight    =   4890
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5775
   LinkTopic       =   "Form1"
   ScaleHeight     =   4890
   ScaleWidth      =   5775
   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      =   5715
      TabIndex        =   0
      Top             =   795
      Width           =   5775
   End
End
Attribute VB_Name = "huizhi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'资料整理 影子 VB爱好者乐园 http://yingzi007.126.com
'绘制三次参数样条插值曲线
'欢迎经常访问“VB天堂”http://vbskys.yeah.net
'我的E-mail:[e-mail]
'主页内容：VB脚本、JAVA脚本、ASP学习及VB源程序、作者的自编软件及源程序、
'各种免费资源(如免费打美国长途、免费国际传真等）
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

Private Sub Form_Load()

End Sub