# spline cubic rutine with VB5

I need a VB5.0 function able to do a smoth curve since a several datas from 2d array using spline cubic method
###### Who is Participating?

Senior DBACommented:
0

Commented:
Hi
1. Do you need local (3 points) or global (all points) spline?
2. Do you need interpolation or extrapolation too?
3. I'm afraid you forgot to add some zeroes to points value <smile>
Cheers
0

Author Commented:
1. all points
2. interpolation
3. I lost my points because I put the
questions first in a wrong topic area
sorry, but I don't have more points
availables :(
0

Commented:
Hi
just one more question - plz, describe your 2d array - is this A(n,2) or A(2,n) dimension, is it zero or 1 bazed. Or you have 2 one-dim arrays?
for example:
A(0,0) = X(0)
A(0,1) = Y(0)
A(1,0) = X(1)
etc...
Cheers
0

Commented:
Ok, here it is.
I assume, you have 1 based 2dim array,like this:
A(1,1) = X(1)
A(1,2) = X(2)
A(1,3) = X(3)
A(2,1) = Y(1)
A(2,2) = Y(2)
A(2,3) = Y(3)
If not, I specially work with X() and Y() arrays so you can change code.
Place PictureBox, command button and TextBox (multiline) on form. Form code:

Option Explicit
Option Base 1
Dim M() As Single
Dim X() As Single, Y() As Single
Dim TempArr() As Single

Private Sub PrepareSpline(inpArr() As Single)
Dim n As Integer, i As Integer
Dim L() As Single, R() As Single, S() As Single
Dim D As Single, E As Single, F As Single, H As Single, P As Single
n = UBound(inpArr, 2)
If n < 2 Then Exit Sub
ReDim M(n), X(n), Y(n), L(n), R(n), S(n)
For i = 1 To n
X(i) = inpArr(1, i)
Y(i) = inpArr(2, i)
Next i
D = X(2) - X(1):  E = (Y(2) - Y(1)) / D
For i = 2 To n - 1
H = D: D = X(i + 1) - X(i)
If D = 0 Then D = 0.0001
F = E: E = (Y(i + 1) - Y(i)) / D
L(i) = D / (D + H)
R(i) = 1 - L(i)
S(i) = 6 * (E - F) / (D + H)
Next i
For i = 2 To n - 1
P = 1 / (R(i) * L(i - 1) + 2)
L(i) = -L(i) * P
S(i) = (S(i) - R(i) * S(i - 1)) * P
Next i
M(n) = 0: L(n - 1) = S(n - 1): M(n - 1) = L(n - 1)
For i = n - 2 To 1 Step -1
L(i) = L(i) * L(i + 1) + S(i)
M(i) = L(i)
Next i
End Sub

Private Function CalcValue(arg As Single) As Single
Dim ret As Single, i As Integer, n As Integer
Dim D As Single, H As Single, P As Single, R As Single
n = UBound(X)
For i = 1 To n
If arg < X(i) Then Exit For
Next i
Select Case i
Case 1    ' arg less then x(1) -> Extrapolation
D = X(2) - X(1)
If D = 0 Then D = 0.0001
ret = -D * M(2) / 6 + (Y(2) - Y(1)) / D
ret = ret * (arg - X(1)) + Y(1)
Case n + 1 ' arg greater then x(n) -> Extrapolation
D = X(n) - X(n - 1)
If D = 0 Then D = 0.0001
ret = D * M(n - 1) / 6 + (Y(n) - Y(n - 1)) / D
ret = ret * (arg - X(n)) + Y(n)
Case Else  'interpolation
D = X(i) - X(i - 1): H = arg - X(i - 1)
R = X(i) - arg: P = D * D / 6
ret = (M(i - 1) * R ^ 3 + M(i) * H ^ 3) / (6 * D)
ret = ret + ((Y(i - 1) - M(i - 1) * P) * R + (Y(i) - M(i) * P) * H) / D
End Select
CalcValue = ret
End Function

Private Sub Command1_Click()
PrepareSpline TempArr
DrawCurve 1
End Sub

Text1 = ""
Picture1.FillColor = vbRed
Picture1.FillStyle = vbSolid
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
Static n1 As Integer
If Button = 1 Then
n1 = n1 + 1
ReDim Preserve TempArr(2, n1)
TempArr(1, n1) = X
TempArr(2, n1) = Y
Text1 = Text1 & vbCrLf & TempArr(1, n1) & vbTab & TempArr(2, n1)
Picture1.Circle (X, Y), 50
End If
End Sub

Private Sub DrawCurve(iStep As Integer)
Dim i As Integer
Picture1.PSet (X(LBound(X)), CalcValue(X(LBound(X))))
For i = X(LBound(X)) + iStep To X(UBound(X)) Step iStep
Picture1.Line -(i, CalcValue(CSng(i)))
Next i
End Sub

' click on picturebox to draw points, then press command button
' sometimes you can received overflow or division by zero - it's depend on array value. You can fixed this yourself. (I've already spend 3 hours for coding and have no more time). Or I'll fix it after weekend.

Cheers

0

Author Commented:
Thanks for help me, the rutines
works perfect..!!
regards,
Ricardo
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.