1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
| Option Explicit
'pic (PictureBox)
'cmdSpline (CommandButton)
Private Const POINTS_LEN = 10
Private Const RESOLUTION = 128 '32
Private Const EPSILON = 0.00001
Private Type Point2D
x As Single
y As Single
End Type
Private Type Segment
points(3) As Point2D
End Type
Private Sub cmdSpline_Click()
Dim values(POINTS_LEN - 1) As Point2D
Dim spline(POINTS_LEN - 2) As Segment
Dim p As Point2D
Dim i As Integer, j As Integer
values(0).x = 0: values(0).y = 0
values(1).x = 20: values(1).y = 0
values(2).x = 45: values(2).y = -47
values(3).x = 53: values(3).y = 335
values(4).x = 57: values(4).y = 26
values(5).x = 62: values(5).y = 387
values(6).x = 74: values(6).y = 104
values(7).x = 89: values(7).y = 0
values(8).x = 95: values(8).y = 100
values(9).x = 100: values(9).y = 0
p.x = 0: p.y = 0
pic.AutoRedraw = True
pic.Scale (-10, -100)-(110, 450)
pic.DrawWidth = 5
For i = 0 To POINTS_LEN - 1
pic.PSet (values(i).x, values(i).y), vbBlack
Next i
If CalculateSpline(values, POINTS_LEN, spline) Then
pic.DrawWidth = 1
For i = 0 To POINTS_LEN - 2
For j = 0 To RESOLUTION - 1
Call SegmentCalc(spline(i), j / RESOLUTION, p)
pic.PSet (p.x, p.y), vbBlack
Next j
Next i
'pic.PSet (values(POINTS_LEN - 1).x, values(POINTS_LEN - 1).y), vbBlack
End If
End Sub
Private Sub Point2DNormalize(Point As Point2D)
Dim i As Single
i = Sqr(Point.x * Point.x + Point.y * Point.y)
Point.x = Point.x / i
Point.y = Point.y / i
End Sub
Private Function Point2DAdd(Left As Point2D, Right As Point2D) As Point2D
Dim newPoint As Point2D
newPoint.x = Left.x + Right.x
newPoint.y = Left.y + Right.y
Point2DAdd = newPoint
End Function
Private Function Point2DSubtract(Left As Point2D, Right As Point2D) As Point2D
Dim newPoint As Point2D
newPoint.x = Left.x - Right.x
newPoint.y = Left.y - Right.y
Point2DSubtract = newPoint
End Function
Private Function Point2DMultiply(Left As Point2D, v As Single) As Point2D
Dim newPoint As Point2D
newPoint.x = Left.x * v
newPoint.y = Left.y * v
Point2DMultiply = newPoint
End Function
Private Sub SegmentCalc(seg As Segment, t As Single, p As Point2D)
Dim t2 As Single, t3 As Single, nt As Single, nt2 As Single, nt3 As Single
t2 = t * t
t3 = t2 * t
nt = 1 - t
nt2 = nt * nt
nt3 = nt2 * nt
p.x = nt3 * seg.points(0).x + 3 * t * nt2 * seg.points(1).x + 3 * t2 * nt * seg.points(2).x + t3 * seg.points(3).x
p.y = nt3 * seg.points(0).y + 3 * t * nt2 * seg.points(1).y + 3 * t2 * nt * seg.points(2).y + t3 * seg.points(3).y
End Sub
Private Function CalculateSpline(values() As Point2D, valuesSize As Integer, bezier() As Segment) As Boolean
Dim n As Integer, i As Integer
Dim tgL As Point2D
Dim tgR As Point2D
Dim cur As Point2D
Dim nnext As Point2D
Dim tmpPoint As Point2D
Dim i1 As Single, i2 As Single, tmp As Single, x As Single
If (valuesSize < 3) Then CalculateSpline = False: Exit Function
n = valuesSize - 1
tgL.x = 0: tgL.y = 0
tgR.x = 0: tgR.y = 0
nnext = Point2DSubtract(values(1), values(0))
tmpPoint.x = 0: tmpPoint.y = 0
Call Point2DNormalize(nnext)
i1 = 0: i2 = 0: tmp = 0: x = 0
For i = 0 To n - 1
bezier(i).points(0) = values(i)
bezier(i).points(1) = values(i)
bezier(i).points(2) = values(i + 1)
bezier(i).points(3) = values(i + 1)
cur = nnext
tgL = tgR
If i + 1 < n Then
nnext = Point2DSubtract(values(i + 2), values(i + 1))
Call Point2DNormalize(nnext)
tgR = Point2DAdd(cur, nnext)
Call Point2DNormalize(tgR)
Else
tgR.x = 0
tgR.y = 0
End If
If Abs(values(i + 1).y - values(i).y) < EPSILON Then
i1 = 0: i2 = 0
Else
tmp = values(i + 1).x - values(i).x
'i1 = IIf(Abs(tgL.x) > EPSILON, tmp / (2 * tgL.x), 1)
'i2 = IIf(Abs(tgR.x) > EPSILON, tmp / (2 * tgR.x), 1) 'ERROR
If Abs(tgL.x) > EPSILON Then
i1 = tmp / (2 * tgL.x)
Else
i1 = 1
End If
If Abs(tgR.x) > EPSILON Then
i2 = tmp / (2 * tgR.x)
Else
i2 = 1
End If
End If
If Abs(tgL.x) > EPSILON And Abs(tgR.x) > EPSILON Then
tmp = tgL.y / tgL.x - tgR.y / tgR.x
If Abs(tmp) > EPSILON Then
x = (values(i + 1).y - tgR.y / tgR.x * values(i + 1).x - values(i).y + tgL.y / tgL.x * values(i).x) / tmp
If x > values(i).x And x < values(i + 1).x Then
If tgL.y > 0 Then
If (i1 > i2) Then
i1 = 0
Else
i2 = 0
End If
Else
If i1 < i2 Then
i1 = 0
Else
i2 = 0
End If
End If
End If
End If
End If
tmpPoint = Point2DMultiply(tgL, i1)
bezier(i).points(1) = Point2DAdd(bezier(i).points(1), tmpPoint)
tmpPoint = Point2DMultiply(tgR, i2)
bezier(i).points(2) = Point2DSubtract(bezier(i).points(2), tmpPoint)
Next i
CalculateSpline = True
End Function |
(
