Original Post
Hi!
I have a little Problem with my collision detection. Can you say me why it isn''t working?
-->
Private Function Collision() As Boolean
Dim IndexX As Integer, IndexX2 As Integer
Dim IndexY As Integer, IndexY2 As Integer
Dim R1 As RECT, R2 As RECT, R22 As RECT, R3 As RECT
IndexX = Val(kLR.PosX \ 22)
IndexY = Val(kLR.PosY \ 22)
Select Case kLR.Way
Case Links
IndexX = IndexX - 1
IndexX2 = IndexX
IndexY2 = IndexY - 1
Case Rechts
IndexX = IndexX + 1
IndexX2 = IndexX
IndexY2 = IndexY + 1
Case Hoch
IndexY = IndexY - 1
IndexX2 = IndexX + 1
IndexY2 = IndexY
Case Runter
IndexY = IndexY + 1
IndexY2 = IndexY
IndexX2 = IndexX + 1
End Select
If IndexX < 0 Then IndexX = 0
If IndexY < 0 Then IndexY = 0
If IndexX2 < 0 Then IndexX2 = 0
If IndexY2 < 0 Then IndexY2 = 0
'' Setting Player''s Rect
With R1
.Top = kLR.PosY
.Left = kLR.PosX
.Bottom = kLR.PosY + 22
.Right = kLR.PosX + 22
End With
'' Setting 1st Target-Rect
With R2
.Top = SpriteSize * IndexY
.Bottom = (SpriteSize * IndexY) + SpriteSize
.Left = SpriteSize * IndexX
.Right = (SpriteSize * IndexX) + SpriteSize
End With
'' Setting 2nd Target-Rect
With R22
.Top = SpriteSize * IndexY2
.Bottom = (SpriteSize * IndexY2) + SpriteSize
.Left = SpriteSize * IndexX2
.Right = (SpriteSize * IndexX2) + SpriteSize
End With
'' API-Function "IntersectRect"
If WorldArray(IndexX, IndexY) <> 1 Then
Kollision = CBool(IntersectRect(R3, R1, R2))
Debug.Print "R2: " & Collision & " World: " & WorldArray(IndexX, IndexY)
End If
If WorldArray(IndexX2, IndexY2) <> 1 Then
Kollision = CBool(IntersectRect(R3, R1, R22))
Debug.Print "R22: " & Collision & " World: " & WorldArray(IndexX, IndexY)
End If
End Function
,,,
<°L°>
V