[RESOLVED] [VB6] - Building games with API functions

Collisions:
i need some advices about collsions(like what is more faster).
the 'if' code:

Code:

---

Public Function CollisionPrecise(X1 As Long, Y1 As Long, Width1 As Long, Height1 As Long, X2 As Long, Y2 As Long, Width2 As Long, Height2 As Long) As Boolean
    If (X1 + Width1 >= X2 And X1 <= X2 + Width2) And (Y1 + Height1 >= Y2 And Y1 <= Y2 + Height2) Then
        CollisionPrecise = True
    Else
        CollisionPrecise = False
    End If
End Function

---

is more faster than:
IntersectRect() API function?

I never work with the IntersectRect API. Even professional game programmers don't use API's for collision. I actually have 2 fast methods of collison I can give you along with collision response. The first one is called rigid body collision detecton, which is used for polygons of any shape and size such as triangles, squares, rectangles, pentagons, hexagons, etc. And it's very accurate. Lets go ahead and setup a sample project so we have something to work with, with better controls and some math functions you'll need for rigid body collision:

vb Code:

Option Explicit
 
Private Type Vector
 
    X As Single
    Y As Single
 
End Type
 
Private Type Sprite_Type
 
    Position As Vector
    Width As Long
    Height As Long
    
    'Collision Stuff
    Collided As Boolean
    NColl As Vector
    DColl As Single
 
End Type
 
Private Player As Sprite_Type
Private Monster As Sprite_Type
 
Private Running As Boolean
 
Private Const BUTTON_UP As Long = vbKeyW
Private Const BUTTON_DOWN As Long = vbKeyS
Private Const BUTTON_LEFT As Long = vbKeyA
Private Const BUTTON_RIGHT As Long = vbKeyD
 
Private Const BUTTON_UP_FLAG As Long = 1
Private Const BUTTON_DOWN_FLAG As Long = 2
Private Const BUTTON_LEFT_FLAG As Long = 4
Private Const BUTTON_RIGHT_FLAG As Long = 8
 
Public Key_State As Long
 
Private Function Check_Key(Key_Flag As Long) As Long
 
    Check_Key = Key_State And Key_Flag
 
End Function
 
Private Sub Keyboard_Controls()
    
    If Check_Key(BUTTON_UP_FLAG) Then
        Player.Position.Y = Player.Position.Y - 1
    End If
            
    If Check_Key(BUTTON_DOWN_FLAG) Then
        Player.Position.Y = Player.Position.Y + 1
    End If
            
    If Check_Key(BUTTON_LEFT_FLAG) Then
        Player.Position.X = Player.Position.X - 1
    End If
            
    If Check_Key(BUTTON_RIGHT_FLAG) Then
        Player.Position.X = Player.Position.X + 1
    End If
 
End Sub
 
Private Sub Draw_Filled_Rectangle(ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long, ByVal Color As Long)
 
    frmMain.Line (X, Y)-(X + Width, Y + Height), Color, BF
 
End Sub
 
Private Function Vector_New(ByVal X As Single, ByVal Y As Single) As Vector
 
    Vector_New.X = X
    Vector_New.Y = Y
    
End Function
 
Private Function Vector_Subtract(A As Vector, B As Vector) As Vector
 
    Vector_Subtract.X = A.X - B.X
    Vector_Subtract.Y = A.Y - B.Y
    
End Function
 
Private Function Vector_Multiply(A As Vector, B As Vector) As Single
 
    Vector_Multiply = A.X * B.X + A.Y * B.Y
 
End Function
 
Private Function Vector_Multiply2(A As Vector, ByVal Value As Single) As Vector
 
    Vector_Multiply2 = Vector_New(A.X * Value, A.Y * Value)
 
End Function
 
Private Sub Main()
 
    With frmMain
    
        .Show
        .ScaleMode = vbPixels
        .AutoRedraw = True
    
    End With
    
    With Player
        .Position.X = frmMain.ScaleWidth / 2
        .Position.Y = frmMain.ScaleHeight / 2
        .Width = 30
        .Height = 30
    End With
    
    With Monster
        .Position.X = 50
        .Position.Y = 50
        .Width = 30
        .Height = 30
    End With
    
    Running = True
    
    Do While Running = True
    
        frmMain.Cls
        Keyboard_Controls
        'Collision_Detection 'goes here. Uncomment once you have collision code pasted.
        Draw_Filled_Rectangle Player.Position.X, Player.Position.Y, Player.Width, Player.Height, RGB(0, 255, 0)
        Draw_Filled_Rectangle Monster.Position.X, Monster.Position.X, Monster.Width, Monster.Height, RGB(0, 0, 0)
        DoEvents
    
    Loop
 
End Sub
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
 
    Select Case KeyCode
        Case BUTTON_UP
            Key_State = Key_State Or BUTTON_UP_FLAG
        Case BUTTON_DOWN
            Key_State = Key_State Or BUTTON_DOWN_FLAG
        Case BUTTON_LEFT
            Key_State = Key_State Or BUTTON_LEFT_FLAG
        Case BUTTON_RIGHT
            Key_State = Key_State Or BUTTON_RIGHT_FLAG
    End Select
 
End Sub
 
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
 
    Select Case KeyCode
        Case BUTTON_UP
            Key_State = Key_State And (Not BUTTON_UP_FLAG)
        Case BUTTON_DOWN
            Key_State = Key_State And (Not BUTTON_DOWN_FLAG)
        Case BUTTON_LEFT
            Key_State = Key_State And (Not BUTTON_LEFT_FLAG)
        Case BUTTON_RIGHT
            Key_State = Key_State And (Not BUTTON_RIGHT_FLAG)
    End Select
 
End Sub
 
Private Sub Form_Load()
 
    Main
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    
    Running = False
    Unload frmMain
 
End Sub

For rigid body collision, you'll need these:

vb Code:

