by Mark Roberts (2 Submissions)
Category: Custom Controls/Forms/Menus
Compatability: Visual Basic 3.0
Difficulty: Intermediate
Date Added: Wed 3rd February 2021
Rating: (6 Votes)
A simple Bezier spline implementation. Allows the user to select control 'points on a picture box and then draw a Bezier curve between them.
NEW!! - User can now move control points!!
Assumes
I just wrote this to help me with something else so it's not even slightly optimised - in fact its really badly done but it does the job. Implements the explicit x,y functions of the normal parametric equation.
You can move the points by selecting clicking
on them and dragging with the left button
If you want to put multiple points on the same
location add them with the right button
Place the following controls on a form
Command button NAME= cmdReset
Picture Box NAME=picDisplay
Label NAME = label1
Dim nc As Integer
Dim Cont(100, 1) As Integer
Dim NewLocPoint As Integer
Const Smooth = 0.02
Dim Dragging As Boolean
Function B(k, n, u)
'Bezier blending function
B = C(n, k) * (u ^ k) * (1 - u) ^ (n - k)
End Function
Function C(n, r)
' Implements c!/r!*(n-r)!
C = fact(n) / (fact(r) * fact(n - r))
End Function
Function fact(n)
' Recursive factorial fucntion
If n = 1 Or n = 0 Then
fact = 1
Else
fact = n * fact(n - 1)
End If
End Function
Private Sub AddCont(X, Y)
Cont(nc, 0) = X: Cont(nc, 1) = Y
nc = nc + 1
End Sub
Private Sub cmdReset_Click()
nc = 0
picDisplay.Cls
End Sub
Private Sub Form_Load()
Form1.ScaleMode = vbTwips
Form1.Caption = "Bezier Curves by Mark Roberts"
Form1.Move 900, 900, 5900, 5200
picDisplay.Move 120, 120, 5535, 4250
cmdReset.Move 4640, 4435, 1015, 255
cmdReset.Caption = "&Reset"
With Label1
.BackColor = &HC0FFFF
.BorderStyle = vbFixedSingle
.Move 120, 4440, 4435, 255
.Alignment = vbCenter
.Caption = "Select new points or drag points to move"
End With
picDisplay.ScaleMode = vbPixels
picDisplay.FontSize = 5
End Sub
Private Sub picDisplay_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
xv = Int(X): yv = Int(Y) 'In case not pixels
cval = Clicked(xv, yv)
If cval > -1 And Button = 1 Then ' In case you want multiple points
Dragging = True
NewLocPoint = cval
Label1.Caption = "Dragging point " + Trim$(cval + 1)
Else
AddCont xv, yv 'Add the control points
picDisplay.Circle (xv, yv), 2, 255
picDisplay.Print nc
If nc = 1 Then
PSet (xv, yv)
Else
picDisplay.DrawStyle = vbDot
picDisplay.Line (Cont(nc - 2, 0), Cont(nc - 2, 1))-(Cont(nc - 1, 0), Cont(nc - 1, 1)), 0
picDisplay.DrawStyle = vbSolid
End If
If nc > 1 Then Redraw
End If
End Sub
Private Sub picDisplay_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Clicked(X, Y) > -1 Then
MousePointer = vbCrosshair
Else
MousePointer = vbDefault
End If
If Dragging = True Then
xv = Int(X): yv = Int(Y)
Cont(NewLocPoint, 0) = xv: Cont(NewLocPoint, 1) = yv
Redraw
End If
End Sub
Private Sub picDisplay_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
' End dragging operation
If Dragging = True Then
Dragging = False
Redraw
Label1.Caption = "Select new points or drag current ones"
End If
End Sub
Private Function Clicked(X, Y)
' Has the user clicked within the circle
' of a current point
For i = 0 To nc
xp = Cont(i, 0): yp = Cont(i, 1)
If Abs(xp - X) < 3 And Abs(yp - Y) < 3 Then
Clicked = i
Exit Function
End If
Next i
Clicked = -1
End Function
Sub Redraw()
'Redraws entire display
picDisplay.Cls
For i = 1 To nc
xv = Cont(i - 1, 0): yv = Cont(i - 1, 1)
picDisplay.Circle (xv, yv), 2, 255
picDisplay.Print i
Next i
picDisplay.DrawStyle = vbDot
For i = 0 To nc - 2
picDisplay.Line (Cont(i, 0), Cont(i, 1))-(Cont(i + 1, 0), Cont(i + 1, 1)), 0
Next i
picDisplay.DrawStyle = vbSolid
DrawBezier Smooth
End Sub
Sub DrawBezier(du)
' Draws a Bezier curve using the control points given in
' Cont(...). Uses delta u steps
n = nc - 1 'N = number of control points -1
If n < 1 Then
MsgBox "Need more control points", vbInformation
Exit Sub
End If
picDisplay.PSet (Cont(0, 0), Cont(0, 1)) 'Plot the first point
For u = 0 To 1 Step du
X = 0: Y = 0
For k = 0 To n ' For each control point
bv = B(k, n, u) ' Calculate blending function
X = X + Cont(k, 0) * bv
Y = Y + Cont(k, 1) * bv
Next k
picDisplay.Line -(X, Y), 65535 ' Draw to the point
Next u
picDisplay.Line -(Cont(n, 0), Cont(n, 1)), 65535
End Sub