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:haijun@yang.com.cn
'主頁內容：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