Private Function Collide(A() As Vector, B() As Vector, Number_Of_VerticesA As Long, Number_Of_VerticesB As Long, Offset As Vector, N As Vector, T As Single) As Boolean
   
    Dim Axis(64) As Vector
    Dim TAxis(64) As Single
   
    Dim Number_Of_Axes As Long: Number_Of_Axes = 0
   
    Dim I As Long, J As Long
   
    Dim E0 As Vector
    Dim E1 As Vector
    Dim E As Vector
   
    J = Number_Of_VerticesA - 1
   
    For I = 0 To J
       
        E0 = A(J)
        E1 = A(I)
       
        E = Vector_Subtract(E1, E0)
       
        Axis(Number_Of_Axes).X = -E.Y
        Axis(Number_Of_Axes).Y = E.X
       
        If (Interval_Intersect(A(), B(), Number_Of_VerticesA, Number_Of_VerticesB, Axis(Number_Of_Axes), Offset, TAxis(Number_Of_Axes))) = False Then
       
            Collide = False
            Exit Function
       
        End If
       
        Number_Of_Axes = Number_Of_Axes + 1
       
        J = I
       
    Next I
   
    J = Number_Of_VerticesB - 1
   
    For I = 0 To J
       
        E0 = B(J)
        E1 = B(I)
       
        E = Vector_Subtract(E1, E0)
 
        Axis(Number_Of_Axes).X = -E.Y
        Axis(Number_Of_Axes).Y = E.X
       
        If (Interval_Intersect(A(), B(), Number_Of_VerticesA, Number_Of_VerticesB, Axis(Number_Of_Axes), Offset, TAxis(Number_Of_Axes))) = False Then
       
            Collide = False
            Exit Function
       
        End If
       
        Number_Of_Axes = Number_Of_Axes + 1
       
        J = I
       
    Next I
   
    If (Find_Minimum_Translation_Distance(Axis(), TAxis(), Number_Of_Axes, N, T)) = False Then
   
        Collide = False
        Exit Function
       
       
    End If
   
    If Vector_Multiply(N, Offset) < 0 Then
   
        N.X = -N.X
        N.Y = -N.Y
       
    End If
   
    Collide = True
 
End Function
 
Private Sub Get_Interval(Vertex_List() As Vector, Number_Of_Vertices As Long, Axis As Vector, Min As Single, Max As Single)
 
    Min = Vector_Multiply(Vertex_List(0), Axis)
    Max = Vector_Multiply(Vertex_List(0), Axis)
   
    Dim I As Long
   
    For I = 1 To Number_Of_Vertices - 1
   
        Dim D As Single: D = Vector_Multiply(Vertex_List(I), Axis)
   
        If (D < Min) Then
       
            Min = D
           
        ElseIf (D > Max) Then
       
            Max = D
           
        End If
   
    Next I
 
End Sub
 
Private Function Interval_Intersect(A() As Vector, B() As Vector, Number_Of_VerticesA As Long, Number_Of_VerticesB As Long, Axis As Vector, Offset As Vector, TAxis As Single) As Boolean
 
    Dim Min(1) As Single, Max(1) As Single
   
    Get_Interval A(), Number_Of_VerticesA, Axis, Min(0), Max(0)
    Get_Interval B(), Number_Of_VerticesB, Axis, Min(1), Max(1)
   
    Dim H As Single: H = Vector_Multiply(Offset, Axis)
   
    Min(0) = Min(0) + H
    Max(0) = Max(0) + H
   
    Dim D0 As Single: D0 = Min(0) - Max(1)
    Dim D1 As Single: D1 = Min(1) - Max(0)
   
    If ((D0 > 0) Or (D1 > 0)) Then
   
        Interval_Intersect = False
        Exit Function
       
    Else
 
        If D0 > D1 Then
       
            TAxis = D0
           
        Else
       
            TAxis = D1
           
        End If
       
        Interval_Intersect = True
        Exit Function
       
    End If
 
End Function
 
Private Function Normalize(Vec As Vector) As Single
 
    Dim Length As Single: Length = Sqr(Vec.X * Vec.X + Vec.Y * Vec.Y)
       
    If (Length = 0) Then
   
        Normalize = 0
        Exit Function
       
    End If
   
    Vec = Vector_Multiply2(Vec, (1 / Length))
 
    Normalize = Length
   
End Function
 
Private Function Find_Minimum_Translation_Distance(Axis() As Vector, TAxis() As Single, Number_Of_Axes As Long, N As Vector, T As Single) As Boolean
 
    Dim Mini As Long: Mini = -1
 
    T = 0
    N = Vector_New(0, 0)
   
    Dim I As Long
   
    For I = 0 To Number_Of_Axes - 1
   
        Dim N2 As Single: N2 = Normalize(Axis(I))
       
        TAxis(I) = TAxis(I) / N2
       
        If TAxis(I) > T Or Mini = -1 Then
   
            Mini = I
            T = TAxis(I)
            N = Axis(I)
 
        End If
       
    Next I
   
    Find_Minimum_Translation_Distance = (Mini <> -1)
 
End Function
 
Private Function Collision_Detection() As Boolean
   
    Dim Vertex_List(4) As Vector
    Dim Vertex_List2(4) As Vector
   
   'Tile wall
    Vertex_List(0) = Vector_New(0, 0)
    Vertex_List(1) = Vector_New(Monster.Width, 0)
    Vertex_List(2) = Vector_New(Monster.Width, Monster.Height)
    Vertex_List(3) = Vector_New(0, Monster.Height)
   
   'Player
    Vertex_List2(0) = Vector_New(0, 0)
    Vertex_List2(1) = Vector_New(Player.Width, 0)
    Vertex_List2(2) = Vector_New(Player.Width, Player.Height)
    Vertex_List2(3) = Vector_New(0, Player.Height)
   
    With Player
        
        .Collided = Collide(Vertex_List2(), Vertex_List(), 4, 4, Vector_Subtract(.Position, Monster.Position), .NColl, .DColl)
           
            If .Collided = True Then
                Collision_Detection = True
                
                'Collision Response
                .Position = Vector_Subtract(.Position, Vector_Multiply2(.NColl, (.DColl * 1.01)))
            End If
       
    End With
    
End Function

