在VB中如何通过已知的几个点绘制样条曲线

Function hypot(ByVal X As Single, ByVal Y As Single)
hypot = Sqr(X ^ 2 + Y ^ 2)
End Function

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(1000) As Single, b(1000) As Single, c(1000) As Single, dX(1000) As Single, dY(1000) As Single
Dim qx(1000) As Single, qy(1000) 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(1000) As Single, px(1000) As Single, py(1000) As Single
Dim u(3000) As Single, v(3000) 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 Command1_Click()
Dim i As Long
'Picture1.Scale (0, 0)-(640, 550)
DrawWidth = 3
Picture1.Cls
'If Check1.Value Then Command2_Click
'X(0) = 1
'Y(0) = 1
'X(t - 1) = 638
'Y(t - 1) = 548
Picture1.ForeColor = QBColor(10)
For i = 0 To t - 1
Picture1.Line (X(i) - 1, Y(i) - 1)-(X(i) + 1, Y(i) + 1), QBColor(10), B
Picture1.Print i
Next i
Picture1.ForeColor = QBColor(12)
DrawWidth = 1
tspLine t - 1, 2, 0, 0, 0, 0
Picture1.PSet (u1(0), v1(0))
For i = 1 To num - 1
Picture1.Line -(u1(i), v1(i))
'For de = 1 To 12000: Next de 'Sleep 1
Next i
Picture1.ForeColor = QBColor(10)
For i = 0 To t - 1
Picture1.Line (X(i) - 1, Y(i) - 1)-(X(i) + 1, Y(i) + 1), QBColor(10), B
Picture1.Print i
Next i
End Sub

在picturebox里先设置坐标，最大值和最小值，然后用pset方法循环画点。

picture1.Scale (xmin.Text, ymax.Text)-(xmax.Text, ymin.Text)

For i = 1 To 1000
Picture2.PSet (xx(i), yy(i))
Next