Results 1 to 10 of 10

Thread: [RESOLVED] Making a Shape move along a Line

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Sep 2013
    Posts
    190

    Resolved [RESOLVED] Making a Shape move along a Line

    Using the Line tool, I have drawn a line on my form. I also have a Shape on my form. The shape starts at either end, but I need to have it move along the Line to the other end. The Shape needs to follow the Line, no matter the angle it is drawn. How do I do this?

    Using VB6 with Windows7.

    Name:  vbf1.jpg
Views: 1694
Size:  15.9 KB

  2. #2
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,049

    Re: Making a Shape move along a Line

    Try this formula. Ensure you pass the distance to move in appropriate scale units of the Line's container. For simplicity, suggest just changing the line's container (form, picbox, whatever) to a ScaleMode of vbPixels. The DistanceToMove parameter is number of units from the line's X1,Y1 point. Obviously you will want to center the shape over the returned NewX,NewY coordinates.

    Code:
    Private Sub GetNextPoint(Path As VB.Line, DistanceToMove As Long, NewX As Single, NewY As Single)
    
    ' DistanceToMove is number of ScaleUnits (twips,pixels,etc) to move from Path's X1,Y1 properties
    ' NewX & NewY will be the coordinates relative to Path's X1,Y1 & DistanceToMove
    
    Dim dx As Single, dy As Single
    Dim sLen As Single
    
    dx = Path.X2 - Path.X1
    dy = Path.Y2 - Path.Y1
    sLen = Sqr(dx * dx + dy * dy)
    
    NewY = (dy * DistanceToMove) / sLen + Path.Y1
    NewX = (dx * DistanceToMove) / sLen + Path.X1
    
    End Sub
    Edited: I didn't add any logic to test whether your distance exceeds the line length. You can test that yourself. Just calc the length as shown in the subroutine & ensure you don't pass a distance greater than that. Or, within the subroutine, if DistanceToMove > sLen then return Path.X2,Path.Y2 as the NewX,NewY values

    As-is, the line is used just for a starting point, direction & angle, there is no stopping point in the logic. You can traverse that line in either direction at an infinite +/- DistanceToMove

    After re-reading your post, shape can start at either end? This changes the logic within the subroutine. Modified below:
    Code:
    Private Sub GetNextPoint(Path As VB.Line, ByVal DistanceToMove As Long, StartAtX1Y1 As Boolean, _
                                 NewX As Single, NewY As Single)
    
    ' DistanceToMove is number of ScaleUnits (twips,pixels,etc) to move from Path's X1,Y1 properties
    ' NewX & NewY will be the coordinates relative to Path's X1,Y1 & DistanceToMove
    ' StartAtX1Y1 is true if starting point is X1,Y1 else False if starting from X2,Y2
    
    Dim dx As Single, dy As Single
    Dim sLen As Single
    
        dx = Path.X2 - Path.X1
        dy = Path.Y2 - Path.Y1
        sLen = Sqr(dx * dx + dy * dy)
        If StartAtX1Y1 = False Then DistanceToMove = sLen - DistanceToMove
        NewY = (dy * DistanceToMove) / sLen + Path.Y1
        NewX = (dx * DistanceToMove) / sLen + Path.X1
    
    End Sub
    Last edited by LaVolpe; Nov 16th, 2014 at 01:38 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  3. #3
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,921

    Re: Making a Shape move along a Line

    Quote Originally Posted by Conroy Vanderbluff View Post
    Using the Line tool, I have drawn a line on my form. I also have a Shape on my form. The shape starts at either end, but I need to have it move along the Line to the other end. The Shape needs to follow the Line, no matter the angle it is drawn. How do I do this?
    There's a lot of VB6-modules out there on the Web, which define basic routines for 2D-Vector-Math.

    And you only need a few of those routines, to accomplish what you want -
    (below is a small Class-Module which defines such a "Subset of V-functions to begin with).

    Into a *.bas-Module, named modVector2D:
    Code:
    Option Explicit
    
    Sub vDraw(Cont, V As cV, Optional ByVal Radius& = 5, Optional ByVal Color& = vbBlue)
      Cont.FillColor = Color
      Cont.Circle (V.x, V.y), Radius, Color
    End Sub
    
    Function vInit(ByVal x As Double, ByVal y As Double) As cV
      Set vInit = New cV
      vInit.x = x
      vInit.y = y
    End Function
     
    Function vAdd(V1 As cV, V2 As cV) As cV
      Set vAdd = New cV
      vAdd.x = V1.x + V2.x
      vAdd.y = V1.y + V2.y
    End Function
    
    Function vSub(V1 As cV, V2 As cV) As cV
      Set vSub = New cV
      vSub.x = V1.x - V2.x
      vSub.y = V1.y - V2.y
    End Function
    
    Function vMul(V As cV, ByVal Scalar As Double) As cV
      Set vMul = New cV
      vMul.x = V.x * Scalar
      vMul.y = V.y * Scalar
    End Function
    
    Function vNeg(V As cV) As cV
      Set vNeg = New cV
      vNeg.x = -V.x
      vNeg.y = -V.y
    End Function
    
    Function vLength(V As cV) As Double
      vLength = Sqr((V.x * V.x) + (V.y * V.y))
    End Function
    
    Function vDist(V1 As cV, V2 As cV) As Double
      vDist = vLength(vSub(V1, V2))
    End Function
     
    Function vDotProd(V1 As cV, V2 As cV) As Double
      vDotProd = (V1.x * V2.x) + (V1.y * V2.y)
      If vDotProd = 0 Then vDotProd = 1
    End Function
     
    Function vNorm(V As cV) As cV
    Dim Length As Double
      Length = vLength(V)
      Set vNorm = New cV
      If Length Then vNorm.x = V.x / Length
      If Length Then vNorm.y = V.y / Length
    End Function
    The above Module-Code needs to be accompanied by a small Project-Private-Class, named cV:
    Code:
    Option Explicit
     
    Public x As Double, y As Double
     
    Public Function Clone() As cV
      Set Clone = New cV
          Clone.x = x
          Clone.y = y
    End Function
    Then it's a good idea to encapsulate certain Objects and their behaviour in a Class as well...
    For your case, an encapsulation of the three Point-Elements (A, B and the moving Obj) -
    all in one Class, would look this way:

    Into a Project-Private-Class, named cObj:
    Code:
    Option Explicit
    
    Public Enum eFromTo
      trvAB
      trvBA
    End Enum
    
    Public vPos As cV          'the location-Vector of our Obj
    Public vDir As cV          'the (normalized) direction-Vector of our Obj
    Public vA As cV, vB As cV  'location-Vectors of points A and B
    Public Speed As Double     'the travel-speed of our Obj
    Public FromTo As eFromTo   'the travel-direction of our Obj
     
    Public Sub CalcNewPos()
      If FromTo = trvAB Then Set vDir = vNorm(vSub(vB, vA)) Else Set vDir = vNorm(vSub(vA, vB))
      Set vPos = vAdd(vPos, vMul(vDir, Speed))
    End Sub
    
    Public Function ABDist() As Double
      ABDist = vDist(vA, vB)
    End Function
    
    Public Function TravelDist() As Double
      TravelDist = vDist(vPos, IIf(FromTo = trvAB, vA, vB))
    End Function
    
    Public Sub SwitchTravelDirection()
      FromTo = IIf(FromTo = trvAB, trvBA, trvAB)
    End Sub
    
    Sub DrawOn(Cont)
      Cont.Line (vA.x, vA.y)-(vB.x, vB.y), vbMagenta
      vDraw Cont, vPos, 16, vbRed
      vDraw Cont, vA, 8, vbBlue
      vDraw Cont, vB, 8, vbGreen
    End Sub
    As you can see - due to the included Vector-Math-HelperCode, the code within that Class is lean and understandable.

    What now remains, is to bring all together in a Form:
    Code:
    Option Explicit
    
    Private WithEvents TRedraw As vB.Timer
    
    Private Obj1 As New cObj, Obj2 As New cObj
    
    Private Sub Form_Load() 'just some Inits
      Set TRedraw = Controls.Add("VB.Timer", "TRedraw"): TRedraw.Interval = 20
      AutoRedraw = True
      ScaleMode = vbPixels
      FillStyle = 0
      
      Set Obj1.vA = vInit(50, 50) 'init the Movement-restriction-points A
      Set Obj1.vB = vInit(400, 300) '...and B
      Set Obj1.vPos = Obj1.vA.Clone 'init our Obj-Pos to the same location-Vector as Point vA
          Obj1.FromTo = trvAB 'define the current travel-direction as "from A-To-B"
          Obj1.Speed = 4 'and the Speed of the Object
      
      Set Obj2.vA = vInit(200, 300) 'init the Movement-restriction-points A
      Set Obj2.vB = vInit(300, 50) '...and B
      Set Obj2.vPos = Obj2.vB.Clone 'init our Obj-Pos to the same location-Vector as Point vB
          Obj2.FromTo = trvBA 'define the current travel-direction as "from B-To-A"
          Obj2.Speed = 7 'and the Speed of the Object
    End Sub
    
    Private Sub TRedraw_Timer()
      CheckAndMove Obj1
      CheckAndMove Obj2
     
      RedrawAll
    End Sub
    
    Private Sub CheckAndMove(Obj As cObj)
      If Obj.TravelDist > Obj.ABDist Then Obj.SwitchTravelDirection
      Obj.CalcNewPos 'reposition, according to the current travel-direction and speed
    End Sub
    
    Private Sub RedrawAll()
      Cls
      Obj1.DrawOn Me
      Obj2.DrawOn Me
    End Sub
    And the result is two Objects which are rendered on the Form, bouncing between
    their A and B-Points with different Speeds.



    Olaf
    Last edited by Schmidt; Nov 16th, 2014 at 01:40 PM.

  4. #4

    Thread Starter
    Addicted Member
    Join Date
    Sep 2013
    Posts
    190

    Re: Making a Shape move along a Line

    Schmidt, I am getting a lot of errors using your code, specifically

    Code:
    Private Obj1 As New cObj, Obj2 As New cObj
    LaVolpe, I will try to use your code, though it seems very general.

    Thank you both.

  5. #5

    Thread Starter
    Addicted Member
    Join Date
    Sep 2013
    Posts
    190

    Re: Making a Shape move along a Line

    LaVolpe, can you explain how I would use your code?

  6. #6
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,049

    Re: Making a Shape move along a Line

    Quote Originally Posted by Conroy Vanderbluff View Post
    LaVolpe, I will try to use your code, though it seems very general.

    Thank you both.
    It's generic & simple for traversing lines at a constant speed (i.e., 1 pixel at an interval). I have routines that can traverse, arcs, & bezier curves, basically any contiguous path. Way more complicated than what you requested. The code I posted (later modified for reverse direction) works for straight lines
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  7. #7
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,921

    Re: Making a Shape move along a Line

    Quote Originally Posted by Conroy Vanderbluff View Post
    Schmidt, I am getting a lot of errors using your code, specifically

    Code:
    Private Obj1 As New cObj, Obj2 As New cObj
    You will need to get the Class-Names right in your Test-Project...
    I've edited my earlier posting, to make these ClassNames more "visually present".

    To summarize again - you will need (in a new StdExe-Project)
    - the usual Form (the default-name Form1 is sufficient)
    - a *.bas Module for the Vector-Math-Functions (name it as you like)
    - a private Class-Module, named cV
    - a private Class-Module, named cObj

    Olaf

  8. #8
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,049

    Re: Making a Shape move along a Line

    Quote Originally Posted by Conroy Vanderbluff View Post
    LaVolpe, can you explain how I would use your code?
    Sample below is using the updated version I posted back in my first reply

    Simple. Assume the form's ScaleMode is pixels else need to convert distance to form's scalemode
    - move 20 pixels from start of line
    Code:
    Dim NewX as Single, NewY as Single
    
        GetNextPoint Line1, 20, True, Newx, Newy
        Shape1.Move NewX - Shape1.Width \ 2, NewY - Shape1.Height \ 2
    - move 20 pixels from end of line
    Code:
    Dim NewX as Single, NewY as Single
    
        GetNextPoint Line1, 20, False, Newx, Newy
        Shape1.Move NewX - Shape1.Width \ 2, NewY - Shape1.Height \ 2
    edited: a complete sample
    1) On a form, add a line control, default name of Line1. Draw it as you wish
    2) Add a timer & command button to the form, leaving default names. Ensure button doesn't overlap line
    3) Add a shape control to the form, default name
    4) In the command button's click event add this
    Code:
    If Timer1.Tag = "" Then ' start animation
        Timer1.Tag = 0 ' starting distance
        If MsgBox("Start animation from start of line", vbYesNo + vbQuestion, "Direction?") = vbYes Then
            Line1.Tag = "1"
        Else
            Line1.Tag = "0"
        End If
        Me.ScaleMode = vbPixels
        Timer1.Interval = 15
        Timer1.Enabled = True
    Else ' stop animation & reset
        Timer1.Enabled = False
        Timer1.Tag = ""
    End If
    5) In the Timer1_Event add this code
    Code:
    Dim x As Single, y As Single
    GetNextPoint Line1, Val(Timer1.Tag), CBool(Val(Line1.Tag)), x, y
    Shape1.Move x - Shape1.Width \ 2, y - Shape1.Height \ 2
    Timer1.Tag = Val(Timer1.Tag) + 1
    6) And here's the same modified routine from post #2. Add it to your form
    Code:
    Private Sub GetNextPoint(Path As VB.Line, ByVal DistanceToMove As Long, StartAtX1Y1 As Boolean, Newx As Single, Newy As Single)
    
    ' DistanceToMove is number of ScaleUnits (twips,pixels,etc) to move from Path's X1,Y1 properties
    ' NewX & NewY will be the coordinates relative to Path's X1,Y1 & DistanceToMove
    
    Dim dx As Single, dy As Single
    Dim sLen As Single
    
        dx = Path.X2 - Path.X1
        dy = Path.Y2 - Path.Y1
        sLen = Sqr(dx * dx + dy * dy)
        If StartAtX1Y1 = False Then DistanceToMove = sLen - DistanceToMove
        Newy = (dy * DistanceToMove) / sLen + Path.Y1
        Newx = (dx * DistanceToMove) / sLen + Path.X1
    
    End Sub
    Now run the project & click the button to start/stop/reset animation
    Last edited by LaVolpe; Nov 16th, 2014 at 04:05 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  9. #9

    Thread Starter
    Addicted Member
    Join Date
    Sep 2013
    Posts
    190

    Re: [RESOLVED] Making a Shape move along a Line

    Resolved. Thanks, LaVolpe!

  10. #10
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,049

    Re: [RESOLVED] Making a Shape move along a Line

    Quote Originally Posted by Conroy Vanderbluff View Post
    Resolved. Thanks, LaVolpe!
    Welcome. Be sure to test whether your shape slides off the line if required (distance < 0 or distance > line length)
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

Tags for this Thread

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