The other method of collision I use is Box to Box collision detection which is easier. Only with this it'll return the side it collided on. When calling Collision_Detection2 however, use 1 for accurate collision. Values above will offset the sprite.

vb Code:

Private Function Collision_Box_To_Box(ByVal B1_X As Single, ByVal B1_Y As Single, ByVal B1_Width As Single, ByVal B1_Height As Single, ByVal B2_X As Single, ByVal B2_Y As Single, ByVal B2_Width As Single, ByVal B2_Height As Single) As Long
   
    Const NO_COLLISION As Long = 0
    Const COL_LEFT As Long = 1
    Const COL_RIGHT As Long = 2
    Const COL_UP As Long = 3
    Const COL_DOWN As Long = 4
   
    Dim Side As Long
    Dim Overlap As Long
   
    If Not (B1_X < (B2_X + B2_Width) And _
       (B1_X + B1_Width) > B2_X And _
       B1_Y < (B2_Y + B2_Height) And _
       (B1_Y + B1_Height) > B2_Y) Then
        Collision_Box_To_Box = 0
        Exit Function
    End If
   
    Side = COL_LEFT
    Overlap = Abs(B1_X - (B2_X + B2_Width))
 
    If Abs((B1_X + B1_Width) - B2_X) < Overlap Then
        Side = COL_RIGHT
        Overlap = Abs((B1_X + B1_Width) - B2_X)
    End If
   
    If Abs(B1_Y - (B2_Y + B2_Height)) < Overlap Then
        Side = COL_UP
        Overlap = Abs(B1_Y - (B2_Y + B2_Height))
    End If
   
    If Abs((B1_Y + B1_Height) - B2_Y) < Overlap Then
        Side = COL_DOWN
        Overlap = Abs((B1_Y + B1_Height) - B2_Y)
    End If
 
    Collision_Box_To_Box = Side
   
End Function
    
Private Function Collision_Detection2(ByVal Overlap As Long)
 
    Const NO_COLLISION As Long = 0
    Const COL_LEFT As Long = 1
    Const COL_RIGHT As Long = 2
    Const COL_UP As Long = 3
    Const COL_DOWN As Long = 4
 
    Dim Side As Long
 
    With Player
       
         Side = Collision_Box_To_Box(Player.Position.X, Player.Position.Y, Player.Width, Player.Height, Monster.Position.X, Monster.Position.Y, Monster.Width, Monster.Height)
        
         If Side <> 0 Then
             Collision_Detection2 = True
             .Collided = True
             
             'Collision Response
             Select Case Side
                 Case COL_LEFT: .Position.X = .Position.X + Overlap
                 Case COL_RIGHT:: .Position.X = .Position.X - Overlap
                 Case COL_UP:: .Position.Y = .Position.Y + Overlap
                 Case COL_DOWN:: .Position.Y = .Position.Y - Overlap
             End Select
         End If
    End With
   
End Function

(Continued from above post) Also just to let ya know, if the collision isn't a sprite and its a tile in a tile engine, I do something differently but with the same algorithm. Most people would make the fatal mistake of looping through the whole map one tile at a time to check if a collision took place with the sprite. But if your map is gigantic in size, this would be sluggish. The faster way would be to check all 9 sides of the sprite to see if it collided into the tile surrounding it. Why check all 9 sides and not just the sprite itself? Cause if you are approaching the walls at an angle or move into a corner, you end up going through the walls! So for example, if you use rigid body collision, you do this, assuming you got a tile engine going:

vb Code:

Public Function Collision_Detection() As Boolean
    
    Dim Vertex_List(4) As Vector
    Dim Vertex_List2(4) As Vector
    Dim Boundry(8) As Vector
    Dim Position As Vector
    Dim I As Long
    
    Vertex_List(0) = Vector_New(0, 0)
    Vertex_List(1) = Vector_New(TILE_SIZE, 0)
    Vertex_List(2) = Vector_New(TILE_SIZE, TILE_SIZE)
    Vertex_List(3) = Vector_New(0, TILE_SIZE)
    
    Vertex_List2(0) = Vector_New(0, 0)
    Vertex_List2(1) = Vector_New(TILE_SIZE, 0)
    Vertex_List2(2) = Vector_New(TILE_SIZE, TILE_SIZE)
    Vertex_List2(3) = Vector_New(0, TILE_SIZE)
    
    With Player
    
        Boundry(0).X = .Coordinates.X - 1: Boundry(0).Y = .Coordinates.Y
        Boundry(1).X = .Coordinates.X:     Boundry(1).Y = .Coordinates.Y - 1
        Boundry(2).X = .Coordinates.X + 1: Boundry(2).Y = .Coordinates.Y
        Boundry(3).X = .Coordinates.X:     Boundry(3).Y = .Coordinates.Y + 1
        Boundry(4).X = .Coordinates.X:     Boundry(4).Y = .Coordinates.Y
        Boundry(5).X = .Coordinates.X - 1:     Boundry(5).Y = .Coordinates.Y - 1
        Boundry(6).X = .Coordinates.X + 1:     Boundry(6).Y = .Coordinates.Y - 1
        Boundry(7).X = .Coordinates.X - 1:      Boundry(7).Y = .Coordinates.Y + 1
        Boundry(8).X = .Coordinates.X + 1:     Boundry(8).Y = .Coordinates.Y + 1
    
        For I = 0 To 8
            If Boundry(I).X <= 0 Then Boundry(I).X = 0
            If Boundry(I).Y <= 0 Then Boundry(I).Y = 0
            If Boundry(I).X >= Map.Width - 1 Then Boundry(I).X = Map.Width - 1
            If Boundry(I).Y >= Map.Height - 1 Then Boundry(I).Y = Map.Height - 1
        
            Position.X = Map.Collision_Map.Vertex_List(Boundry(I).X, Boundry(I).Y).X
            Position.Y = Map.Collision_Map.Vertex_List(Boundry(I).X, Boundry(I).Y).Y
            .Collided = Collide(Vertex_List2(), Vertex_List(), 4, 4, Vector_Subtract(.Position, Position), .NColl, .DColl)
            
            If .Collided = True Then
                If Map.Collision_Map.Response(Boundry(I).X, Boundry(I).Y) = COLLISION_WALL Then
                    Collision_Detection = True
                    .Position = Vector_Subtract(.Position, Vector_Multiply2(.NColl, (.DColl * 1.01)))
                End If
            End If
        Next I
        
    End With
 
