Collision Detection, project attached

[scr0p]

I have it so the box can be moved by keyboard, but I want to find out when its touching the wall. it uses a timer and picTure boxes, no BitbLt or anything special.

[golgo13sf]

Private Sub CheckDetection() '==?===
    If picMain.Left = wall.Left Then 'TOOK OUT THE AND CONDITION HERE
        wall.BackColor = vbRed 'Turn red when box touches it
    Else
        wall.BackColor = vbBlue 'turn blue when not touching it
    End If
End Sub

'CHANGED THE MOVEMENT VALUE, IT WAS SWITCHING TOO FAST TO SEE THE COLOR CHANGE, AT THIS SPEED YOU CAN SEE IT HAPPEN
Private Sub Moveit()
    If duck(0).Facing = 1 Then
        duck(0).X = duck(0).X - 1
        picMain.Left = duck(0).X
    ElseIf duck(0).Facing = 2 Then
        duck(0).Y = duck(0).Y - 1
        picMain.Top = duck(0).Y
    ElseIf duck(0).Facing = 3 Then
        duck(0).X = duck(0).X + 1
        picMain.Left = duck(0).X
    ElseIf duck(0).Facing = 4 Then
        duck(0).Y = duck(0).Y + 1
        picMain.Top = duck(0).Y
    End If
End Sub

[scr0p]

hmmM, thanks but there is a problem with this now, See if I pass the square UNDER the line, it still gets touched, I think because it doesnt check for Y, only for X, I wanna be able to go all around the square w/o color change, unless I touch it directly.




Also another thing, It seems to be too little, the "hot spot" Its like 1 pixelx1 pixel, How can I make it so if the edges touch, itll change color, not only if the center touches, thanks!

[golgo13sf]

this works now, also bounces the box off the wall, regardless of which surface, also the space bar stops the box

Option Explicit

    Private Type RECT
        Left As Long    'upper left x coord
        Top As Long     'upper left y coord
        Right As Long   'lower right x coord
        Bottom As Long  'lower right y coord
    End Type

    Private Type TEK
        X As Long
        Y As Long
        Facing As Long
    End Type
    
    Private Enum DIRECTION
        DirLeft = 1
        DirUp = 2
        DirRight = 3
        DirDown = 4
        DirStop = 5
    End Enum
    
    Private Box As RECT
    Private WallDimensions As RECT
    Private bHit As Boolean
    Dim duck(0) As TEK

Private Sub Form_Load()
    Randomize
    
    duck(0).X = Int(Rnd * Form1.ScaleWidth) - 10 '---Start the picMain box
    duck(0).Y = Int(Rnd * Form1.ScaleHeight) - 10 'anywhere within the form
    picMain.Left = duck(0).X 'randomLy
    picMain.Top = duck(0).Y '-------------------------------
    GetBoxBounds
    GetWallBounds
    bHit = False
    
End Sub

Private Sub GetWallBounds()
    
    With WallDimensions
        .Left = wall.Top
        .Top = wall.Left
        .Right = wall.Top + wall.Height
        .Bottom = wall.Left + wall.Width
    End With
    
End Sub

Private Sub GetBoxBounds()
    
    With Box
        .Left = picMain.Top
        .Top = picMain.Left
        .Right = picMain.Top + picMain.Height
        .Bottom = picMain.Left + picMain.Width
    End With
    
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyLeft Then            'Left
        duck(0).Facing = DirLeft
        
    ElseIf KeyCode = vbKeyUp Then        'Up
        duck(0).Facing = DirUp
        
    ElseIf KeyCode = vbKeyRight Then        'Right
        duck(0).Facing = DirRight
        
    ElseIf KeyCode = vbKeyDown Then        'Down
        duck(0).Facing = DirDown
        
    ElseIf KeyCode = vbKeySpace Then
        duck(0).Facing = DirStop
        
    End If
    
End Sub

Private Sub Timer1_Timer()

    Call Moveit
    Call CheckDetection
    
End Sub

Private Sub CheckCollision()

'check for left of box on right of wall, check for below top of wall, then bottom of wall
If Box.Top = WallDimensions.Bottom And (Box.Right >= WallDimensions.Left And Box.Left <= WallDimensions.Right) Then
    bHit = True
    ReverseDirection
    
'check for right of box on left of wall, check for below top of wall, then bottom of wall
ElseIf Box.Bottom = WallDimensions.Top And (Box.Right >= WallDimensions.Left And Box.Left <= WallDimensions.Right) Then
    bHit = True
    ReverseDirection
    
'check for bottom of box on top of wall, then within left of wall, then within right of wall
ElseIf Box.Right = WallDimensions.Left And (Box.Bottom >= WallDimensions.Top And Box.Top <= WallDimensions.Bottom) Then
    bHit = True
    ReverseDirection
    
'check for top of box on bottom of wall, then within left of wall, then within right of wall
ElseIf Box.Left = WallDimensions.Right And (Box.Bottom >= WallDimensions.Top And Box.Top <= WallDimensions.Bottom) Then
    bHit = True
    ReverseDirection
    
Else
    bHit = False
End If

End Sub


Private Sub ReverseDirection()
    
    Select Case duck(0).Facing
        Case DirUp
            duck(0).Facing = DirDown
            
        Case DirDown
            duck(0).Facing = DirUp
            
        Case DirRight
            duck(0).Facing = DirLeft
            
        Case DirLeft
            duck(0).Facing = DirRight
            
    End Select
    
End Sub

Private Sub CheckDetection() '==?===

    CheckCollision
    
    If bHit Then
        wall.BackColor = vbRed 'Turn red when box touches it
        
    Else
        wall.BackColor = vbBlue 'turn blue when not touching it
        
    End If
    
End Sub

Private Sub Moveit()

    If duck(0).Facing = DirLeft Then
        duck(0).X = duck(0).X - 1
        picMain.Left = duck(0).X
        GetBoxBounds
        
    ElseIf duck(0).Facing = DirUp Then
        duck(0).Y = duck(0).Y - 1
        picMain.Top = duck(0).Y
        GetBoxBounds
        
    ElseIf duck(0).Facing = DirRight Then
        duck(0).X = duck(0).X + 1
        picMain.Left = duck(0).X
        GetBoxBounds
        
    ElseIf duck(0).Facing = DirDown Then
        duck(0).Y = duck(0).Y + 1
        picMain.Top = duck(0).Y
        GetBoxBounds
        
    End If
    
End Sub

[scr0p]

ThanKs

[golgo13sf]

no problem