VB做三次样条曲线[终稿]

VB做三次样条曲线[终稿]
VB做三次样条曲线
'=================================================================== ==
============================
'三次样条做图模块X，Y，要做图的图片框
Public Sub OperateData(ByRef DataX() As Single, ByRef DataY() As Single, ByVal ePic As PictureBox) '数字组从0开始n结束
Dim N As Long '数组最高维数
Dim dh() As Single, dn() As Single, du() As Single, dd() As Single '样条方程组参数数组
Dim Fa() As Single, fr() As Single, Fb() As Single '分解A=LU
Dim TempY() As Single, TempX() As Single '分部解方程
组
Dim J As Long, i As Long '计算变量
Dim X As Single, Y As Single '绘制曲线用坐标
N = UBound(DataX) '返回数组的指示维度的最大值
ReDim dh(0 To N), dn(0 To N), du(0 To N), dd(0 To N)
'对dh()数组的赋值 ,为数组变量重新分配存储空间
For J = 1 To N Step 1 '对dn()数组赋值
DoEvents '转让控制权，以便让操作系统处理其它的事
件。

最简单的理解，比如你要在某个耗时很多的过程中(最常见的是
循环)，还要响应某个操作,比如控制进度条的显示，那就需要加入
DoEvents
dh(J) = DataX(J) - DataX(J - 1)
Next J
For J = 1 To N - 1 Step 1 '对du()数组赋值
DoEvents
dn(J) = dh(J + 1) / (dh(J) + dh(J + 1))
Next J
For J = 1 To N - 1 Step 1 ''对dd()数组赋值
DoEvents
du(J) = 1 - dn(J)
Next J
For J = 1 To N - 1 Step 1
DoEvents
dd(J) = 6 * (((DataY(J + 1) - DataY(J)) / dh(J +
1)) - ((DataY(J) - DataY(J - 1)) / dh(J))) / (dh(J) + dh(J + 1))
Next J
'设定为自然样条*************************
dd(0) = 0
dd(N) = 0
'***************************************
'追赶法解方程组
'分解方程组
ReDim Fa(0 To N), fr(0 To N), Fb(0 To N) '数组的重新定义
Fa(0) = 2: Fb(0) = dn(0) / 2
For i = 1 To N Step 1
DoEvents
fr(i) = du(i)
Fa(i) = 2 - fr(i) * Fb(i - 1)
DoEvents
If i < N Then Fb(i) = dn(i) / Fa(i)
Next i
'解方程组Ly=f
ReDim TempY(0 To N), TempX(0 To N)
TempY(0) = dd(0) / Fa(0)
For i = 1 To N Step 1
TempY(i) = (dd(i) - fr(i) * TempY(i - 1)) / Fa(i) DoEvents
Next i
'解方程组Ux=y
TempX(N) = TempY(N)
For i = N - 1 To 0 Step -1
TempX(i) = TempY(i) - Fb(i) * TempX(i + 1)
DoEvents
Next i
'得到TempX(0 to N)就是(Xj,Yj)各个点的二阶倒数，0《 j 《 n '找到对应的图片框进行三次样条曲线绘制
For J = 1 To N Step 1 '设置n个区间段
For X = DataX(J - 1) To DataX(J) Step 0.001 '设
定作图区间
DoEvents
Y = TempX(J - 1) * ((DataX(J) - X) ^ 3) / (6 * dh(J))
DoEvents
Y = Y + TempX(J) * ((X - DataX(J - 1)) ^ 3) / (6 * dh(J))
DoEvents
Y = Y + (DataY(J - 1) - (TempX(J - 1) * (dh(J) ^ 2) / 6)) * (DataX(J) - X) / dh(J)
DoEvents
Y = Y + (DataY(J) - (TempX(J) * (dh(J) ^ 2)) / 6) * (X - DataX(J - 1)) / dh(J)
DoEvents
ePic.PSet (X, Y), vbBlue ‘画图
Next X
Next J
End Sub
'===================================================================
==
============================
'最小二乘法拟合(0 To n) 直线拟合
Public Function DrawLines(ByRef DataX() As Single, ByRef DataY() As Single, ByVal ePic As PictureBox) As Long
On Error GoTo errHandle ’当端口被占用中，跳过此作用
Dim J As Long, N As Long, A As Double, B As Double, C As Double, D As Double
Dim Fa As Double, Fb As Double
Dim X As Single, Y As Single
N = UBound(DataX) + 1 'ubound为求一个数组的上边界
For J = 0 To N - 1 Step 1
A = A + DataX(J) ^ 2
B = B + DataX(J)
C = C + DataY(J)
D = D + DataX(J) * DataY(J)
Next J
Fa = (A * C - B * D) / (N * A - B ^ 2)
Fb = (N * D - B * C) / (N * A - B ^ 2)
ePic.ForeColor = vbBlue '设置颜色
ePic.DrawWidth = 2 '画点时，设置点的大小
For X = DataX(0) To DataX(N - 1) Step 0.1
Y = Fa + X * Fb
DoEvents
ePic.PSet (X, Y) '画图
DoEvents
Next X
DrawLines = 1
Exit Function
errHandle:
DrawLines = 0
MsgBox "计算错误，未能完成曲线", vbOKOnly + vbCritical, "err"
End Function。