end function

with sprite coordinates being the tile position of where the sprite is at on the map. To convert a position into tile coordinates you do this:

vb Code:

Public Sub Convert_Position_To_Coordinates(Sprite As Sprite_Type)
 
    Sprite.Coordinates.X = Int(Sprite.Position.X / TILE_SIZE)
    Sprite.Coordinates.Y = Int(Sprite.Position.Y / TILE_SIZE)
 
End Sub

For Box to Box however, its similar but a little different for collision response:

vb Code:

Public Function Collision_Detection2(ByVal Overlap As Long)
 
    Const NO_COLLISION As Long = 0
    Const COL_LEFT As Long = 1
    Const COL_RIGHT As Long = 2
    Const COL_UP As Long = 3
    Const COL_DOWN As Long = 4
 
    Dim Boundry(8) As Vector
    Dim Side As Long
    Dim I As Long
 
    With Player
    
        Boundry(0).X = .Coordinates.X - 1: Boundry(0).Y = .Coordinates.Y
        Boundry(1).X = .Coordinates.X:     Boundry(1).Y = .Coordinates.Y - 1
        Boundry(2).X = .Coordinates.X + 1: Boundry(2).Y = .Coordinates.Y
        Boundry(3).X = .Coordinates.X:     Boundry(3).Y = .Coordinates.Y + 1
        Boundry(4).X = .Coordinates.X:     Boundry(4).Y = .Coordinates.Y
        Boundry(5).X = .Coordinates.X - 1:     Boundry(5).Y = .Coordinates.Y - 1
        Boundry(6).X = .Coordinates.X + 1:     Boundry(6).Y = .Coordinates.Y - 1
        Boundry(7).X = .Coordinates.X - 1:      Boundry(7).Y = .Coordinates.Y + 1
        Boundry(8).X = .Coordinates.X + 1:     Boundry(8).Y = .Coordinates.Y + 1
        
        For I = 0 To 8
        
            If Boundry(I).X <= 0 Then Boundry(I).X = 0
            If Boundry(I).Y <= 0 Then Boundry(I).Y = 0
            If Boundry(I).X >= Map.Width - 1 Then Boundry(I).X = Map.Width - 1
            If Boundry(I).Y >= Map.Height - 1 Then Boundry(I).Y = Map.Height - 1
 
            Side = Collision_Box_To_Box2(Player.Position.X, Player.Position.Y, TILE_SIZE, TILE_SIZE, Boundry(I).X * TILE_SIZE, Boundry(I).Y * TILE_SIZE, TILE_SIZE, TILE_SIZE)
            
            If Side <> 0 Then
                If Map.Collision_Map.Response(Boundry(I).X, Boundry(I).Y) = COLLISION_WALL Then
                    Collision_Detection2 = True
                    .Collided = True
                    Select Case Side
                        Case COL_LEFT: .Position.X = .Position.X + Overlap
                        Case COL_RIGHT:: .Position.X = .Position.X - Overlap
                        Case COL_UP:: .Position.Y = .Position.Y + Overlap
                        Case COL_DOWN:: .Position.Y = .Position.Y - Overlap
                    End Select
                End If
            End If
            
        Next I
        
    End With
    
End Function

Heres a project I uploaded for ya. Although it's an AStar sample I'm working on, it has the tile collision code I was talking about. Have fun :wave:
http://www.vbforums.com/attachment.p...1&d=1323219188

Quote:

---

Originally Posted by Jacob Roman

(Continued from above post) Also just to let ya know, if the collision isn't a sprite and its a tile in a tile engine, I do something differently but with the same algorithm. Most people would make the fatal mistake of looping through the whole map one tile at a time to check if a collision took place with the sprite. But if your map is gigantic in size, this would be sluggish. The faster way would be to check all 9 sides of the sprite to see if it collided into the tile surrounding it. Why check all 9 sides and not just the sprite itself? Cause if you are approaching the walls at an angle or move into a corner, you end up going through the walls! So for example, if you use rigid body collision, you do this, assuming you got a tile engine going:

vb Code:

Public Function Collision_Detection() As Boolean
    
    Dim Vertex_List(4) As Vector
    Dim Vertex_List2(4) As Vector
    Dim Boundry(8) As Vector
    Dim Position As Vector
    Dim I As Long
    
    Vertex_List(0) = Vector_New(0, 0)
    Vertex_List(1) = Vector_New(TILE_SIZE, 0)
    Vertex_List(2) = Vector_New(TILE_SIZE, TILE_SIZE)
    Vertex_List(3) = Vector_New(0, TILE_SIZE)
    
    Vertex_List2(0) = Vector_New(0, 0)
    Vertex_List2(1) = Vector_New(TILE_SIZE, 0)
    Vertex_List2(2) = Vector_New(TILE_SIZE, TILE_SIZE)
    Vertex_List2(3) = Vector_New(0, TILE_SIZE)
    
    With Player
    
        Boundry(0).X = .Coordinates.X - 1: Boundry(0).Y = .Coordinates.Y
        Boundry(1).X = .Coordinates.X:     Boundry(1).Y = .Coordinates.Y - 1
        Boundry(2).X = .Coordinates.X + 1: Boundry(2).Y = .Coordinates.Y
        Boundry(3).X = .Coordinates.X:     Boundry(3).Y = .Coordinates.Y + 1
        Boundry(4).X = .Coordinates.X:     Boundry(4).Y = .Coordinates.Y
        Boundry(5).X = .Coordinates.X - 1:     Boundry(5).Y = .Coordinates.Y - 1
        Boundry(6).X = .Coordinates.X + 1:     Boundry(6).Y = .Coordinates.Y - 1
        Boundry(7).X = .Coordinates.X - 1:      Boundry(7).Y = .Coordinates.Y + 1
        Boundry(8).X = .Coordinates.X + 1:     Boundry(8).Y = .Coordinates.Y + 1
    
        For I = 0 To 8
            If Boundry(I).X <= 0 Then Boundry(I).X = 0
            If Boundry(I).Y <= 0 Then Boundry(I).Y = 0
            If Boundry(I).X >= Map.Width - 1 Then Boundry(I).X = Map.Width - 1
            If Boundry(I).Y >= Map.Height - 1 Then Boundry(I).Y = Map.Height - 1
        
            Position.X = Map.Collision_Map.Vertex_List(Boundry(I).X, Boundry(I).Y).X
            Position.Y = Map.Collision_Map.Vertex_List(Boundry(I).X, Boundry(I).Y).Y
            .Collided = Collide(Vertex_List2(), Vertex_List(), 4, 4, Vector_Subtract(.Position, Position), .NColl, .DColl)
            
            If .Collided = True Then
                If Map.Collision_Map.Response(Boundry(I).X, Boundry(I).Y) = COLLISION_WALL Then
                    Collision_Detection = True
                    .Position = Vector_Subtract(.Position, Vector_Multiply2(.NColl, (.DColl * 1.01)))
                End If
            End If
        Next I
        
    End With
 
