Results 1 to 15 of 15

Thread: [RESOLVED] Drag&Collision

  1. #1

    Thread Starter
    Lively Member
    Join Date
    Oct 2008
    Posts
    123

    Resolved [RESOLVED] Drag&Collision

    Hi to all

    I have a question about drag object and collision.
    I can get when the dragged object get collided
    with others object...but
    how to stop drag when collide ?

    Thanks for help
    Nanni

  2. #2
    Fanatic Member technorobbo's Avatar
    Join Date
    Dec 2008
    Location
    Chicago
    Posts
    864

    Re: Drag&Collision

    Quote Originally Posted by Nanni
    Hi to all

    I have a question about drag object and collision.
    I can get when the dragged object get collided
    with others object...but
    how to stop drag when collide ?

    Thanks for help
    Nanni
    You mean this:
    Code:
    Private Sub SomeObject_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
    Source.Drag 2
    End Sub
    Have Fun,

    TR
    _____________________________
    Check out my Alpha DogFighter2D Game Demo and Source code. Direct Download:http://home.comcast.net/~technorobbo/Alpha.zip or Read about it in the forum:http://www.vbforums.com/showthread.php?t=551700. Now in 3D!!! http://home.comcast.net/~technorobbo/AlPha3D.zip or read about it in the forum: http://www.vbforums.com/showthread.php?goto=newpost&t=552560 and IChessChat3D internet chess game

  3. #3

    Thread Starter
    Lively Member
    Join Date
    Oct 2008
    Posts
    123

    Re: Drag&Collision

    Hi technorobbo
    Thanks for reply.

    I'm using BitBlt to Overlay a picture on another.
    I have a Picturebox for destination and two Picturebox for
    Keeping Sprite (1 for mask and 1 for complete image).

    I'm using MouseMove for Drag image in destination PictureBox.

    Code:
    BitBlt Picdest.hDC, 0, 0, Picdest.ScaleWidth, Picdest.ScaleHeight, PicBack.hDC, 0, 0, SRCCOPY '(backGround)
    BitBlt Picdest.hDC, X ,Y , PicSprite(ID).ScaleWidth, PicSprite(ID).ScaleHeight, PicSprite(ID + 1).hDC, 0, 0, SRCAND '(Sprite Mask)
    BitBlt Picdest.hDC, X , Y , PicSprite(ID).ScaleWidth, PicSprite(ID).ScaleHeight, PicSprite(ID).hDC, 0, 0, SRCPAINT '(Sprite)
    I can get when the moved object get collided

    Code:
    If PicSprite(ID1).Left <= PicSprite(ID2).Left + PicSprite(ID2).Width Then
            If PicSprite(ID).Left + PicSprite(ID).Width >= PicSprite(ID2).Left Then
                If PicSprite(ID).Top <= PicSprite(ID2).Top + PicSprite(ID2).Height Then
                    If PicSprite(ID).Top + PicSprite(ID).Height >= PicSprite(ID2).Top Then
                        Overlap = True
                    End If
                End If
            End If
        End If
    with others object, but I do not know how to stop the movement
    of the object, when it comes into contact with anothers.

    Thanks for Help
    Nanni

  4. #4
    Fanatic Member technorobbo's Avatar
    Join Date
    Dec 2008
    Location
    Chicago
    Posts
    864

    Resolved Re: Drag&Collision

    Why dont you check for overlap before you paint the object in the new location, If it's overlapped paint it in the old location:
    Code:
    BitBlt Picdest.hDC, 0, 0, Picdest.ScaleWidth, Picdest.ScaleHeight, PicBack.hDC, 0, 0, SRCCOPY '(backGround)
    if overlap then
       BitBlt Picdest.hDC, oldX(ID) ,oldY(ID) , PicSprite(ID).ScaleWidth, PicSprite(ID).ScaleHeight, PicSprite(ID + 1).hDC, 0, 0, SRCAND '(Sprite Mask)
       BitBlt Picdest.hDC, oldX(ID) , oldY(ID) , PicSprite(ID).ScaleWidth, PicSprite(ID).ScaleHeight, PicSprite(ID).hDC, 0, 0, SRCPAINT '(Sprite)
    else
       BitBlt Picdest.hDC, X , Y , PicSprite(ID).ScaleWidth, PicSprite(ID).ScaleHeight, PicSprite(ID + 1).hDC, 0, 0, SRCAND '(Sprite Mask)
       BitBlt Picdest.hDC, X , Y , PicSprite(ID).ScaleWidth, PicSprite(ID).ScaleHeight, PicSprite(ID).hDC, 0, 0, SRCPAINT '(Sprite)
       oldX(ID)=X
       oldY(ID)=y
    end if
    Last edited by technorobbo; Mar 16th, 2009 at 05:53 AM.
    Have Fun,

    TR
    _____________________________
    Check out my Alpha DogFighter2D Game Demo and Source code. Direct Download:http://home.comcast.net/~technorobbo/Alpha.zip or Read about it in the forum:http://www.vbforums.com/showthread.php?t=551700. Now in 3D!!! http://home.comcast.net/~technorobbo/AlPha3D.zip or read about it in the forum: http://www.vbforums.com/showthread.php?goto=newpost&t=552560 and IChessChat3D internet chess game

  5. #5

    Thread Starter
    Lively Member
    Join Date
    Oct 2008
    Posts
    123

    Re: Drag&Collision

    Hi technorobbo

    thanks for suggestion, but...
    though it seems a simple problem, I am stuck.

    I have enclosed a test form, but I can't figure out
    how I can stop the movement of the object.

    Sorry again for question.

    Regards
    Nanni
    Attached Files Attached Files

  6. #6
    Fanatic Member technorobbo's Avatar
    Join Date
    Dec 2008
    Location
    Chicago
    Posts
    864

    Re: Drag&Collision

    You were setting overlap to true but not to false, that was stopping you from completing the routine. I added a circular collision check - your smiley faces are oval so the cant come together completely. If they were round they would. You can un-Rem the rectagular collision.

    Code:
    Option Explicit
    
    Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, _
                                                 ByVal nWidth As Long, ByVal nHeight As Long, _
                                                 ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
                                                 ByVal dwRop As Long) As Long
                                                 
    Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, _
                                                ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
                                                ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, _
                                                ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
    
    Private Const MERGEPAINT = &HBB0226
    Private Const SRCAND = &H8800C6
    Private Const SRCCOPY = &HCC0020
    Private Const SRCPAINT = &HEE0086
    
    Private Type ObjectDataType
      Id As Long    'ID identifies what image to associate with this object
      X As Long     'X position (upper left corner) of the image within the Big picture
      Y As Long     'Y position (upper left corner) of the image withing the Big picture
      W As Long     'The Width of the Image
      H As Long     'The Height of the Image
      oldx As Long
      oldy As Long
    End Type
    
    Private Type ObjectType  'To keep track of the images we want to drag around
      Dat As ObjectDataType
      PrvLink As Long 'Link to the next lower image
      NxtLink As Long 'Link to the next higher image
    End Type
    
    Dim Obj(1 To 6) As ObjectType 'Create array to keep track of sprite
    
    Dim dragObj As Long  'Holds the selected object (the one clicked on)
    
    Dim mx As Single, my As Single              'holds the position of the mouseX and mouseY relative to the view window
    Dim Px As Long, Py As Long                  'holds the picture offset, used in scrolling the background
    Dim Xoffset As Long, Yoffset As Long        'holds the relative offset of the mouse, within the image being moved
    
    Dim sx As Single  'Scale factor to be applied to the viewport relative Mouse X,
    Dim sy As Single  'Scale factor for Y
    
    Dim Overlap As Boolean
    
    Dim b_lblMouseDownY As Boolean
    Dim b_lblMouseDownX As Boolean
    
    Private Sub UpdatePicture()
    
    'Limit the viewport mouse X and Y values to the viewport
      If mx < 0 Then mx = 0
      If mx > PicDest.ScaleWidth Then mx = PicDest.ScaleWidth
      If my < 0 Then my = 0
      If my > PicDest.ScaleHeight Then my = PicDest.ScaleHeight
    
      Px = mx * sx  'Determine the BigPicture X offset
      Py = my * sy  'And Y offset
    
     'Bitblt the background picture to the viewport (from the offset position (px,py)
      BitBlt PicDest.hdc, 0, 0, PicDest.ScaleWidth, PicDest.ScaleHeight, PicBack.hdc, Px, Py, vbSrcCopy
    
     'For each image object
     '  Determine the Pictureboxes of the Image from the ID
     '  Bitblt the mask and sprite of the image from their picturebox to their position in the viewport
      Dim i As Long, Id As Long
      'i = FirstLink 'start at the bottom of the zorder
    
    
    For i = 1 To 2
    
        With Obj(i).Dat
          BitBlt PicDest.hdc, .X - Px, .Y - Py, Picture3(0).ScaleWidth, Picture3(0).ScaleHeight, Picture3(1).hdc, 0, 0, SRCAND
          BitBlt PicDest.hdc, .X - Px, .Y - Py, Picture3(0).ScaleWidth, Picture3(0).ScaleHeight, Picture3(0).hdc, 0, 0, SRCPAINT
        End With
        
    Next i
    
    
    PicDest.Refresh  'Update the viewport to see the result of all our work
      
    End Sub
    
    
    Private Sub Form_Load()
    Dim i As Integer
    
    Label1.Caption = "No Drag"
    
    sx = (PicBack.ScaleWidth - PicDest.ScaleWidth) / PicDest.ScaleWidth
    sy = (PicBack.ScaleHeight - PicDest.ScaleHeight) / PicDest.ScaleHeight
    
    For i = 1 To 2
        With Obj(i).Dat
          .H = Picture3(0).ScaleHeight          'Save the image Height
          .W = Picture3(0).ScaleWidth           'Save the image Width
          If i = 1 Then
          .X = 10   '
          .Y = 10  '  position the image
          Else
          .X = 100
          .Y = 100
          End If
        End With
      Next i
    
      
      UpdatePicture                               'Display the current state of the picture
    
    End Sub
    
    Private Sub Picdest_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If Button <> vbLeftButton Then Exit Sub
    
      Dim i As Long               'temporary loop counter
      Dim tx As Long, ty As Long  'translated X and Y (viewport X,Y to the Big Picture's X,Y)
    
        tx = X + Px                               '  Convert viewport X to BigPicture X (add picture X offset
        ty = Y + Py                               '  Convert viewport Y to BigPicture Y (add Picture Y offset)
        
               
          For i = LBound(Obj) To UBound(Obj)
                             
            With Obj(i).Dat                         '  Reference the Data for the indexed object
             'Rectangular bounds check
              If tx > .X And tx < .X + .W Then      '    If the click X is within the X bounds of the image
                If ty > .Y And ty < .Y + .H Then    '      If the click Y is winin the Y bounds of the image
                  Xoffset = tx - .X                      '      Compute the relative X position within the image
                  Yoffset = ty - .Y                      '      Compute the relative Y position within the image
                    ' See if this point corresponds to
                    ' a black point on the mask.
                    If Picture3(1).Point(Xoffset, Yoffset) = vbBlack Then
                        dragObj = i                     '
                        Exit For
                    End If
                  
                End If
              End If
            End With
            
          Next i
          
      
      
    End Sub
    
    Private Sub Picdest_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Dim i As Integer
    
    If Button <> vbLeftButton Then Exit Sub
    
    If dragObj > 0 Then 'If we are currently moving an image
    Label1.Caption = "drag Object " & dragObj
    
        'Collision detection with
      
          For i = LBound(Obj) To UBound(Obj)
            Obj(dragObj).Dat.X = X + Px - Xoffset  '  Update the images position
            Obj(dragObj).Dat.Y = Y + Py - Yoffset
            If Not dragObj = i Then
                Dim nx As Single, ny As Single
                Dim mx As Single, my As Single
                Dim distance As Single
                mx = Obj(dragObj).Dat.X + Obj(dragObj).Dat.W / 2
                my = Obj(dragObj).Dat.Y + Obj(dragObj).Dat.H / 2
                nx = Obj(i).Dat.X + Obj(i).Dat.W / 2
                ny = Obj(i).Dat.Y + Obj(i).Dat.H / 2
                distance = Int(Sqr((mx - nx) ^ 2 + (my - ny) ^ 2))
    '            If Obj(dragObj).Dat.X <= Obj(i).Dat.X + Obj(i).Dat.W And _
    '            Obj(dragObj).Dat.X + Obj(dragObj).Dat.W >= Obj(i).Dat.X And _
    '            Obj(dragObj).Dat.Y <= Obj(i).Dat.Y + Obj(i).Dat.H And _
    '            Obj(dragObj).Dat.Y + Obj(dragObj).Dat.H >= Obj(i).Dat.Y Then
            If distance < Obj(dragObj).Dat.W Then
                Overlap = True
                Obj(dragObj).Dat.X = Obj(dragObj).Dat.oldx  '  Update the images position
                Obj(dragObj).Dat.Y = Obj(dragObj).Dat.oldy
                Label2.Caption = "Overlap"
                Debug.Print "Overlap", X, Y, i
                Exit For
            Else
                Label2.Caption = "NO Overlap"
                Overlap = False
                Obj(dragObj).Dat.oldx = Obj(dragObj).Dat.X
                Obj(dragObj).Dat.oldy = Obj(dragObj).Dat.Y
            End If
            
            End If
          
          Next i
      UpdatePicture
        
    End If
    
    End Sub
    Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    b_lblMouseDownY = True
    End Sub
    
    Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If b_lblMouseDownY And (Y / Screen.TwipsPerPixelY <= Image1.Height) And (Y / Screen.TwipsPerPixelY > 0) Then
    
    my = (Y - PicDest.ScaleTop) / Screen.TwipsPerPixelY      'update the MouseY
    UpdatePicture
    End If
    
    End Sub
    
    Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    b_lblMouseDownY = False
    End Sub
    
    Private Sub Image2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    b_lblMouseDownX = True
    End Sub
    
    Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If b_lblMouseDownX And (X / Screen.TwipsPerPixelX <= Image2.Width) And (X / Screen.TwipsPerPixelX > 0) Then
    mx = (X - PicDest.ScaleLeft) / Screen.TwipsPerPixelX 'Image2.Left / Screen.TwipsPerPixelX
    
    UpdatePicture
    End If
    End Sub
    
    Private Sub Image2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    b_lblMouseDownX = False
    End Sub
    
    Private Sub PicDest_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    dragObj = 0
    End Sub
    Have Fun,

    TR
    _____________________________
    Check out my Alpha DogFighter2D Game Demo and Source code. Direct Download:http://home.comcast.net/~technorobbo/Alpha.zip or Read about it in the forum:http://www.vbforums.com/showthread.php?t=551700. Now in 3D!!! http://home.comcast.net/~technorobbo/AlPha3D.zip or read about it in the forum: http://www.vbforums.com/showthread.php?goto=newpost&t=552560 and IChessChat3D internet chess game

  7. #7

    Thread Starter
    Lively Member
    Join Date
    Oct 2008
    Posts
    123

    Re: Drag&Collision

    Hi technorobbo
    Thanks for point me in right direction,
    but there is another problem.

    When you drag quickly the sprite, the overlap point
    is not the same as when you drag the sprite slowly.

    Is there a workaround for this behaviour?

    Thanks again for help me and sorry for questions.

    Regards
    Nanni

  8. #8
    G&G Moderator chemicalNova's Avatar
    Join Date
    Jun 2002
    Location
    Victoria, Australia
    Posts
    4,246

    Re: Drag&Collision

    Test to see if the two positions of the images intersect using a simple function, then, as long as they intersect (at all), you can stop it from moving:
    Code:
    Type Rectangle
    	X As Integer
    	Y As Integer
    	Width As Integer
    	Height As Integer
    End Type
    
    Function Intersect(rect1 As Rectangle, rect2 As Rectangle) As Boolean
    
    if (((rect1.X > (rect2.X + rect2.Width)) _
    	AND (rect2.X < (rect1.X + rect1.Width))) _
    	AND (rect1.Y < (rect2.Y + rect2.Height))) Then
    Intersect = (rect2.Y < (rect1.Y + rect1.Height))
    End If
    Intersect = False
    
    End Function
    Use it like..
    Code:
    Dim picture1Position As Rectangle
    Dim picture2Position As Rectangle
    
    picture1Position.X = 50
    picture1Position.Y = 50
    picture1Position.Width = 300
    picture1Position.Height = 300
    
    picture2Position.X = 100
    picture2Position.Y = 100
    picture2Position.Width = 300
    picture2Position.Height = 300
    
    If Not (Intersect(picture1Position, picture2Position)) Then
    ' if these two rectangles do not overlap.. then move the image..
    End If
    chem

    Visual Studio 6, Visual Studio.NET 2005, MASM

  9. #9

    Thread Starter
    Lively Member
    Join Date
    Oct 2008
    Posts
    123

    Re: Drag&Collision

    Hi chem
    thanks for reply.

    I need to drag Sprite bitblt to a BackGround.
    I can drag sprite, i can check for collision (also Pixel Collision)
    but I can't get always the same overlap point.

    Use the arrow keys to move the sprite is quite simple,
    but I do not understand how to achieve the same result
    using the mouse for dragging sprite.


    Thanks
    Nanni

  10. #10
    Fanatic Member technorobbo's Avatar
    Join Date
    Dec 2008
    Location
    Chicago
    Posts
    864

    Re: Drag&Collision

    Quote Originally Posted by Nanni View Post
    When you drag quickly the sprite, the overlap point
    is not the same as when you drag the sprite slowly.
    Is there a workaround for this behaviour?
    That's actually a pretty simple resolution. I'm not by my computer right now but I will explain and later I can give you an example.

    When 2 circles are adjacent the line segment created by their centers is always the length of 1 circles diameter. To find the known distance from one center to the other you perform the Pythagorean Theorem (a^2 +b^2= c^2).
    Knowing the length of the hypotenuse you can cross multiply to find the x and y of the adjacent circle.

    diameter=20
    hypotenuse= sqr((x2-x1)^2 + (y2-y1)^2)
    newX=20 * (x2-x1)/hypotenuse + x1
    newy=20 * (y2-y1)/hypotenuse +y1

    If your thoroughly confused I'll program it up for you to see.
    Have Fun,

    TR
    _____________________________
    Check out my Alpha DogFighter2D Game Demo and Source code. Direct Download:http://home.comcast.net/~technorobbo/Alpha.zip or Read about it in the forum:http://www.vbforums.com/showthread.php?t=551700. Now in 3D!!! http://home.comcast.net/~technorobbo/AlPha3D.zip or read about it in the forum: http://www.vbforums.com/showthread.php?goto=newpost&t=552560 and IChessChat3D internet chess game

  11. #11
    Fanatic Member technorobbo's Avatar
    Join Date
    Dec 2008
    Location
    Chicago
    Posts
    864

    Re: Drag&Collision

    OK, here it is. I'm 100% sure this is what your looking for.

    If the balls were a perfect circle they'd butt up to each other perfectly but since theyre oval there will always be a slight gap. I uploaded some perfectly round ones for you.

    Code:
    Option Explicit
    
    Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, _
                                                 ByVal nWidth As Long, ByVal nHeight As Long, _
                                                 ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
                                                 ByVal dwRop As Long) As Long
                                                 
    Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, _
                                                ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
                                                ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, _
                                                ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
    
    Private Const MERGEPAINT = &HBB0226
    Private Const SRCAND = &H8800C6
    Private Const SRCCOPY = &HCC0020
    Private Const SRCPAINT = &HEE0086
    
    Private Type ObjectDataType
      Id As Long    'ID identifies what image to associate with this object
      X As Long     'X position (upper left corner) of the image within the Big picture
      Y As Long     'Y position (upper left corner) of the image withing the Big picture
      W As Long     'The Width of the Image
      H As Long     'The Height of the Image
      oldx As Long
      oldy As Long
    End Type
    
    Private Type ObjectType  'To keep track of the images we want to drag around
      Dat As ObjectDataType
      PrvLink As Long 'Link to the next lower image
      NxtLink As Long 'Link to the next higher image
    End Type
    
    Dim Obj(1 To 6) As ObjectType 'Create array to keep track of sprite
    
    Dim dragObj As Long  'Holds the selected object (the one clicked on)
    
    Dim mx As Single, my As Single              'holds the position of the mouseX and mouseY relative to the view window
    Dim Px As Long, Py As Long                  'holds the picture offset, used in scrolling the background
    Dim Xoffset As Long, Yoffset As Long        'holds the relative offset of the mouse, within the image being moved
    
    Dim sx As Single  'Scale factor to be applied to the viewport relative Mouse X,
    Dim sy As Single  'Scale factor for Y
    
    Dim Overlap As Boolean
    
    Dim b_lblMouseDownY As Boolean
    Dim b_lblMouseDownX As Boolean
    
    Private Sub UpdatePicture()
    
    'Limit the viewport mouse X and Y values to the viewport
      If mx < 0 Then mx = 0
      If mx > PicDest.ScaleWidth Then mx = PicDest.ScaleWidth
      If my < 0 Then my = 0
      If my > PicDest.ScaleHeight Then my = PicDest.ScaleHeight
    
      Px = mx * sx  'Determine the BigPicture X offset
      Py = my * sy  'And Y offset
    
     'Bitblt the background picture to the viewport (from the offset position (px,py)
      BitBlt PicDest.hdc, 0, 0, PicDest.ScaleWidth, PicDest.ScaleHeight, PicBack.hdc, Px, Py, vbSrcCopy
    
     'For each image object
     '  Determine the Pictureboxes of the Image from the ID
     '  Bitblt the mask and sprite of the image from their picturebox to their position in the viewport
      Dim i As Long, Id As Long
      'i = FirstLink 'start at the bottom of the zorder
    
    
    For i = 1 To 2
    
        With Obj(i).Dat
          BitBlt PicDest.hdc, .X - Px, .Y - Py, Picture3(0).ScaleWidth, Picture3(0).ScaleHeight, Picture3(1).hdc, 0, 0, SRCAND
          BitBlt PicDest.hdc, .X - Px, .Y - Py, Picture3(0).ScaleWidth, Picture3(0).ScaleHeight, Picture3(0).hdc, 0, 0, SRCPAINT
        End With
        
    Next i
    
    
    PicDest.Refresh  'Update the viewport to see the result of all our work
      
    End Sub
    
    
    Private Sub Form_Load()
    Dim i As Integer
    
    Label1.Caption = "No Drag"
    
    sx = (PicBack.ScaleWidth - PicDest.ScaleWidth) / PicDest.ScaleWidth
    sy = (PicBack.ScaleHeight - PicDest.ScaleHeight) / PicDest.ScaleHeight
    
    For i = 1 To 2
        With Obj(i).Dat
          .H = Picture3(0).ScaleHeight          'Save the image Height
          .W = Picture3(0).ScaleWidth           'Save the image Width
          If i = 1 Then
          .X = 10   '
          .Y = 10  '  position the image
          Else
          .X = 100
          .Y = 100
          End If
        End With
      Next i
    
      
      UpdatePicture                               'Display the current state of the picture
    
    End Sub
    
    Private Sub Picdest_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If Button <> vbLeftButton Then Exit Sub
    
      Dim i As Long               'temporary loop counter
      Dim tx As Long, ty As Long  'translated X and Y (viewport X,Y to the Big Picture's X,Y)
    
        tx = X + Px                               '  Convert viewport X to BigPicture X (add picture X offset
        ty = Y + Py                               '  Convert viewport Y to BigPicture Y (add Picture Y offset)
        
               
          For i = LBound(Obj) To UBound(Obj)
                             
            With Obj(i).Dat                         '  Reference the Data for the indexed object
             'Rectangular bounds check
              If tx > .X And tx < .X + .W Then      '    If the click X is within the X bounds of the image
                If ty > .Y And ty < .Y + .H Then    '      If the click Y is winin the Y bounds of the image
                  Xoffset = tx - .X                      '      Compute the relative X position within the image
                  Yoffset = ty - .Y                      '      Compute the relative Y position within the image
                    ' See if this point corresponds to
                    ' a black point on the mask.
                    If Picture3(1).Point(Xoffset, Yoffset) = vbBlack Then
                        dragObj = i                     '
                        Exit For
                    End If
                  
                End If
              End If
            End With
            
          Next i
          
      
      
    End Sub
    
    Private Sub Picdest_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Dim i As Integer
    
    If Button <> vbLeftButton Then Exit Sub
    
    If dragObj > 0 Then 'If we are currently moving an image
    Label1.Caption = "drag Object " & dragObj
    
        'Collision detection with
      
          For i = LBound(Obj) To UBound(Obj)
          With Obj(dragObj).Dat
            .X = X + Px - Xoffset '  Update the images position
            .Y = Y + Py - Yoffset
          End With
            If Not dragObj = i Then
                Dim nx As Single, ny As Single
                Dim mx As Single, my As Single
                Dim distance As Single
                mx = Obj(dragObj).Dat.X + Obj(dragObj).Dat.W / 2
                my = Obj(dragObj).Dat.Y + Obj(dragObj).Dat.H / 2
                nx = Obj(i).Dat.X + Obj(i).Dat.W / 2
                ny = Obj(i).Dat.Y + Obj(i).Dat.H / 2
                distance = Int(Sqr((mx - nx) ^ 2 + (my - ny) ^ 2))
    '            If Obj(dragObj).Dat.X <= Obj(i).Dat.X + Obj(i).Dat.W And _
    '            Obj(dragObj).Dat.X + Obj(dragObj).Dat.W >= Obj(i).Dat.X And _
    '            Obj(dragObj).Dat.Y <= Obj(i).Dat.Y + Obj(i).Dat.H And _
    '            Obj(dragObj).Dat.Y + Obj(dragObj).Dat.H >= Obj(i).Dat.Y Then
            If distance < Obj(dragObj).Dat.W Then
                Overlap = True
                With Obj(dragObj).Dat
                    .X = .W * (mx - nx) / distance + nx - Obj(dragObj).Dat.W / 2
                    .Y = .W * (my - ny) / distance + ny - Obj(dragObj).Dat.W / 2
                End With
                Label2.Caption = "Overlap"
                Debug.Print "Overlap", X, Y, i
                Exit For
            Else
                Label2.Caption = "NO Overlap"
                Overlap = False
                Obj(dragObj).Dat.oldx = Obj(dragObj).Dat.X
                Obj(dragObj).Dat.oldy = Obj(dragObj).Dat.Y
            End If
            
            End If
          
          Next i
      UpdatePicture
        
    End If
    
    End Sub
    Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    b_lblMouseDownY = True
    End Sub
    
    Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If b_lblMouseDownY And (Y / Screen.TwipsPerPixelY <= Image1.Height) And (Y / Screen.TwipsPerPixelY > 0) Then
    
    my = (Y - PicDest.ScaleTop) / Screen.TwipsPerPixelY      'update the MouseY
    UpdatePicture
    End If
    
    End Sub
    
    Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    b_lblMouseDownY = False
    End Sub
    
    Private Sub Image2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    b_lblMouseDownX = True
    End Sub
    
    Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If b_lblMouseDownX And (X / Screen.TwipsPerPixelX <= Image2.Width) And (X / Screen.TwipsPerPixelX > 0) Then
    mx = (X - PicDest.ScaleLeft) / Screen.TwipsPerPixelX 'Image2.Left / Screen.TwipsPerPixelX
    
    UpdatePicture
    End If
    End Sub
    
    Private Sub Image2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    b_lblMouseDownX = False
    End Sub
    
    Private Sub PicDest_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    dragObj = 0
    End Sub
    Attached Images Attached Images   
    Last edited by technorobbo; Mar 17th, 2009 at 05:45 PM.
    Have Fun,

    TR
    _____________________________
    Check out my Alpha DogFighter2D Game Demo and Source code. Direct Download:http://home.comcast.net/~technorobbo/Alpha.zip or Read about it in the forum:http://www.vbforums.com/showthread.php?t=551700. Now in 3D!!! http://home.comcast.net/~technorobbo/AlPha3D.zip or read about it in the forum: http://www.vbforums.com/showthread.php?goto=newpost&t=552560 and IChessChat3D internet chess game

  12. #12

    Thread Starter
    Lively Member
    Join Date
    Oct 2008
    Posts
    123

    Re: Drag&Collision

    hi technorobbo
    your explanations are always very clear and precise.

    The code works fine only when there are 2 objects.
    Testing the code with 3 objects, the collision is
    detected only for the first collided object.

    I changed the code to have 3 objects.

    Try to bring 2 object so that their distance is
    smaller than the size of the third object.
    When the third object comes into collision
    with an object, it overlaps with another.

    Code:
    Option Explicit
    
    Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, _
                                                 ByVal nWidth As Long, ByVal nHeight As Long, _
                                                 ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
                                                 ByVal dwRop As Long) As Long
                                                 
    Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, _
                                                ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
                                                ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, _
                                                ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
    
    Private Const MERGEPAINT = &HBB0226
    Private Const SRCAND = &H8800C6
    Private Const SRCCOPY = &HCC0020
    Private Const SRCPAINT = &HEE0086
    
    Private Type ObjectDataType
      Id As Long    'ID identifies what image to associate with this object
      X As Long     'X position (upper left corner) of the image within the Big picture
      Y As Long     'Y position (upper left corner) of the image withing the Big picture
      W As Long     'The Width of the Image
      H As Long     'The Height of the Image
      oldx As Long
      oldy As Long
    End Type
    
    Private Type ObjectType  'To keep track of the images we want to drag around
      Dat As ObjectDataType
      PrvLink As Long 'Link to the next lower image
      NxtLink As Long 'Link to the next higher image
    End Type
    
    Dim Obj(1 To 3) As ObjectType 'Create array to keep track of sprite
    
    Dim dragObj As Long  'Holds the selected object (the one clicked on)
    
    Dim mx As Single, my As Single              'holds the position of the mouseX and mouseY relative to the view window
    Dim Px As Long, Py As Long                  'holds the picture offset, used in scrolling the background
    Dim Xoffset As Long, Yoffset As Long        'holds the relative offset of the mouse, within the image being moved
    
    Dim sx As Single  'Scale factor to be applied to the viewport relative Mouse X,
    Dim sy As Single  'Scale factor for Y
    
    Dim Overlap As Boolean
    
    Dim b_lblMouseDownY As Boolean
    Dim b_lblMouseDownX As Boolean
    
    Private Sub UpdatePicture()
    
    'Limit the viewport mouse X and Y values to the viewport
      If mx < 0 Then mx = 0
      If mx > picDest.ScaleWidth Then mx = picDest.ScaleWidth
      If my < 0 Then my = 0
      If my > picDest.ScaleHeight Then my = picDest.ScaleHeight
    
      Px = mx * sx  'Determine the BigPicture X offset
      Py = my * sy  'And Y offset
    
     'Bitblt the background picture to the viewport (from the offset position (px,py)
      BitBlt picDest.hdc, 0, 0, picDest.ScaleWidth, picDest.ScaleHeight, PicBack.hdc, Px, Py, vbSrcCopy
    
     'For each image object
     '  Determine the Pictureboxes of the Image from the ID
     '  Bitblt the mask and sprite of the image from their picturebox to their position in the viewport
      Dim i As Long, Id As Long
      'i = FirstLink 'start at the bottom of the zorder
    
    
    For i = LBound(Obj) To UBound(Obj)
    
        With Obj(i).Dat
          BitBlt picDest.hdc, .X - Px, .Y - Py, Picture3(0).ScaleWidth, Picture3(0).ScaleHeight, Picture3(1).hdc, 0, 0, SRCAND
          BitBlt picDest.hdc, .X - Px, .Y - Py, Picture3(0).ScaleWidth, Picture3(0).ScaleHeight, Picture3(0).hdc, 0, 0, SRCPAINT
        End With
        
    Next i
    
    
    picDest.Refresh  'Update the viewport to see the result of all our work
      
    End Sub
    
    
    Private Sub Form_Load()
    Dim i As Integer
    
    Label1.Caption = "No Drag"
    
    sx = (PicBack.ScaleWidth - picDest.ScaleWidth) / picDest.ScaleWidth
    sy = (PicBack.ScaleHeight - picDest.ScaleHeight) / picDest.ScaleHeight
    
    For i = LBound(Obj) To UBound(Obj)
        With Obj(i).Dat
          .H = Picture3(0).ScaleHeight          'Save the image Height
          .W = Picture3(0).ScaleWidth           'Save the image Width
          If i = 1 Then
          .X = 10   '
          .Y = 10  '  position the image
          ElseIf i = 2 Then
          .X = 100
          .Y = 100
          Else
          .X = 100
          .Y = 200
          End If
        End With
      Next i
    
      
      UpdatePicture                               'Display the current state of the picture
    
    End Sub
    
    Private Sub Picdest_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    If Button <> vbLeftButton Then Exit Sub
    
      Dim i As Long               'temporary loop counter
      Dim tx As Long, ty As Long  'translated X and Y (viewport X,Y to the Big Picture's X,Y)
    
        tx = X + Px                               '  Convert viewport X to BigPicture X (add picture X offset
        ty = Y + Py                               '  Convert viewport Y to BigPicture Y (add Picture Y offset)
        
               
          For i = LBound(Obj) To UBound(Obj)
                             
            With Obj(i).Dat                         '  Reference the Data for the indexed object
             'Rectangular bounds check
              If tx > .X And tx < .X + .W Then      '    If the click X is within the X bounds of the image
                If ty > .Y And ty < .Y + .H Then    '      If the click Y is winin the Y bounds of the image
                  Xoffset = tx - .X                      '      Compute the relative X position within the image
                  Yoffset = ty - .Y                      '      Compute the relative Y position within the image
                    ' See if this point corresponds to
                    ' a black point on the mask.
                    If Picture3(1).Point(Xoffset, Yoffset) = vbBlack Then
                        dragObj = i                     '
                        Exit For
                    End If
                  
                End If
              End If
            End With
            
          Next i
          
      
      
    End Sub
    
    Private Sub Picdest_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Dim i As Integer
    
    If Button <> vbLeftButton Then Exit Sub
    
    If dragObj > 0 Then 'If we are currently moving an image
    Label1.Caption = "drag Object " & dragObj
    
        'Collision detection with
      
          For i = LBound(Obj) To UBound(Obj)
          With Obj(dragObj).Dat
            .X = X + Px - Xoffset '  Update the images position
            .Y = Y + Py - Yoffset
          End With
            If Not dragObj = i Then
                Dim nx As Single, ny As Single
                Dim mx As Single, my As Single
                Dim distance As Single
                mx = Obj(dragObj).Dat.X + Obj(dragObj).Dat.W / 2
                my = Obj(dragObj).Dat.Y + Obj(dragObj).Dat.H / 2
                nx = Obj(i).Dat.X + Obj(i).Dat.W / 2
                ny = Obj(i).Dat.Y + Obj(i).Dat.H / 2
                distance = Int(Sqr((mx - nx) ^ 2 + (my - ny) ^ 2))
    '            If Obj(dragObj).Dat.X <= Obj(i).Dat.X + Obj(i).Dat.W And _
    '            Obj(dragObj).Dat.X + Obj(dragObj).Dat.W >= Obj(i).Dat.X And _
    '            Obj(dragObj).Dat.Y <= Obj(i).Dat.Y + Obj(i).Dat.H And _
    '            Obj(dragObj).Dat.Y + Obj(dragObj).Dat.H >= Obj(i).Dat.Y Then
            If distance < Obj(dragObj).Dat.W Then
                Overlap = True
                
                With Obj(dragObj).Dat
                    .X = .W * (mx - nx) / distance + nx - Obj(dragObj).Dat.W / 2
                    .Y = .W * (my - ny) / distance + ny - Obj(dragObj).Dat.W / 2
                End With
                
                Label2.Caption = "Overlap"
                Debug.Print "Overlap", X, Y, i
                Exit For
            Else
                Label2.Caption = "NO Overlap"
                Overlap = False
                Obj(dragObj).Dat.oldx = Obj(dragObj).Dat.X
                Obj(dragObj).Dat.oldy = Obj(dragObj).Dat.Y
            End If
            
            End If
          
          Next i
      UpdatePicture
        
    End If
    
    End Sub
    Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    b_lblMouseDownY = True
    End Sub
    
    Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If b_lblMouseDownY And (Y / Screen.TwipsPerPixelY <= Image1.Height) And (Y / Screen.TwipsPerPixelY > 0) Then
    
    my = (Y - picDest.ScaleTop) / Screen.TwipsPerPixelY      'update the MouseY
    UpdatePicture
    End If
    
    End Sub
    
    Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    b_lblMouseDownY = False
    End Sub
    
    Private Sub Image2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    b_lblMouseDownX = True
    End Sub
    
    Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If b_lblMouseDownX And (X / Screen.TwipsPerPixelX <= Image2.Width) And (X / Screen.TwipsPerPixelX > 0) Then
    mx = (X - picDest.ScaleLeft) / Screen.TwipsPerPixelX 'Image2.Left / Screen.TwipsPerPixelX
    
    UpdatePicture
    End If
    End Sub
    
    Private Sub Image2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    b_lblMouseDownX = False
    End Sub
    
    Private Sub PicDest_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    dragObj = 0
    End Sub
    Thanks for your availability and kindness

    Regards
    Nanni

  13. #13
    Fanatic Member technorobbo's Avatar
    Join Date
    Dec 2008
    Location
    Chicago
    Posts
    864

    Re: Drag&Collision

    If your going to do multiple collisions then you'll need to do recursion. The logic is similar to a bubble sort.This is just the Picdest_MouseMove routine the rest can stay the same. The problem with recursion is that you have to protect from endless loop - a countdown or max number of loops will work. I haven't added that part - got no time right now ,but if you need help figuring it out just ask :
    Code:
    Private Sub Picdest_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim nx As Single, ny As Single
    Dim mx As Single, my As Single
    Dim distance As Single
    Dim i As Integer
    
    If Button <> vbLeftButton Then Exit Sub
    
    If dragObj > 0 Then 'If we are currently moving an image
    Label1.Caption = "drag Object " & dragObj
    
        'Collision detection with
          With Obj(dragObj).Dat
            .X = X + Px - Xoffset '  Update the images position
            .Y = Y + Py - Yoffset
          End With
          
          Do
            Overlap = False
            For i = LBound(Obj) To UBound(Obj)
        
                If Not dragObj = i Then
    
                    mx = Obj(dragObj).Dat.X + Obj(dragObj).Dat.W / 2
                    my = Obj(dragObj).Dat.Y + Obj(dragObj).Dat.H / 2
                    nx = Obj(i).Dat.X + Obj(i).Dat.W / 2
                    ny = Obj(i).Dat.Y + Obj(i).Dat.H / 2
                    distance = Int(Sqr((mx - nx +.1) ^ 2 + (my - ny + .1 ) ^ 2))
        '            If Obj(dragObj).Dat.X <= Obj(i).Dat.X + Obj(i).Dat.W And _
        '            Obj(dragObj).Dat.X + Obj(dragObj).Dat.W >= Obj(i).Dat.X And _
        '            Obj(dragObj).Dat.Y <= Obj(i).Dat.Y + Obj(i).Dat.H And _
        '            Obj(dragObj).Dat.Y + Obj(dragObj).Dat.H >= Obj(i).Dat.Y Then
                    If distance < Obj(dragObj).Dat.W Then
                        Overlap = True
                        
                        With Obj(dragObj).Dat
                            .X = .W * (mx - nx) / distance + nx - Obj(dragObj).Dat.W / 2
                            .Y = .W * (my - ny) / distance + ny - Obj(dragObj).Dat.W / 2
                        End With
                        
                        Label2.Caption = "Overlap"
                        Debug.Print "Overlap", X, Y, i
                        Exit For
                    Else
                        Label2.Caption = "NO Overlap"
        
                    End If
                
                End If
              
              Next i
            Loop While Overlap
      UpdatePicture
        
    End If
    
    End Sub

    Post Edit : You should also a global flag used as a semaphore to prohibit multiple events while the routine is processing.
    added a +.1 to avoid a div by 0 error
    Last edited by technorobbo; Mar 18th, 2009 at 10:23 AM.
    Have Fun,

    TR
    _____________________________
    Check out my Alpha DogFighter2D Game Demo and Source code. Direct Download:http://home.comcast.net/~technorobbo/Alpha.zip or Read about it in the forum:http://www.vbforums.com/showthread.php?t=551700. Now in 3D!!! http://home.comcast.net/~technorobbo/AlPha3D.zip or read about it in the forum: http://www.vbforums.com/showthread.php?goto=newpost&t=552560 and IChessChat3D internet chess game

  14. #14

    Thread Starter
    Lively Member
    Join Date
    Oct 2008
    Posts
    123

    Re: Drag&Collision

    Hi technorobbo
    I still have div by 0 error, but I think that this is not important.
    I can see if the distance value is 0 and I can
    set the value to .1

    Code:
    If distance <= 0 Then distance = 0.1
    I did not understand how to avoid infinite loop.
    When you have some time, can you explain me how I could do?

    Thanks for your precious time.

  15. #15
    Fanatic Member technorobbo's Avatar
    Join Date
    Dec 2008
    Location
    Chicago
    Posts
    864

    Re: Drag&Collision

    Like this:

    Code:
    Private Sub Picdest_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim nx As Single, ny As Single
    Dim mx As Single, my As Single
    Dim distance As Single, countdown As Integer
    Dim i As Integer
    
    If Button <> vbLeftButton Then Exit Sub
    
    If dragObj > 0 Then 'If we are currently moving an image
    Label1.Caption = "drag Object " & dragObj
    
        'Collision detection with
          With Obj(dragObj).Dat
            .X = X + Px - Xoffset '  Update the images position
            .Y = Y + Py - Yoffset
          End With
          countdown = 10
          Do
            Overlap = False
            For i = LBound(Obj) To UBound(Obj)
        
                If Not dragObj = i Then
    
                    mx = Obj(dragObj).Dat.X + Obj(dragObj).Dat.W / 2
                    my = Obj(dragObj).Dat.Y + Obj(dragObj).Dat.H / 2
                    nx = Obj(i).Dat.X + Obj(i).Dat.W / 2
                    ny = Obj(i).Dat.Y + Obj(i).Dat.H / 2
                    distance = Int(Sqr((mx - nx) ^ 2 + (my - ny) ^ 2)) + 0.001
        '            If Obj(dragObj).Dat.X <= Obj(i).Dat.X + Obj(i).Dat.W And _
        '            Obj(dragObj).Dat.X + Obj(dragObj).Dat.W >= Obj(i).Dat.X And _
        '            Obj(dragObj).Dat.Y <= Obj(i).Dat.Y + Obj(i).Dat.H And _
        '            Obj(dragObj).Dat.Y + Obj(dragObj).Dat.H >= Obj(i).Dat.Y Then
                    If distance < Obj(dragObj).Dat.W Then
                        Overlap = True
                        
                        With Obj(dragObj).Dat
                            .X = .W * (mx - nx) / distance + nx - Obj(dragObj).Dat.W / 2
                            .Y = .W * (my - ny) / distance + ny - Obj(dragObj).Dat.W / 2
                        End With
                        
                        Label2.Caption = "Overlap"
                        Debug.Print "Overlap", X, Y, i
                        Exit For
                    Else
                        Label2.Caption = "NO Overlap"
        
                    End If
                
                End If
              
              Next i
              countdown = countdown - 1
            Loop While Overlap And countdown
      UpdatePicture
        
    End If
    
    End Sub
    I also moved the .o1 offset to the distance variable - works better!

    I'm also wondering how this game will work, It very unique in it's design..
    Last edited by technorobbo; Mar 18th, 2009 at 06:33 PM.
    Have Fun,

    TR
    _____________________________
    Check out my Alpha DogFighter2D Game Demo and Source code. Direct Download:http://home.comcast.net/~technorobbo/Alpha.zip or Read about it in the forum:http://www.vbforums.com/showthread.php?t=551700. Now in 3D!!! http://home.comcast.net/~technorobbo/AlPha3D.zip or read about it in the forum: http://www.vbforums.com/showthread.php?goto=newpost&t=552560 and IChessChat3D internet chess game

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