Results 1 to 2 of 2

Thread: Beads flow on a line/ Balls moving on a line

  1. #1

    Thread Starter
    New Member
    Join Date
    Oct 2015
    Posts
    3

    Beads flow on a line/ Balls moving on a line

    Hello everyone

    The code shows the balls moving on a line. I wanted to show the flow of balls on the line like the electric current flowing.

    But when the line is titled in any other angle, then it does not work as wanted.

    This is the extension of the Lavolpe code.

    Any idea to improve this and show the balls moving on the line.
    Attached Files Attached Files

  2. #2
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: Beads flow on a line/ Balls moving on a line

    To ease the pain when implementing this for "arbitrary trajectory paths",
    a decent graphics lib can be used, producing the following output:

    Name:  TrajectoryAnim.png
Views: 110
Size:  44.6 KB

    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width