end function

with sprite coordinates being the tile position of where the sprite is at on the map. To convert a position into tile coordinates you do this:

vb Code:

Public Sub Convert_Position_To_Coordinates(Sprite As Sprite_Type)
 
    Sprite.Coordinates.X = Int(Sprite.Position.X / TILE_SIZE)
    Sprite.Coordinates.Y = Int(Sprite.Position.Y / TILE_SIZE)
 
End Sub

For Box to Box however, its similar but a little different for collision response:

vb Code:

Public Function Collision_Detection2(ByVal Overlap As Long)
 
    Const NO_COLLISION As Long = 0
    Const COL_LEFT As Long = 1
    Const COL_RIGHT As Long = 2
    Const COL_UP As Long = 3
    Const COL_DOWN As Long = 4
 
    Dim Boundry(8) As Vector
    Dim Side As Long
    Dim I As Long
 
    With Player
    
        Boundry(0).X = .Coordinates.X - 1: Boundry(0).Y = .Coordinates.Y
        Boundry(1).X = .Coordinates.X:     Boundry(1).Y = .Coordinates.Y - 1
        Boundry(2).X = .Coordinates.X + 1: Boundry(2).Y = .Coordinates.Y
        Boundry(3).X = .Coordinates.X:     Boundry(3).Y = .Coordinates.Y + 1
        Boundry(4).X = .Coordinates.X:     Boundry(4).Y = .Coordinates.Y
        Boundry(5).X = .Coordinates.X - 1:     Boundry(5).Y = .Coordinates.Y - 1
        Boundry(6).X = .Coordinates.X + 1:     Boundry(6).Y = .Coordinates.Y - 1
        Boundry(7).X = .Coordinates.X - 1:      Boundry(7).Y = .Coordinates.Y + 1
        Boundry(8).X = .Coordinates.X + 1:     Boundry(8).Y = .Coordinates.Y + 1
        
        For I = 0 To 8
        
            If Boundry(I).X <= 0 Then Boundry(I).X = 0
            If Boundry(I).Y <= 0 Then Boundry(I).Y = 0
            If Boundry(I).X >= Map.Width - 1 Then Boundry(I).X = Map.Width - 1
            If Boundry(I).Y >= Map.Height - 1 Then Boundry(I).Y = Map.Height - 1
 
            Side = Collision_Box_To_Box2(Player.Position.X, Player.Position.Y, TILE_SIZE, TILE_SIZE, Boundry(I).X * TILE_SIZE, Boundry(I).Y * TILE_SIZE, TILE_SIZE, TILE_SIZE)
            
            If Side <> 0 Then
                If Map.Collision_Map.Response(Boundry(I).X, Boundry(I).Y) = COLLISION_WALL Then
                    Collision_Detection2 = True
                    .Collided = True
                    Select Case Side
                        Case COL_LEFT: .Position.X = .Position.X + Overlap
                        Case COL_RIGHT:: .Position.X = .Position.X - Overlap
                        Case COL_UP:: .Position.Y = .Position.Y + Overlap
                        Case COL_DOWN:: .Position.Y = .Position.Y - Overlap
                    End Select
                End If
            End If
            
        Next I
        
    End With
    
End Function

Heres a project I uploaded for ya. Although it's an AStar sample I'm working on, it has the tile collision code I was talking about. Have fun :wave:
http://www.vbforums.com/attachment.p...1&d=1323219188

---

thanks for everything

Animation:
in Game Loop. how you calculate de milliseconds for the sprite animation?
(i understand that these questions are a basic game questions, but i can't find any manual that tell us these basic things. i know use transparentblt()(i don't use bitblt() because is more difficulty for mask). the GetTickCount() is more complicate to understand, but ok. i even didn't knew if you use form keyboard events or the keystate() api function. instead ask very things like these basic normal things, can you advice some nice toturial?)
(sorry if i bored you, but "if i don't have the path i can't walk")

Quote:

---

Originally Posted by joaquim

in Game Loop. how you calculate de milliseconds for the sprite animation?

---

Could you be a little more specific? Are you referring to animation speed? Or how long it took to fully animate? Or what :confused:

Quote:

---

Originally Posted by joaquim

the GetTickCount() is more complicate to understand, but ok

---

I personally don't use GetTickCount(). Instead I use a high resolution timer for more accurate time using QueryPerformanceCounter and QueryPerformanceFrequency API's. Heres an example program and some typical functions I use with them in action:

vb Code:

Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpPerformanceCount As Currency) As Long
 
Private Ticks_Per_Second As Currency
Private Start_Time As Currency
 
Private Time As Single
Private Milliseconds As Single
 
Private Running As Boolean
 
'Some boolean variable to control time
Private Time_Enabled As Boolean
 
