Results 1 to 34 of 34

Thread: VB6 The line returned when it hit the wall

  1. #1

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    VB6 The line returned when it hit the wall

    Hello my friends, I want a simple code that returns at the same angle when a line hits the walls.
    Name:  1.jpg
Views: 651
Size:  13.2 KB
    Name:  2.jpg
Views: 631
Size:  15.7 KB
    Thanks . Code for vb6

  2. #2
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,582

    Re: VB6 The line returned when it hit the wall

    Just invert the Y value when you hit the top or bottom, and invert the X value when you hit the left or right.
    "Anyone can do any amount of work, provided it isn't the work he is supposed to be doing at that moment" Robert Benchley, 1930

  3. #3

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    Quote Originally Posted by passel View Post
    Just invert the Y value when you hit the top or bottom, and invert the X value when you hit the left or right.
    Thanks for the reply .
    In your opinion, the return of the exact line goes back to the same angle
    How many codes I tried in this way were not accurate
    If you do not mind, you can put the source code here, thank you

  4. #4
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,872

    Re: VB6 The line returned when it hit the wall

    If you post what you already have, maybe we can help you to adapt your code.

  5. #5
    PowerPoster
    Join Date
    Nov 2017
    Posts
    3,116

    Re: VB6 The line returned when it hit the wall

    Why don't you post your code and then suggestions can be made. That's how things generally work here.

  6. #6
    Angel of Code Niya's Avatar
    Join Date
    Nov 2011
    Posts
    8,598

    Re: VB6 The line returned when it hit the wall

    Post the code. We don't know if you're talking about movement or simply drawing lines.
    Treeview with NodeAdded/NodesRemoved events | BlinkLabel control | Calculate Permutations | Object Enums | ComboBox with centered items | .Net Internals article(not mine) | Wizard Control | Understanding Multi-Threading | Simple file compression | Demon Arena

    Copy/move files using Windows Shell | I'm not wanted

    C++ programmers will dismiss you as a cretinous simpleton for your inability to keep track of pointers chained 6 levels deep and Java programmers will pillory you for buying into the evils of Microsoft. Meanwhile C# programmers will get paid just a little bit more than you for writing exactly the same code and VB6 programmers will continue to whitter on about "footprints". - FunkyDexter

    There's just no reason to use garbage like InputBox. - jmcilhinney

    The threads I start are Niya and Olaf free zones. No arguing about the benefits of VB6 over .NET here please. Happiness must reign. - yereverluvinuncleber

  7. #7

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    link download

    Name:  bouncing_balls1.png
Views: 547
Size:  8.4 KB

    Download the file. Can I explain more?
    I mean draw the line until it hits the wall and returns at the same angle
    link download
    Last edited by Mojtaba; Dec 18th, 2020 at 12:55 PM.

  8. #8
    PowerPoster SamOscarBrown's Avatar
    Join Date
    Aug 2012
    Location
    NC, USA
    Posts
    9,145

    Re: VB6 The line returned when it hit the wall

    Why not ZIP your program/code and ATTACH that zipped file to the post?...lotta folks don't open RAR files (at least "I" don't).
    Sam I am (as well as Confused at times).

  9. #9

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    Why? For what reason ! Problems the rar file?

    Do not pay too much attention to my code at all because it is an incomplete and simple thing just to convey the meaning
    Attached Files Attached Files
    Last edited by Mojtaba; Dec 18th, 2020 at 07:15 PM.

  10. #10
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,582

    Re: VB6 The line returned when it hit the wall

    Quote Originally Posted by Mojtaba View Post
    link download

    Name:  bouncing_balls1.png
