画曲线
各位帮帮忙，如何用VB画通过几个指定坐标点的平滑曲线？也就是说程序在输入几个点的坐标后就自动生成通过这几个点的XY散点图？ 问题点数：20、回复次数：6Top
1 楼yangzhaoyu（老妖）回复于 2001-12-15 18:11:02 得分 0
WINDOWS的有API函数可以话曲线,但只是3点平滑.如果你是N点的话,建议你找本计算机常用算法看看,里面有求N点平滑的算法Top
2 楼enmity（灵感之源）回复于 2001-12-15 19:34:59 得分 10
到
http://caotang.myetang.com/temp/curve.zip
下载给你满意答复的例子Top
3 楼xxlroad（土八路）回复于 2001-12-15 19:48:45 得分 10
VERSION 5.00
Begin VB.Form huizhi
BorderStyle = 1 'Fixed Single
Caption = "绘制三次参数样条插值曲线"
ClientHeight = 3240
ClientLeft = 45
ClientTop = 330
ClientWidth = 3285
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3240
ScaleWidth = 3285
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Caption = "结束"
Height = 375
Left = 1620
TabIndex = 2
Top = 120
Width = 1395
End
Begin VB.CommandButton Command1
Caption = "绘制曲线"
Height = 375
Left = 120
TabIndex = 1
Top = 120
Width = 1395
End
Begin VB.PictureBox Picture1
Align = 2 'Align Bottom
BackColor = &H00FFFFFF&
FillColor = &H000000FF&
ForeColor = &H000000FF&
Height = 2655
Left = 0
ScaleHeight = 2595
ScaleWidth = 3225
TabIndex = 0
Top = 585
Width = 3285
End
End
Attribute VB_Name = "huizhi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'绘制三次参数样条插值曲线
'“VB天堂”http://vbskys.yeah.net
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
Top
4 楼xxlroad（土八路）回复于 2001-12-15 19:53:04 得分 0
请给： enmity(灵感之源) 加 20 分Top
5 楼dzgld（古道东风）回复于 2001-12-16 17:30:31 得分 0
谢谢帮助！等我调试通过后一定加分Top
6 楼liuks（大胖胖）回复于 2001-12-16 18:34:46 得分 0
个人认为,采用VBA,使用graph控件,要简单的多,起码绘图部分不用自己编,可直接调用Graph控件方法.Top