Private Function Hi_Res_Timer_Initialize() As Boolean
 
    If QueryPerformanceFrequency(Ticks_Per_Second) = 0 Then
        Hi_Res_Timer_Initialize = False
    Else
        QueryPerformanceCounter Start_Time
        Hi_Res_Timer_Initialize = True
    End If
 
End Function
 
Private Function Get_Elapsed_Time() As Single
    
    Dim Last_Time As Currency
    Dim Current_Time As Currency
    
    QueryPerformanceCounter Current_Time
    Get_Elapsed_Time = (Current_Time - Last_Time) / Ticks_Per_Second
    QueryPerformanceCounter Last_Time
    
End Function
 
Private Sub cmdStart_Click()
    If Time_Enabled = False Then
        Milliseconds = Get_Elapsed_Time
        Time_Enabled = True
    End If
End Sub
 
Private Sub cmdStartOver_Click()
    Milliseconds = Get_Elapsed_Time
    Time = Get_Elapsed_Time - Milliseconds
End Sub
 
Private Sub cmdStop_Click()
    Time_Enabled = False
End Sub
 
Private Sub Form_Load()
 
    Me.Show
    Me.AutoRedraw = True
    
    Hi_Res_Timer_Initialize
    Running = True
    
    Do While Running = True
        Me.Cls
        If Time_Enabled = True Then
            Time = Get_Elapsed_Time - Milliseconds
        End If
        Print Time
        DoEvents
    Loop
    
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
 
    Running = False
    Unload Me
 
End Sub

Another function I use for non DirectX apps since DirectX handles the framerate for you is Lock_Framerate, which is also dependent on the QueryPerformanceCounter API:

vb Code:

Public Sub Lock_Framerate(Target_FPS As Long)
 
    Static Last_Time As Currency
    Dim Current_Time As Currency
    Dim FPS As Single
   
    Do
        QueryPerformanceCounter Current_Time
        FPS = Ticks_Per_Second / (Current_Time - Last_Time)
    Loop While (FPS > Target_FPS)
   
    QueryPerformanceCounter Last_Time
 
End Sub

Here is Lock_Framerate in action, along with an FPS counter:

vb Code:

Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpPerformanceCount As Currency) As Long
 
Private Ticks_Per_Second As Currency
Private Start_Time As Currency
 
Private Milliseconds As Single
Private Frame_Count As Long
Private Get_FPS As Long
 
Private Running As Boolean
 
 
Private Function Hi_Res_Timer_Initialize() As Boolean
 
    If QueryPerformanceFrequency(Ticks_Per_Second) = 0 Then
        Hi_Res_Timer_Initialize = False
    Else
        QueryPerformanceCounter Start_Time
        Hi_Res_Timer_Initialize = True
    End If
 
End Function
 
Private Function Get_Elapsed_Time() As Single
    
    Dim Last_Time As Currency
    Dim Current_Time As Currency
    
    QueryPerformanceCounter Current_Time
    Get_Elapsed_Time = (Current_Time - Last_Time) / Ticks_Per_Second
    QueryPerformanceCounter Last_Time
    
End Function
 
Private Sub Lock_Framerate(Target_FPS As Long)
 
    Static Last_Time As Currency
    Dim Current_Time As Currency
    Dim FPS As Single
   
    Do
        QueryPerformanceCounter Current_Time
        FPS = Ticks_Per_Second / (Current_Time - Last_Time)
    Loop While (FPS > Target_FPS)
   
    QueryPerformanceCounter Last_Time
 
End Sub
 
 
Private Sub Form_Load()
 
    Me.Show
    Me.AutoRedraw = True
    
    Hi_Res_Timer_Initialize
    Milliseconds = Get_Elapsed_Time
    Running = True
    
    Do While Running = True
        Me.Cls
        Me.Caption = "Frames Per Second: " & Get_FPS
        'Getting FPS should be at the end of the game loop
        Frame_Count = Frame_Count + 1
        If Get_Elapsed_Time - Milliseconds >= 1 Then
            Get_FPS = Frame_Count
            Frame_Count = 0
            Milliseconds = Get_Elapsed_Time
        End If
        Lock_Framerate 60 '60 frames per second
        DoEvents
    Loop
    
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
 
    Running = False
    Unload Me
 
End Sub

Quote:

---

Originally Posted by joaquim

i even didn't knew if you use form keyboard events or the keystate() api function.

---

I didn't use any API's for improved controls. I just used pure VB. How I did it was like so:

vb Code:

Private Const BUTTON_UP As Long = vbKeyW
Private Const BUTTON_DOWN As Long = vbKeyS
Private Const BUTTON_LEFT As Long = vbKeyA
Private Const BUTTON_RIGHT As Long = vbKeyD
 
'IMPORTANT - Needs to be in bits with the more buttons you use. ex: 1, 2, 4, 8, 16, 32, 64, 128, 256, etc.
Private Const BUTTON_UP_FLAG As Long = 1
Private Const BUTTON_DOWN_FLAG As Long = 2
Private Const BUTTON_LEFT_FLAG As Long = 4
Private Const BUTTON_RIGHT_FLAG As Long = 8
 
Private Key_State As Long
Private Running As Boolean
 
Public Function Check_Key(Key_Flag As Long) As Long
 
    Check_Key = Key_State And Key_Flag
 
End Function
 
Public Sub Keyboard_Controls()
    
    If Check_Key(BUTTON_UP_FLAG) Then
        Print "Up"
    End If
            
    If Check_Key(BUTTON_DOWN_FLAG) Then
        Print "Down"
    End If
            
    If Check_Key(BUTTON_LEFT_FLAG) Then
        Print "Left"
    End If
            
    If Check_Key(BUTTON_RIGHT_FLAG) Then
        Print "Right"
    End If
 
End Sub
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
 
    Select Case KeyCode
        Case BUTTON_UP
            Key_State = Key_State Or BUTTON_UP_FLAG
        Case BUTTON_DOWN
            Key_State = Key_State Or BUTTON_DOWN_FLAG
        Case BUTTON_LEFT
            Key_State = Key_State Or BUTTON_LEFT_FLAG
        Case BUTTON_RIGHT
            Key_State = Key_State Or BUTTON_RIGHT_FLAG
    End Select
 