Views: 547
Size:  8.4 KB

    Download the file. Can I explain more?
    I mean draw the line until it hits the wall and returns at the same angle
    link download
    And that is what I told you.
    If you're drawing a line, you're adding a constant X and Y value to the previous point to get to another point in the line.
    Since the Incident Angle and the Angle of Reflection are equal, just a negative reflection of the other, then the change in X or Y is also equal, but one is the reflection of the other.
    So you change the sign of delta X or Y, but the magnitude will state the same.
    "Anyone can do any amount of work, provided it isn't the work he is supposed to be doing at that moment" Robert Benchley, 1930

  11. #11
    The Idiot
    Join Date
    Dec 2014
    Posts
    2,721

    Re: VB6 The line returned when it hit the wall

    theres no gravity or friction, so we could say the ball is moving like in space, it need "force" and since its 2D we only need x and y.
    lets push the ball, lets say xforce=1 and yforce=1 and time interval of 1/second.

    movement is x =x + xforce and y = y + yforce

    now u need to create a way to determine the walls or hit-area. this can be a bit complicated, but if everything is lines and we know the radius of the ball, we can make use that to determine when the ball hits the walls.

    nx = x + xforce
    ny = y + yforce

    if nx + r => width it means the ball is about to go through the wall, so we need to bounce it back, simple by making xforce = -1
    if ny + r => height the same but height
    if nx - r <= 0 for the left wall, and return xforce = 1
    if ny - r <= 0 for the top wall

  12. #12
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,582

    Re: VB6 The line returned when it hit the wall

    Since your code is using line controls and not drawing lines, that complicates things.
    I guess the question is how you want the user interface to work, and how many lines do you want to draw.

    Here, your example is change so that mousemove is just selecting the x value of where the first line ends, and the y value of the first line is set to the bottom of the form, so your first line draws from the start location to the bottom of the form.
    The change in X is noted and just added to the X value to "double the angle", so is a reflection off the bottom. The starting Y is used as the end of the second line, so the slope of the line matches the reflection angle.

    I don't know if that helps at all.
    Code:
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    
      Dim dx As Single
      dx = x - Line1.X1
    
      Line1.X2 = x
      Line1.Y2 = ScaleHeight
    
      Line2.X1 = x
      Line2.Y1 = ScaleHeight
    
      Line2.X2 = x + dx
      Line2.Y2 = Line1.Y1
    
    End Sub
    "Anyone can do any amount of work, provided it isn't the work he is supposed to be doing at that moment" Robert Benchley, 1930

  13. #13

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    This is exactly what I mean
    This is great
    Just add the code for the up and down directions, thank you



    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

    Dim dx As Single
    dx = x - Line1.X1

    Line1.X2 = x
    Line1.Y2 = ScaleHeight

    Line2.X1 = x
    Line2.Y1 = ScaleHeight

    Line2.X2 = x + dx
    Line2.Y2 = Line1.Y1

    End Sub
    Last edited by Mojtaba; Dec 19th, 2020 at 01:43 PM.

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

    Re: VB6 The line returned when it hit the wall

    FWIW, below is a simple snippet which renders a bouncing ball - using the simple reflection-formula, passel already gave you...
    Though the problem is now already split into: BallRadius 'R', BallPosition-Vector 'c' and a BallSpeedVector 'v' ...
    (because one usually wants a given object to move with a certain speed)

    Code:
    Option Explicit
     
    Private WithEvents TRender As VB.Timer 'for dynamic creation
    
    Private Type tV2D
      x As Single
      y As Single
    End Type
    
    Private R!, c As tV2D, v As tV2D 'Ball-Radius, Ball-Center and Ball-Velocity in Pixels per TimerStep
     
    Private Sub Form_Load()
       'Inits for our Form-Canvas
       AutoRedraw = True: ScaleMode = vbPixels
       FillColor = vbYellow: FillStyle = vbFSSolid
    
       R = 16               'set the Radius
       c.x = 100: c.y = 100 'set the center-point
       v.x = 200: v.y = 200 'set the speed-vector
     
       Set TRender = Controls.Add("VB.Timer", "TRender") 'create the RenderLoop-Timer dynamically...
           TRender.Interval = 10 '... set a small interval
    End Sub
     
    Private Sub TRender_Timer()
      Cls
        DrawBasedOn GetTimeDelta(Timer) 'determine a time-delta, to achieve constant speed
      Refresh
    End Sub
    
    Function GetTimeDelta(ByVal curT As Single)
      Static lastT: If lastT = 0 Then lastT = Timer
      GetTimeDelta = curT - lastT: lastT = curT
    End Function
    
    Sub DrawBasedOn(ByVal dT As Single) 'ensure constant speed per "ds = v * dT"
       c.x = c.x + v.x * dT
       c.y = c.y + v.y * dT
       
       If c.x < R Then v.x = -v.x: c.x = R 'left border-collision
       If c.x > ScaleWidth - R Then v.x = -v.x: c.x = ScaleWidth - R 'right border-collision
     
       If c.y < R Then v.y = -v.y: c.y = R 'top border-collision
       If c.y > ScaleHeight - R Then v.y = -v.y: c.y = ScaleHeight - R 'bottom border-collision
       
       Circle (c.x, c.y), R, &HD0D0D0
    End Sub
    For more advanced "applied physics", the usage of a physics-engine helps to shorten code significantly...
    There's an example of this category in the codebank: https://www.vbforums.com/showthread....hysics-Engine)
    (the most recent Demo-Zip in that CodeBank-thread is sitting in post #9)

    HTH

    Olaf

  15. #15

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    No, I do not mean the movement of the ball. See the movement and return of the line when it hits the wall of the code above

  16. #16

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    https://bayanbox.ir/view/79198492301...9-20-00-19.mp4

    Just like this tool

    Watch the movie
    Last edited by Mojtaba; Dec 19th, 2020 at 11:54 AM.

  17. #17
    The Idiot
    Join Date
    Dec 2014
    Posts
    2,721

    Re: VB6 The line returned when it hit the wall

    that has nothing to do with ball bouncing, but more of a Trajectory.
    without gravity or other forces applied, this is quite easy.
    mouse x/y is the starting position, the center position that is fixed, will be used to know the x/y factors and after that u calculate the edges.
    a recursive function can be used to allow the line to continue until a exit condition is met.
    I dont make any examples because I know others will do it, without giving u a chance to figure it out yourself.

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

    Re: VB6 The line returned when it hit the wall

    Quote Originally Posted by Mojtaba View Post
    No, I do not mean the movement of the ball. See the movement and return of the line when it hits the wall of the code above
    It's the same thing basically ... just:
    - don't paint the ball-circle
    - but step along the initial direction-vector (with much more simulated speed if you want)
    - then gather the newly calculated coords of the center-point after each wall collision
    - into a Polygon-Array or a Collection
    - and stop gathering the resulting trajectory-coords in that path after a certain "depth of collisions"

    Olaf

  19. #19

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    Thank you dear friend for taking the time to answer, but It's too complicated and not what I want

    If you watched movie ، See also this project

    The file is attached
    Attached Files Attached Files

  20. #20
    The Idiot
    Join Date
    Dec 2014
    Posts
    2,721

    Re: VB6 The line returned when it hit the wall

    its the bare minimum, if u follow what Olaf posted.
    its impossible to make it smaller. u need to do some calculations, theres no AI that understand what u need and will do it for u.

    the video that u posted, needs a bit of coding to recreate that.
    that video also require u to "hold and release" the circle, so u also need to work on the mouse-triggers.
    sure, that circle can be the starting point, so u can start with that. place a circle anywhere and make the center point as the starting x/y. make another circle, that will be static and place that in the middle, that x/y will be the reference point, so u know the trajectory.
    and lastly u create the lines, since u know the center point and the rectangle, and if the rectangle has a fixed Rect, u can easily calculate the line length.
    theres no shortcuts here.

  21. #21

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    When eating an object, return the code. How to do this on the line other than x, y
    Because x, y is the starting and ending point of a line
    How to use the scale on the line ?

  22. #22
    Fanatic Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    678

    Re: VB6 The line returned when it hit the wall

    Quote Originally Posted by Mojtaba View Post
    https://bayanbox.ir/view/79198492301...9-20-00-19.mp4

    Just like this tool

    Watch the movie
    To obtain something like the movie:

    - create an empty TXT file

    - copy and paste the code

    - rename the TEXT File to "filename.FRM" (and double click to open it)

    Code:
    VERSION 5.00
    Begin VB.Form Form1 
       Caption         =   "Form1"
       ClientHeight    =   7110
       ClientLeft      =   120
       ClientTop       =   465
       ClientWidth     =   9855
       LinkTopic       =   "Form1"
       ScaleHeight     =   474
       ScaleMode       =   3  'Pixel
       ScaleWidth      =   657
       StartUpPosition =   3  'Windows Default
       Begin VB.Shape Shape 
          FillStyle       =   0  'Solid
          Height          =   270
          Index           =   3
          Left            =   3120
          Shape           =   2  'Oval
          Top             =   960
          Width           =   270
       End
       Begin VB.Line MyLine 
          Index           =   3
          X1              =   -16
          X2              =   114
          Y1              =   152
          Y2              =   368
       End
       Begin VB.Shape Shape 
          FillStyle       =   0  'Solid
          Height          =   270
          Index           =   2
          Left            =   2520
          Shape           =   2  'Oval
          Top             =   960
          Width           =   270
       End
       Begin VB.Line MyLine 
          Index           =   2
          X1              =   8
          X2              =   138
          Y1              =   112
          Y2              =   328
       End
       Begin VB.Line MyLine 
          Index           =   1
          X1              =   0
          X2              =   130
          Y1              =   0
          Y2              =   216
       End
       Begin VB.Shape Shape 
          FillStyle       =   0  'Solid
          Height          =   270
          Index           =   1
          Left            =   2040
          Shape           =   2  'Oval
          Top             =   720
          Width           =   270
       End
       Begin VB.Shape Shape 
          FillStyle       =   0  'Solid
          Height          =   270
          Index           =   0
          Left            =   1560
          Shape           =   2  'Oval
          Top             =   1560
          Width           =   270
       End
       Begin VB.Shape Shape2 
          FillStyle       =   0  'Solid
          Height          =   270
          Left            =   4350
          Shape           =   2  'Oval
          Top             =   3075
          Width           =   270
       End
       Begin VB.Line MyLine 
          Index           =   0
          X1              =   297
          X2              =   427
          Y1              =   214
          Y2              =   430
       End
    End
    Attribute VB_Name = "Form1"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    Option Explicit
    ' Roberto Mior
    ' reexre
    
    Private Function LinesIntersect(L1X1!, L1Y1!, _
                                    L1X2!, L1Y2!, _
                                    L2X1!, L2Y1!, _
                                    L2X2!, L2Y2!, RX!, RY!) As Boolean
    
        Dim s1_x!, s1_y!, s2_x!, s2_y!
        Dim s!, t!
        Dim den       As Single
        s1_x = L1X2 - L1X1: s1_y = L1Y2 - L1Y1
        s2_x = L2X2 - L2X1: s2_y = L2Y2 - L2Y1
    
        den = (-s2_x * s1_y + s1_x * s2_y)
        If den Then
            den = 1! / den
            s = (-s1_y * (L1X1 - L2X1) + s1_x * (L1Y1 - L2Y1)) * den
            If s > 0! Then
                If s < 1! Then
                    t = (s2_x * (L1Y1 - L2Y1) - s2_y * (L1X1 - L2X1)) * den
                    If t > 0! Then
                        If t < 1! Then
                            ' Collision detected
                            RX = L1X1 + (t * s1_x)
                            RY = L1Y1 + (t * s1_y)
                            LinesIntersect = True
                        End If
                    End If
                End If
            End If
        End If
    
    End Function
    
    Private Function LineIntersectRect(x1!, y1!, x2!, y2!, RX!, RY!, Invert As Long)
        Dim XX!, YY!
        XX! = ScaleWidth - 9
        YY! = ScaleHeight - 9
        ' horizontal
        If LinesIntersect(x1, y1, x2, y2, 9, 9, XX, 9, RX, RY) Then Invert = -1: Exit Function
        If LinesIntersect(x1, y1, x2, y2, 9, YY, XX, YY, RX, RY) Then Invert = -1: Exit Function
        'Vertical
        If LinesIntersect(x1, y1, x2, y2, 9, 9, 9, YY, RX, RY) Then Invert = 1: Exit Function
        If LinesIntersect(x1, y1, x2, y2, XX, 9, XX, YY, RX, RY) Then Invert = 1: Exit Function
    
    End Function
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    
        Dim dx        As Single
        Dim dy        As Single
        Dim NewX      As Single
        Dim NewY      As Single
    
        Dim D         As Single
        Dim RX!, RY!
        Dim Invert    As Long
        Dim L         As Long
    
        If Button <> 2 Then
            For L = 0 To 3
                If L = 0 Then
                    dx = (x - MyLine(0).x1)
                    dy = (y - MyLine(0).y1)
                Else
                    If Invert = 1 Then
                        dx = -(MyLine(L - 1).x1 - MyLine(L - 1).x2)
                        dy = (MyLine(L - 1).y1 - MyLine(L - 1).y2)
                    Else
                        dx = (MyLine(L - 1).x1 - MyLine(L - 1).x2)
                        dy = -(MyLine(L - 1).y1 - MyLine(L - 1).y2)
                    End If
                    MyLine(L).x1 = MyLine(L - 1).x2
                    MyLine(L).y1 = MyLine(L - 1).y2
                End If
    
                D = Sqr(dx * dx + dy * dy)
                If D Then
                    D = 1 / D
                    dx = dx * D
                    dy = dy * D
                    NewX = MyLine(L).x1 - dx * 2000    'Max screen
                    NewY = MyLine(L).y1 - dy * 2000
                    LineIntersectRect MyLine(L).x1, MyLine(L).y1, NewX, NewY, RX, RY, Invert
                    MyLine(L).x2 = RX
                    MyLine(L).y2 = RY
                    Shape(L).Left = RX - Shape(L).Width * 0.5
                    Shape(L).Top = RY - Shape(L).Height * 0.5
                End If
            Next
    
        Else
            MyLine(0).x1 = x
            MyLine(0).y1 = y
            Shape2.Left = x - Shape2.Width * 0.5
            Shape2.Top = y - Shape2.Height * 0.5
        End If
    End Sub
    Right button to move starting point



    ---------------------------------------------------
    v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v
    EDIT:
    For fun and challenge with myself I wanted to try doing it with sloped contour lines (not just a rectangle).
    [To get the Form proceed same as above]

    Code:
    VERSION 5.00
    Begin VB.Form Form1 
       Caption         =   "Form1"
       ClientHeight    =   8280
       ClientLeft      =   120
       ClientTop       =   465
       ClientWidth     =   11280
       LinkTopic       =   "Form1"
       ScaleHeight     =   552
       ScaleMode       =   3  'Pixel
       ScaleWidth      =   752
       StartUpPosition =   1  'CenterOwner
       Begin VB.Line ContourLine 
          BorderWidth     =   2
          Index           =   0
          Visible         =   0   'False
          X1              =   320
          X2              =   520
          Y1              =   80
          Y2              =   40
       End
       Begin VB.Line MyLine 
          Index           =   4
          X1              =   -16
          X2              =   114
          Y1              =   192
          Y2              =   408
       End
       Begin VB.Shape ShapeMouse 
          BorderWidth     =   2
          Height          =   270
          Left            =   6600
          Shape           =   2  'Oval
          Top             =   1560
          Width           =   270
       End
       Begin VB.Line MyLine 
          Index           =   3
          X1              =   -8
          X2              =   122
          Y1              =   136
          Y2              =   352
       End
       Begin VB.Line MyLine 
          Index           =   2
          X1              =   0
          X2              =   130
          Y1              =   72
          Y2              =   288
       End
       Begin VB.Line MyLine 
          Index           =   1
          X1              =   0
          X2              =   130
          Y1              =   0
          Y2              =   216
       End
       Begin VB.Shape Shape 
          FillStyle       =   0  'Solid
          Height          =   120
          Index           =   0
          Left            =   1680
          Shape           =   2  'Oval
          Top             =   960
          Width           =   120
       End
       Begin VB.Shape Shape2 
          FillStyle       =   0  'Solid
          Height          =   270
          Left            =   4350
          Shape           =   2  'Oval
          Top             =   3075
          Width           =   270
       End
       Begin VB.Line MyLine 
          Index           =   0
          X1              =   297
          X2              =   427
          Y1              =   214
          Y2              =   430
       End
    End
    Attribute VB_Name = "Form1"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    Option Explicit
    ' Roberto Mior
    ' reexre
    
    Private Type tPoint
        x             As Single
        y             As Single
    End Type
    
    Private Type tLine
        P1            As Long
        P2            As Long
        nDX           As Single
        nDY           As Single
    End Type
    
    Private Lines()   As tLine
    Private Points()  As tPoint
    Private NL        As Long
    Private NP        As Long
    
    Private LineContact As Long
    
    Private Sub Addpoint(x!, y!)
        NP = NP + 1
        ReDim Preserve Points(NP)
        With Points(NP)
            .x = x
            .y = y
        End With
    End Sub
    
    Private Sub AddLine(P1&, P2&)
        Dim DX!, DY!, D!
        NL = NL + 1
        ReDim Preserve Lines(NL)
        With Lines(NL)
            .P1 = P1
            .P2 = P2
    
            DX = Points(P2).x - Points(P1).x
            DY = Points(P2).y - Points(P1).y
            D = 1 / Sqr(DX * DX + DY * DY)
    
            .nDX = -DY * D
            .nDY = DX * D
    
        End With
    
    End Sub
    
    Private Function LinesIntersect(L1X1!, L1Y1!, _
                                    L1X2!, L1Y2!, _
                                    L2X1!, L2Y1!, _
                                    L2X2!, L2Y2!, RX!, RY!) As Boolean
    
        Dim s1_x!, s1_y!, s2_x!, s2_y!
        Dim s!, t!
        Dim den       As Single
        s1_x = L1X2 - L1X1: s1_y = L1Y2 - L1Y1
        s2_x = L2X2 - L2X1: s2_y = L2Y2 - L2Y1
    
        den = (-s2_x * s1_y + s1_x * s2_y)
        If den Then
            den = 1! / den
            s = (-s1_y * (L1X1 - L2X1) + s1_x * (L1Y1 - L2Y1)) * den
            If s > 0! Then
                If s < 1! Then
                    t = (s2_x * (L1Y1 - L2Y1) - s2_y * (L1X1 - L2X1)) * den
                    If t > 0! Then
                        If t < 1! Then
                            ' Collision detected
                            RX = L1X1 + (t * s1_x)
                            RY = L1Y1 + (t * s1_y)
                            LinesIntersect = True
                        End If
                    End If
                End If
            End If
        End If
    
    End Function
    
    Private Function LineIntersectRect(x1!, y1!, x2!, y2!, RX!, RY!, Invert As Long)
        Dim XX!, YY!
        XX! = ScaleWidth - 9
        YY! = ScaleHeight - 9
        ' horizontal
        If LinesIntersect(x1, y1, x2, y2, 9, 9, XX, 9, RX, RY) Then Invert = -1: Exit Function
        If LinesIntersect(x1, y1, x2, y2, 9, YY, XX, YY, RX, RY) Then Invert = -1: Exit Function
        'Vertical
        If LinesIntersect(x1, y1, x2, y2, 9, 9, 9, YY, RX, RY) Then Invert = 1: Exit Function
        If LinesIntersect(x1, y1, x2, y2, XX, 9, XX, YY, RX, RY) Then Invert = 1: Exit Function
    
    End Function
    
    Private Function LineIntersectANY(x1!, y1!, x2!, y2!, RX!, RY!, rNDX!, rNDY!, PL&)
        Dim tRX!, tRY!
        Dim D!, minD!, DX!, DY!, I&
        Dim LX1!, LY1!, LX2!, LY2!
        Dim wLine&
        minD = 1E+32
    
        For I = 1 To NL
            If I <> PL Then    'EXLUDE PREVIOUS CONTACT
                With Lines(I)
                    LX1 = Points(.P1).x
                    LY1 = Points(.P1).y
                    LX2 = Points(.P2).x
                    LY2 = Points(.P2).y
                End With
    
                If LinesIntersect(x1, y1, x2, y2, LX1, LY1, LX2, LY2, tRX, tRY) Then
                    DX = tRX - x1
                    DY = tRY - y1
                    D = DX * DX + DY * DY
                    If D < minD Then
                        minD = D
                        RX = tRX
                        RY = tRY
                        wLine = I
                    End If
                End If
            End If
        Next
    
        rNDX = Lines(wLine).nDX
        rNDY = Lines(wLine).nDY
        PL = wLine
    
    End Function
    
    
    Private Sub Form_Load()
        Dim I         As Long
        Randomize Timer
        For I = 1 To 4
            Load Shape(I)
            Shape(I) = Shape(0)
            Shape(I).Visible = True
        Next
    End Sub
    
    Private Sub Form_Resize()
        Dim x         As Single
        Dim y         As Single
        Dim RndOFF!
        Dim I         As Long
    
        For I = NL To 1 Step -1
            Unload ContourLine(NL) '<<< ERROR !!! ( Correct way ? )
        Next
    
        NP = 0
        NL = 0
    
        RndOFF = 40
    
        For x = 30 To ScaleWidth - 30
            Addpoint x, 10 + Rnd * RndOFF
            x = x + 40 + Rnd * 20
        Next
        For y = 30 To ScaleHeight - 30
            Addpoint ScaleWidth - Rnd * RndOFF, y
            y = y + 40 + Rnd * 20
        Next
    
        For x = ScaleWidth - 30 To 10 Step -1
            Addpoint x, ScaleHeight - Rnd * RndOFF
            x = x - (40 + Rnd * 20)
        Next
        For y = ScaleHeight To 30 Step -1
            Addpoint 10 + Rnd * RndOFF, y
            y = y - (40 + Rnd * 20)
        Next
    
        '    Points(0) = Points(NP)
        For I = 1 To NP
            AddLine I, (I Mod NP) + 1
            Load ContourLine(I)
            ContourLine(I) = ContourLine(0)
            ContourLine(I).Visible = True
            ContourLine(I).x1 = Points(Lines(I).P1).x
            ContourLine(I).y1 = Points(Lines(I).P1).y
            ContourLine(I).x2 = Points(Lines(I).P2).x
            ContourLine(I).y2 = Points(Lines(I).P2).y
            
        Next
    End Sub
    
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    
        Dim DX        As Single
        Dim DY        As Single
        Dim NewX      As Single
        Dim NewY      As Single
    
        Dim D         As Single
        Dim RX!, RY!, rNDX!, rNDY!
        Dim Invert    As Long
        Dim L         As Long
        Dim dot!
        If Button <> 2 Then
            For L = 0 To MyLine.Count - 1
                If L = 0 Then
                    DX = MyLine(0).x1 - x
                    DY = MyLine(0).y1 - y
                Else
                    DX = (MyLine(L - 1).x2 - MyLine(L - 1).x1)
                    DY = (MyLine(L - 1).y2 - MyLine(L - 1).y1)
                    '-------------- REFLECT DX,DY along Normal
                    dot = DX * rNDX + DY * rNDY
                    DX = DX - rNDX * 2 * dot
                    DY = DY - rNDY * 2 * dot
    
                    MyLine(L).x1 = MyLine(L - 1).x2
                    MyLine(L).y1 = MyLine(L - 1).y2
                End If
    
                D = Sqr(DX * DX + DY * DY)
                If D Then
                    D = 1 / D
                    DX = DX * D
                    DY = DY * D
                    NewX = MyLine(L).x1 + DX * 2000    'Max screen
                    NewY = MyLine(L).y1 + DY * 2000
                    'LineIntersectRect MyLine(L).x1, MyLine(L).y1, NewX, NewY, RX, RY, Invert
    
                    LineIntersectANY MyLine(L).x1, MyLine(L).y1, NewX, NewY, RX, RY, rNDX, rNDY, LineContact
    
                    MyLine(L).x2 = RX
                    MyLine(L).y2 = RY
                    Shape(L).Left = RX - Shape(L).Width * 0.5
                    Shape(L).Top = RY - Shape(L).Height * 0.5
                End If
            Next
    
        Else
            MyLine(0).x1 = x
            MyLine(0).y1 = y
            Shape2.Left = x - Shape2.Width * 0.5
            Shape2.Top = y - Shape2.Height * 0.5
        End If
    
        ShapeMouse.Left = x - ShapeMouse.Width * 0.5
        ShapeMouse.Top = y - ShapeMouse.Height * 0.5
    
    End Sub

  23. #23

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Resolved Re: VB6 The line returned when it hit the wall

    Excellent
    Thank you very much

  24. #24

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    ♠ Roberto Mior Reexre ♠
    I have another question for you
    Much easier than the previous question
    Other friends can also answer the body. Thank you. I said because this question is related to this article, I should ask here
    link download
    Watch the movie
    Two circles on the line that are still on the line as the line moves
    Last edited by Mojtaba; Dec 22nd, 2020 at 10:03 AM.

  25. #25
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,872

    Re: VB6 The line returned when it hit the wall

    What kind of tool are you trying to mimic?
    That question has nothing to do with the original question.

  26. #26

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    A guide tool
    And this question is related to the previous question

  27. #27
    Fanatic Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    678

    Re: VB6 The line returned when it hit the wall

    Quote Originally Posted by Mojtaba View Post
    ♠ Roberto Mior Reexre ♠
    I have another question for you
    Much easier than the previous question
    Other friends can also answer the body. Thank you. I said because this question is related to this article, I should ask here
    link download
    Watch the movie
    Two circles on the line that are still on the line as the line moves
    I don't know if I understand well the question.

    If you want a circle to stay at a certain distance from one of the point of a line (along it):

    Let's assume line points are X1 Y1 - X2 Y2
    and you want your circle to stay at a certain distance STAYAT from point X1 Y1 along the line (direction).

    Code:
    '---First of all we have to normalize the line direction
     DX = X2 - X1
     DY = Y2 - Y1
     D = sqr(DX * DX + DY * DY)
    '---The normalized (Vector of length 1) direction then is
     NDX = DX / D
     NDY = DY / D
    '---Now we can find the circle position:
     CircleX = X1 + NDX * STAYAT
     CircleY = Y1 + NDY * STAYAT
    HTH


    PS:
    I edited my post #22
    I add a second block of code that works with slanted contour lines.

  28. #28

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    ---------------------------------------------------
    v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v
    EDIT:
    For fun and challenge with myself I wanted to try doing it with sloped contour lines (not just a rectangle).
    [To get the Form proceed same as above]

    [CODE]VERSION 5.00
    Begin VB.Form Form1
    Caption = "Form1"
    ClientHeight = 8280
    ClientLeft = 120
    ClientTop = 465
    ClientWidth = 11280
    LinkTopic = "Form1" ...
    -----------------------------------
    This is great
    You are a professional programmer, thank you

  29. #29

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    My vbRichClient problem has been fixed

    You answered the question. I did not understand if you have no problem, please send me the code of this question.

    Two circles on the line that are still on the line as the line moves

    Watch the movie

    link download

  30. #30
    Fanatic Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    678

    Re: VB6 The line returned when it hit the wall

    You should be more specific about what's your final goal.
    Create something like billiards game ? or what ?
    Try to specify what goal you want to achieve.
    PS: maybe later I'll "upgrade" to vbRichClient the examples I provided.

  31. #31

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    I upgraded to vbRichClient, no problem.
    Just the second question, I have a problem with two dots on the line
    By moving and changing the angle of the line, the circles should be on the line

    Name:  Circle.jpg
Views: 343
Size:  8.4 KB
    Last edited by Mojtaba; Dec 23rd, 2020 at 07:50 AM.

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

    Re: VB6 The line returned when it hit the wall

    Quote Originally Posted by Mojtaba View Post
    I upgraded to vbRichClient, no problem.
    That eases a lot of things.

    And it seems like your scenario is similar to a "bubble-shooting-game", where:
    - balls can be fired from some rotating "cannon-like thing"
    - with the goal, to "hit some bubbles, including some help from the walls where the shot balls bounce off"
    - including a "trajectory-preview for beginners" (showing where the bouncing ball might hit).

    Anyways, the code below covers the "rotating-cannon-problem", as shown in the ScreenShot:



    The problem of "rotating a complex Object, which consists of SubObjects" can be easily solved with:
    - CC.Save/Restore wrapping
    - followed by a coord-transformation
    - followed by "Sub-Routines" which draw "SubObjects" (without knowing that an outer transform is in place)

    Code:
    Public Sub Draw(CC As cCairoContext, Optional ForcePt As cControlPoint)
      If Not ForcePt Is Nothing Then CalcAngleAndForceLength ForcePt
      CC.Save
        CC.TranslateDrawings AnchorPt.X, AnchorPt.Y 'all drawing-coords and rotations are now relative to this anchor-point
        CC.RotateDrawings Angle
        
        'due to the outer coord-transformations above, the 3 routines below
        'can always assume to "draw the Cannon, as if it lies horizontally"
        RenderCannonContour CC
        If Not ForcePt Is Nothing Then CC.DrawLine 0, 0, -ForceLength, 0, , 1, vbRed
        RenderCannonBalls CC
      CC.Restore
    End Sub
    Ideally, such a complex Object is sitting in its own Class, so let's do this in a Class, name cCannon:
    Code:
    Option Explicit
    
    Public AnchorPt As cControlPoint, BoreRadius As Double, Length As Double
    Public Angle As Double, ForceLength As Double, BallCount As Long
    
    Public Sub Draw(CC As cCairoContext, Optional ForcePt As cControlPoint)
      If Not ForcePt Is Nothing Then CalcAngleAndForceLength ForcePt
      CC.Save
        CC.TranslateDrawings AnchorPt.X, AnchorPt.Y 'all drawing-coords are now relative to this anchor-point
        CC.RotateDrawings Angle
        
        'due to the outer coord-transformations above, the 3 routines below
        'can always assume to "draw the Cannon, as if it lies horizontally"
        RenderCannonContour CC
        If Not ForcePt Is Nothing Then CC.DrawLine 0, 0, -ForceLength, 0, , 1, vbRed
        RenderCannonBalls CC
      CC.Restore
    End Sub
    
    Private Sub RenderCannonContour(CC As cCairoContext)
      Const LW As Double = 3: CC.SetLineWidth LW
      Dim Poly As cArrayList
      Set Poly = New_c.ArrayList(vbDouble, _
          0, -BoreRadius - LW / 2, _
          -Length, -BoreRadius - LW / 2, _
          -Length, BoreRadius + LW / 2, _
          0, BoreRadius + LW / 2)
      CC.PolygonPtr Poly.DataPtr, Poly.Count \ 2, , splNormal, True, True 'use splNone, for straight PolyPt-connections
      CC.Stroke , Cairo.CreateSolidPatternLng(vbMagenta)
    End Sub
     
    Private Sub RenderCannonBalls(CC As cCairoContext)
      Const LW As Double = 2: CC.SetLineWidth LW
      Dim i As Long
      For i = 1 To BallCount
        CC.TranslateDrawings -BoreRadius, 0
          CC.Arc 0, 0, BoreRadius - LW / 2
          CC.Stroke , Cairo.CreateSolidPatternLng(vbBlue)
        CC.TranslateDrawings -BoreRadius, 0
      Next
    End Sub
    
    Private Sub CalcAngleAndForceLength(ForcePt As cControlPoint)
      Dim dx#: dx = AnchorPt.X - ForcePt.X
      Dim dy#: dy = AnchorPt.Y - ForcePt.Y
      Angle = Cairo.CalcArc(dy, dx)
      ForceLength = Sqr(dx * dx + dy * dy)
    End Sub
    The remaining code in a virginal Form is then relatively simple:
    Code:
    Option Explicit
    
    Private CC As cCairoContext, CPs As cControlPoints, WithEvents tmrRefresh As cTimer
    Private Cannon As New cCannon
    
    Private Sub Form_Load()
      ScaleMode = vbPixels 'use Pixel-Scalemode on the Form (for an exactly matching CC.Surface)
      Set CPs = New_c.ControlPoints 'ensure a ControlPoints-Collection-instance
      'now set-up the Cannon-Props
      Set Cannon.AnchorPt = CPs.Add("AnchorPt", ScaleWidth / 2, ScaleHeight / 2, vbGreen, 6)
          Cannon.BoreRadius = 15
          Cannon.Length = 90
          Cannon.BallCount = 2
      Set tmrRefresh = New_c.Timer(40, True) 'simple timer-based "game-loop"
    End Sub
    
    Private Sub RedrawScene(CC As cCairoContext) 'here is, where your own UserDrawings (on the passed "clean CC") will start
      Cannon.Draw CC, CPs("ForcePt")
      CPs.Draw CC 'this can be commented out, in case one wants to "hide" the ControlPoints
    End Sub
    
    'the 3 Mouse-Events below inform the CP-Collection about Mouse-Interactions (ensuring automatic CP-Move-Support)
    Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
      Dim CP As cControlPoint
      Set CP = CPs.CheckControlPointUnderCursor(X, Y, False)
       If CP Is Nothing Then Set CP = CPs.Add("ForcePt", X, Y, vbRed)
      CP.SetMouseDownPoint X, Y
    End Sub
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
      CPs.CheckControlPointUnderCursor X, Y, True
    End Sub
    Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
      If CPs.Exists("ForcePt") Then CPs.Remove "ForcePt"
      CPs.EnsureMouseUpState
    End Sub
    
    Private Sub tmrRefresh_Timer()
      CC.Paint 1, Cairo.CreateSolidPatternLng(vbWhite) 'clear the back-buffer
        RedrawScene CC 'user-drawings on a cleared canvas
      CC.Surface.DrawToDC Me.hDC 'refresh the form with the current bbuf-content
    End Sub
    
    Private Sub Form_Resize()
      Set CC = Cairo.CreateSurface(ScaleWidth, ScaleHeight).CreateContext
    End Sub
    Private Sub Form_Terminate()
      New_c.CleanupRichClientDll
    End Sub
    HTH

    Olaf

  33. #33

    Thread Starter
    Addicted Member Mojtaba's Avatar
    Join Date
    Dec 2020
    Posts
    150

    Re: VB6 The line returned when it hit the wall

    ♣ Olaf ♣
    Thank you, that is exactly what I mean
    But it would have been better if less code could have been used
    Is there no way to use shorter code?
    It does not have to be vbRichClient
    Anyway, thank you very much for writing and taking the time to ask this question .
    That was Perfect

    ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    I am not a professional vb6 and I can not have as much information as you, but I am skilled in site design and graphics, I will be at your service if you have any problems .
    ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    Last edited by Mojtaba; Dec 23rd, 2020 at 04:23 PM.

  34. #34
    The Idiot
    Join Date
    Dec 2014
    Posts
    2,721

    Re: VB6 The line returned when it hit the wall

    if anyone is Olaf if you are asking for "as little possible for good result" sources.
    as I wrote, theres no shortcuts, we need to tell the IDE what to do and how to do and include restrictions, triggers, "what ifs".
    less will always mean that u remove something, that is needed for certain situations.
    usually we add more, error-handling is one or a function that can be reused, we make it flexible, this so, in another situation we can use it again.

    so, the question should not be can it be shorter but can it be smarter, faster, without vbRichClient, etc.

    but Olaf is a genius in programming, everything he do is of high quality and looking at the code her posted, its quite "little", not sure what you expect.

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