Hope it helps.
Edited 13 march 04
********BEWARE! ********
Tested with WinXP only.
Reported crash with Win98
Any feedback and bug reports are welcome.
************************
Code: Select all
Title$ = "Bezier Spline curves - by einander - Click, move & delete points"
; march 10 -2004 -PB 3.81
; Thanks Psychophanta for the Hypotenuse ASM procedure!
; ___________________________
; Click and create points
; Move points with Left Mousebutton
; Delete selected point with Right Mousebutton (need more than 3 points to delete one)
; To see the first spline you need at least 3 points
; Quit with ESC
Enumeration
#IMG
#GadIMG
EndEnumeration
Global hWnd, hDC, _X, _Y, MX, MY, MK, Vertex,MaxVertex, Segments, hDef.f
Global LineWidth.B, SplineColor, BKGcolor, PointColor, Numbers, TextColor
; *************************************************
; CHOOSE HERE YOUR PREFERENCES
LineWidth = 6
Segments = 12 ; number of lines between Vertex
MaxVertex = 200 ; maximum clicked points number
SplineColor = #Green
BKGcolor = #Black
PointColor = #Magenta
TextColor = #Yellow
ViewXpos = 1 ; 0 = Not view
; ************************************************
hDef = 1 / Segments
Dim A.f(MaxVertex)
Dim B.f(MaxVertex)
Dim C.f(MaxVertex)
Dim D.f(MaxVertex)
Dim X.l(MaxVertex)
Dim Y.l(MaxVertex)
Dim Bezier.l(MaxVertex)
Dim Indx.l(MaxVertex)
Dim XSort.l(MaxVertex)
Dim YSort.l(MaxVertex)
Dim X_Spline.l(MaxVertex * Segments )
Dim Y_Spline.l(MaxVertex * Segments )
Procedure INL(ADDR, E, Va) ; Assign value Va to element E of Array starting at ADDR
PokeL(ADDR + E * 4, Va)
EndProcedure
Procedure Lin(DC, X, Y, X1, Y1, Width, Color)
Pen = CreatePen_(#Ps_Solid, Width, Color)
SelectObject_(DC, pen)
MoveToEx_(DC, X, Y, 0) : LineTo_(DC, X1, Y1)
DeleteObject_(pen)
EndProcedure
Procedure Text(X, Y, T$)
FrontColor(Red(TextColor), Green(TextColor), Blue(TextColor))
Locate(X, Y)
DrawText(T$)
EndProcedure
Procedure ArrayCopy(SRC, DEST, DI) ; DI es la cant de elem a copiar
CopyMemory(SRC, DEST, DI * 4)
EndProcedure
Procedure VarL(ADDR, E) ; return element E from Array starting at ADDR
ProcedureReturn PeekL(ADDR + E * 4)
EndProcedure
Procedure SpLin(N, AC1, AC2) ; splines calculations
N1 = N - 1
B(0) = (VarL(AC1, 1) - VarL( AC1, 0)) * 4
For I = 1 To N1
B(I ) = (VarL(AC1, 1 + I ) - VarL(AC1, I ) * 2 + VarL(AC1, I - 1)) * 3
Next I
B(N ) = (VarL(AC1, N1) - VarL(AC1, N )) * 4
C(0) = B(0) / 2
B(1) - B(0) / 4
Dr.f = 0.5
C(1) = B(1) / 2
For I = 2 To N1
S.f = -Dr / 2
B(I ) - B(I - 1) / 4
Dr = 1 / (S / 2 + 2)
C(I ) = B(I ) * Dr
Next I
B(N ) + B(N1) * - Dr
C(N ) = B(N) / (-Dr / 2 + 2)
Repeat
B.f = C(1 + N1) : C.f = B(N1) * 2
If C : B / C : EndIf
C(N1) * (1 - B)
N1 - 1
Until N1 = 0
C(0) * (1 - C(1))
If B(0) : C(0) / B(0) : EndIf
For I = 1 To N
B(I ) = VarL(AC1, I ) - VarL(AC1, I - 1) + (C(I ) * 2 + C(I - 1)) / 6
D(I ) = (C(I ) - C(I - 1)) / 6
Next I
For I = 1 To N : C(I ) / 2 : Next I
For I = 1 To N
T.f = -1
For j = 0 To Segments - 1
INL(AC2, R, ((D(I ) * T + C(I )) * T + B(I )) * T + VarL(AC1, I ))
T + hDef : R + 1
Next j
Next I
INL(AC2, R, VarL(AC1, N ))
EndProcedure
Procedure.f Hypotenuse(Cateto1.f, Cateto2.f) ; this one is from Psychophanta
! fld dword[esp] ; push Cateto1 to FPU stack (to st0)
! fmul st0, st0 ; Cateto1^2
! fld dword[esp + 4] ; push Cateto2 value to FPU stack (to st0) (Cateto1 is now in st1)
! fmul st0, st0 ; Cateto2^2
! faddp ; Cateto1^2+Cateto2^2 and pop FPU stack
! fsqrt ; Sqr(Cateto1^2+Cateto2^2)
EndProcedure
Procedure Near(X, Y, ArrSize, DIR1.L, DIR2.L) ; return elem Nearest to x,y
MIn = $FFFFFF
For i = 0 To ArrSize
a = hypotenuse(X - PeekL(DIR1 + i * 4), Y - PeekL(DIR2 + i * 4))
If A < MIn : MIn = A : J = i : EndIf
Next i
ProcedureReturn J
EndProcedure
Procedure Callback(0, Msg, wParam, lParam) ; control mouse & key messages
Result = #PB_ProcessPureBasicEvents
Select Msg
Case #WM_MOUSEMOVE
GetCursorPos_(p.POINT)
ScreenToClient_(hWnd, p)
MX = p\X
MY = p\Y
Case #WM_LBUTTONDOWN
If MK = 2 : MK = 3 : Else : MK = 1 : EndIf
Case #WM_LBUTTONUP
If MK = 3 : MK = 2 : Else : MK = 0 : EndIf
Case #WM_RBUTTONDOWN
If MK = 1 : MK = 3 : Else : MK = 2 : EndIf
Case #WM_RBUTTONUP
If MK = 3 : MK = 1 : Else : MK = 0 : EndIf
Case #WM_KEYDOWN
Ev = EventwParam()
If Ev = 27 : End
EndIf
Case #PB_EventCloseWindow : End
EndSelect
ProcedureReturn Result
EndProcedure
; _________________________________________________________________________________________
_X = GetSystemMetrics_(#SM_CXSCREEN) : _Y = GetSystemMetrics_(#SM_CYSCREEN)
HwND = OpenWindow(0, 0, 0, _X, _Y, #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE, Title$)
hDC = GetDC_(HwND)
CreateGadgetList(hWnd)
ImageGadget(#GadIMG, 0, 0, _X, _Y, 0)
Dawing = StartDrawing(WindowOutput())
DrawingMode(1)
Box(0, 0, WindowWidth(), WindowHeight(), BKGcolor)
Vertex = -1
SetWindowCallback(@Callback())
Repeat
WindowEvent()
If POSANT
Circle (XSort(POSANT - 1), YSort(POSANT - 1), 5, PointColor) : POSANT = 0
EndIf
If MK = 0 ; Find nearest vertex
C = Near(MX, MY, Vertex, @X(), @Y())
If Abs(mx - x(c)) < 10 And Abs(my - y(c)) < 10
If xpos = 0
Xpos = X(c) : ypos = Y(c)
Circle(xpos, ypos, 5, #white)
EndIf
Else
If xpos
Circle(xpos, ypos, 5, pointcolor)
EndIf
xpos = 0
EndIf
ElseIf MK = 1
If xpos ; Move Vertex
Repeat
WindowEvent()
x(c) = mx : y(c) = my
Gosub DrawSpline
Until mk = 0
Else ; create new Vertex
Gosub SetPoints
Repeat : WindowEvent() :Until MK = 0
If Vertex < 2
Lin(hDC, Bezier(0), YSort(0), Bezier(1), YSort(1), LineWidth, SplineColor)
Else
If Vertex <> Vflag
Gosub DrawSpline
EndIf
Vflag = Vertex
EndIf
EndIf
ElseIf MK = 2
If Vertex > 2
If xpos
For i = c To Vertex
x(i) = x(i + 1) : y(i) = y(i + 1)
Next
Vertex - 1 : Vflag = Vertex
Gosub DrawSpline
EndIf
EndIf
EndIf
ForEver
End
; ______________________________________________
SetPoints :
Circle(MX, MY, 5, PointColor)
Vertex + 1
X(Vertex) = MX : Y(Vertex) = MY
Indx(Vertex) = Vertex
Return
; _______________________________________________
DrawSpline :
ArrayCopy(@X(), Bezier(), Vertex + 1)
For I = 0 To Vertex
XSort(I) = Bezier(Indx(I))
Next I
For I = 0 To Vertex
Bezier(I) = Y(Indx(I))
Next I
ArrayCopy(@Bezier(), @YSort(), Vertex + 1)
SpLin(Vertex, @XSort(), @X_Spline())
SpLin(Vertex, @YSort(), @Y_Spline())
CreateImage(#IMG, _X, _Y)
StopDrawing()
DRAWING = StartDrawing (ImageOutput())
If ViewXpos :
For i = 0 To Vertex
lin(drawing, XSort(i), 0, XSort(i), _y, 1, RGB(60, 70, 80))
Next
EndIf
For i = 1 To Vertex * Segments
Lin(drawing, X_Spline(i - 1), Y_Spline(i - 1), X_Spline(i), Y_Spline(i), LineWidth, SplineColor)
Next
For i = 0 To Vertex
Circle (XSort(i), YSort(i), 5, PointColor)
DrawingMode(1)
Text(XSort(i) - 4, YSort(i) + 4, Str(i))
Next
StopDrawing()
xpos = 0
DRAWING = StartDrawing(WindowOutput())
SetGadgetState(#GadIMG, UseImage(#IMG))
Return
Einander