End Sub
 
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
 
    Select Case KeyCode
        Case BUTTON_UP
            Key_State = Key_State And (Not BUTTON_UP_FLAG)
        Case BUTTON_DOWN
            Key_State = Key_State And (Not BUTTON_DOWN_FLAG)
        Case BUTTON_LEFT
            Key_State = Key_State And (Not BUTTON_LEFT_FLAG)
        Case BUTTON_RIGHT
            Key_State = Key_State And (Not BUTTON_RIGHT_FLAG)
    End Select
 
End Sub
 
 
Private Sub Form_Load()
 
    Me.Show
    Me.AutoRedraw = True
    
    Running = True
    
    Do While Running = True
        Me.Cls
        Keyboard_Controls
        DoEvents
    Loop
    
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
 
    Running = False
    Unload Me
 
End Sub

thanks for everything Jacob.
"Could you be a little more specific? Are you referring to animation speed? Or how long it took to fully animate? Or what???"
yes animation speed. the time what you use for change the frame.
how you do that?

Here's an example program, although I haven't tested it:

vb Code:

Option Explicit
 
Private Type Vector
    
    X As Single
    Y As Single
    
End Type
 
Private Type RECT
 
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
 
End Type
 
Private Type Animation_Type
    
    Frame_Size() As RECT
    Number_Of_Frames As Long
    Number_Of_Textures As Long
    Current_Frame As Single
    Current_Texture As Long
    Frame_Counter As Long
    Speed As Single
    Mode As Long 'Single Shot, Loop, etc.
    Offset() As Vector
    Texture_Number() As Long
    
End Type
 
Private Type Sprite_Type
 
    X As Single
    Y As Single
    Animation_State() As Animation_Type
    Texture_Path() As String
    Texture_List() As Image
    Total_Number_Of_Textures As Long
    Transparency_Color As Long
    Number_Of_Animation_States As Long
    Current_Animation_State As Long
    
End Type
 
Private Declare Function TransparentBlt Lib "msimg32.dll" (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 crTransparent As Long) As Boolean
 
Private Const ANIMATION_MODE_SINGLE_SHOT As Long = 0
Private Const ANIMATION_MODE_LOOP As Long = 1
 
Private Sprite As Sprite_Type
Private Running As Boolean
 
Private Sub Load_Textures()
 
    Dim Width As Long
    Dim Height As Long
    Dim Current_Texture As Long
    
    With Sprite
    
 
        ReDim .Texture_Path(.Total_Number_Of_Textures) As String
        ReDim .Texture_List(.Total_Number_Of_Textures) As Image
        
        .Texture_Path(0) = App.Path & "\Graphics\Ken1.bmp"
        .Texture_Path(1) = App.Path & "\Graphics\Ken2.bmp"
        .Texture_Path(2) = App.Path & "\Graphics\Ken3.bmp"
        .Texture_Path(3) = App.Path & "\Graphics\Ken4.bmp"
        
        For Current_Texture = 0 To .Total_Number_Of_Textures - 1
            .Texture_List(Current_Texture).Picture = .Texture_Path(Current_Texture)
        Next Current_Texture
        
    End With
        
End Sub
 
Private Sub Setup_Sprite()
 
    With Sprite
    
        .X = 50
        .Y = 100
        .Total_Number_Of_Textures = 4
        .Transparency_Color = RGB(0, 0, 0)
        .Number_Of_Animation_States = 1
        
        ReDim .Animation_State(.Number_Of_Animation_States - 1) As Animation_Type
        
        With .Animation_State(0)
        
            .Number_Of_Frames = 6
            .Number_Of_Textures = 4
            .Speed = 0.25
            
            .Mode = ANIMATION_MODE_LOOP
            
            ReDim .Frame_Size(.Number_Of_Textures) As RECT
            ReDim .Offset(.Number_Of_Textures) As Vector
            ReDim .Texture_Number(.Number_Of_Frames) As Long
            
            .Frame_Size(0).Left = 0: .Frame_Size(0).Top = 0: .Frame_Size(0).Right = 60: .Frame_Size(0).Bottom = 92
            .Frame_Size(1).Left = 0: .Frame_Size(1).Top = 0: .Frame_Size(1).Right = 61: .Frame_Size(1).Bottom = 91
            .Frame_Size(2).Left = 0: .Frame_Size(2).Top = 0: .Frame_Size(2).Right = 59: .Frame_Size(2).Bottom = 94
            .Frame_Size(3).Left = 0: .Frame_Size(3).Top = 0: .Frame_Size(3).Right = 56: .Frame_Size(3).Bottom = 95
            
            .Offset(0).X = 0: .Offset(0).Y = 3
            .Offset(1).X = -1: .Offset(1).Y = 4
            .Offset(2).X = 1: .Offset(2).Y = 1
            .Offset(3).X = 2: .Offset(3).Y = 0
            
            .Texture_Number(0) = 0
            .Texture_Number(1) = 1
            .Texture_Number(2) = 0
            .Texture_Number(3) = 2
            .Texture_Number(4) = 3
            .Texture_Number(5) = 2
        
        End With
    
    End With
    
End Sub
 
Private Sub Animate_Sprite()
    
    With Sprite
        
        With .Animation_State(.Current_Animation_State)
            If .Number_Of_Frames <> 0 Then
                Select Case .Mode
                    Case ANIMATION_MODE_SINGLE_SHOT
                        If Int(.Current_Frame) > (.Number_Of_Frames - 1) Then
                            .Current_Frame = (.Number_Of_Frames - 1)
                        End If
                    Case ANIMATION_MODE_LOOP
                        If Int(.Current_Frame) > (.Number_Of_Frames - 1) Then
                            .Current_Frame = 0
                        End If
                End Select
            End If
            
            .Current_Texture = .Texture_Number(Int(.Current_Frame))
    
            Frame.Left = (.X + .Frame_Size(.Current_Texture).Left + .Offset(.Current_Texture).X)
            Frame.Top = (.Y + .Frame_Size(.Current_Texture).Top + .Offset(.Current_Texture).Y)
            Frame.Right = (.X + .Frame_Size(.Current_Texture).Right + .Offset(.Current_Texture).X)
            Frame.Bottom = (.Y + .Frame_Size(.Current_Texture).Bottom + .Offset(.Current_Texture).Y)
            
            Draw_Sprite
                                             
            .Current_Frame = .Current_Frame + .Speed
    
        End With
    
    End With
 
