To ease the pain when implementing this for "arbitrary trajectory paths",
a decent graphics lib can be used, producing the following output:
To see the above work as an animation, please paste this code into an empty Form:
(after setting a reference to RC6 in your Project - download RC6BaseLibs at vbRichClient.com)
Code:
Option Explicit
Const BeadRadius = 5, BeadDistance = 20, BeadSpeed = 3
Private CC As cCairoContext 'our "form-filling" CairoContext
Private Trajectory As cCairoPath, WithEvents tmrAnim As cTimer
Private Sub Form_Load()
AutoRedraw = True: Caption = "Click Me, to change direction"
Set tmrAnim = New_c.Timer(30, True, True)
End Sub
Private Sub Form_Resize()
ScaleMode = vbPixels 'let's work in Pixel-Dimension with our Form (to match Cairo-Surface-coords)
Set CC = Cairo.CreateSurface(ScaleWidth, ScaleHeight).CreateContext 'create a form-covering surface-context
Set Trajectory = CreateLinePath 'create a "curved" trajectory-path, using a helper-routine
End Sub
Private Sub Form_Click()
tmrAnim.Tag = Not tmrAnim.Tag 'switch the direction-state within the timer-tag
End Sub
Sub ReDraw()
Static TD As Long, D#(), xOffs As Long
TD = Trajectory.CalculateDistances(D) 'get the total "walking-distance" of the trajectory
xOffs = (xOffs + IIf(tmrAnim.Tag, 1, -1) * BeadSpeed) Mod TD 'ensure "Animation-Progress"
Dim i As Long, x As Long, Beads(0 To 9) As cCairoPath
For i = 0 To UBound(Beads) 'now we create the "string of pearls" as separate, trajectory-projected Bead-paths
x = xOffs + i * BeadDistance
If x < 0 Then x = x + TD
If x > TD Then x = x Mod TD
CC.Arc x, 0, BeadRadius 'shifting only the x-Coord is sufficient (for the projection-call that follows)
Set Beads(i) = CC.CopyPath 'create the next path-object from what we've just drawn
Beads(i).ProjectPathData_Using Trajectory 'and "project its coordinates" along the trajectory-path
CC.ClearPath 'cleanup the last path-definition from the context
Next
CC.Paint 1, Cairo.CreateCheckerPattern 'ensure a form-covering background on the BackBuffer-CairoSurface
CC.Save 'because we use a transform-call below, we buffer the original coord-sys
CC.TranslateDrawings CC.Surface.Width / 2, CC.Surface.Height / 2 'shift to the center of the form-covering surface
CC.AppendPath Trajectory 'append the trajectory-path
CC.Stroke , Cairo.CreateSolidPatternLng(vbRed) 'and render only its "outline" with a solid color
For i = 0 To UBound(Beads): CC.AppendPath Beads(i): Next 'append all Bead-Path-Objects
CC.Fill , Cairo.CreateSolidPatternLng(vbBlue, 0.6) 'and fill them with 60% blue
CC.Restore 'restore the original coord-sys
CC.Surface.DrawToDC hDC: If AutoRedraw Then Refresh
End Sub
Function CreateLinePath() As cCairoPath
Dim dx: dx = CC.Surface.Width * 0.35
Dim dy: dy = CC.Surface.Height * 0.3
Dim P(0 To 13) As Double 'allocate space for 7 points (x at even, y at odd indexes)
P(0) = 0: P(1) = 0 '<- center-point of the "Lissajous-like figure eight"
P(2) = dx: P(3) = dy
P(4) = dx: P(5) = -dy
P(6) = 0: P(7) = 0
P(8) = -dx: P(9) = dy
P(10) = -dx: P(11) = -dy
P(12) = 0: P(13) = 0 'and back to the center
CC.Polygon P, False, splHeavy, True, True 'render a Polygon-Spline across-these 7 points
Set CreateLinePath = CC.CopyPath(True): CC.ClearPath
End Function
Private Sub tmrAnim_Timer()
ReDraw
End Sub
HTH
Olaf
Last edited by Schmidt; Oct 1st, 2022 at 05:22 PM.