End Sub
 
Private Sub Draw_Sprite()
    
    With Sprite
        TransparentBlt Me.hDC, _
                      .X, .Y, _
                      .Animation_State(.Current_Animation_State).Frame_Size(.Animation_State(.Current_Animation_State).Current_Texture).Right - .Animation_State(.Current_Animation_State).Frame_Size(.Animation_State(.Current_Animation_State).Current_Texture).Left, _
                      .Animation_State(.Current_Animation_State).Frame_Size(.Animation_State(.Current_Animation_State).Current_Texture).Bottom - .Animation_State(.Current_Animation_State).Frame_Size(.Animation_State(.Current_Animation_State).Current_Texture).Top, _
                      .Texture_List(.Animation_State(.Current_Animation_State).Current_Texture).hDC, _
                      .X, .Y, _
                      .Animation_State(.Current_Animation_State).Frame_Size(.Animation_State(.Current_Animation_State).Current_Texture).Right - .Animation_State(.Current_Animation_State).Frame_Size(.Animation_State(.Current_Animation_State).Current_Texture).Left, _
                      .Animation_State(.Current_Animation_State).Frame_Size(.Animation_State(.Current_Animation_State).Current_Texture).Bottom - .Animation_State(.Current_Animation_State).Frame_Size(.Animation_State(.Current_Animation_State).Current_Texture).Top
                      .Transparency_Color
    End With
 
End Sub
 
 
Private Sub Form_Load()
 
    Me.Show
    Me.ScaleMode = vbPixels
    Me.AutoRedraw = True
    
    Setup_Sprite
    Load_Textures
    
    Running = True
    
    Do While Running = True
        Me.Cls
        Animate_Sprite
        DoEvents
    Loop
 
End Sub

It's better if you lock the framerate at 60 or itll go too fast for ya. A working example will be this DirectX app I made a few years ago:

[EDIT] noticed I used .Current_Frame rather than .Current_Texture where its drawing sprite. Needs to be .Current_Texture

"It's better if you lock the framerate at 60 or itll go too fast for ya."
what you mean by that?
instead you give me an entire code, can you tell me how you calculate a the time?
thanks
PS: it's better create a class(to be a padron for wall's\persons\objects\others) or a normal type?
(the class can have everything. frames count\time\images, position\size and more)

Remember back in post #6 when I mentioned locking the frame rate at 60 frames per second?

vb Code:

Option Explicit
     
    Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpPerformanceCount As Currency) As Long
     
    Private Ticks_Per_Second As Currency
    Private Start_Time As Currency
     
    Private Milliseconds As Single
    Private Frame_Count As Long
    Private Get_FPS As Long
     
    Private Running As Boolean
     
     
    Private Function Hi_Res_Timer_Initialize() As Boolean
     
        If QueryPerformanceFrequency(Ticks_Per_Second) = 0 Then
            Hi_Res_Timer_Initialize = False
        Else
            QueryPerformanceCounter Start_Time
            Hi_Res_Timer_Initialize = True
        End If
     
    End Function
     
    Private Function Get_Elapsed_Time() As Single
       
        Dim Last_Time As Currency
        Dim Current_Time As Currency
       
        QueryPerformanceCounter Current_Time
        Get_Elapsed_Time = (Current_Time - Last_Time) / Ticks_Per_Second
        QueryPerformanceCounter Last_Time
       
    End Function
     
    Private Sub Lock_Framerate(Target_FPS As Long)
     
        Static Last_Time As Currency
        Dim Current_Time As Currency
        Dim FPS As Single
       
        Do
            QueryPerformanceCounter Current_Time
            FPS = Ticks_Per_Second / (Current_Time - Last_Time)
        Loop While (FPS > Target_FPS)
       
        QueryPerformanceCounter Last_Time
     
    End Sub
     
     
    Private Sub Form_Load()
     
        Me.Show
        Me.AutoRedraw = True
       
        Hi_Res_Timer_Initialize
        Milliseconds = Get_Elapsed_Time
        Running = True
       
        Do While Running = True
            Me.Cls
            Me.Caption = "Frames Per Second: " & Get_FPS
            'Getting FPS should be at the end of the game loop
            Frame_Count = Frame_Count + 1
            If Get_Elapsed_Time - Milliseconds >= 1 Then
                Get_FPS = Frame_Count
                Frame_Count = 0
                Milliseconds = Get_Elapsed_Time
            End If
            Lock_Framerate 60 '60 frames per second
            DoEvents
        Loop
       
    End Sub
     
    Private Sub Form_Unload(Cancel As Integer)
     
        Running = False
        Unload Me
     
    End Sub

You just need to blend that code with the animation stuff I gave ya. Also you can go either or with modules or classes. They both work. With me though, I personally just stick with modules but thats just me. It was just easier for me to handle than classes. Do whatever is easier for you :)

it's still confuse me. loop inside on another. i think that i can use the same lines that calculate the FPS, right?

Yes you can. And the reason why its looping inside another is cause it needs to lock the frame rate. You can have the framerate whatever you wish but typically in games its 60 FPS. It's similar to the Sleep API only different. But like I said, if you ever tap into DirectX, it does it for you so you wouldnt need to lock the framerate then.

Quote:

---

Originally Posted by Jacob Roman

Yes you can. And the reason why its looping inside another is cause it needs to lock the frame rate. You can have the framerate whatever you wish but typically in games its 60 FPS. It's similar to the Sleep API only different. But like I said, if you ever tap into DirectX, it does it for you so you wouldnt need to lock the framerate then.

---

thanks for everything. thanks for your time.
(sorry i can't rate you more;))

If ya have any more questions, feel free to ask :bigyello: