Results 1 to 14 of 14

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

  1. #1

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    3,964

    Resolved [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?
    VB6 2D Sprite control

    To live is difficult, but we do it.

  2. #2
    Elite Hacker Jacob Roman's Avatar
    Join Date
    Aug 2004
    Location
    Miami Beach, FL
    Posts
    5,349

    Re: [VB6] - Building games with API functions

    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:
    1. Option Explicit
    2.  
    3. Private Type Vector
    4.  
    5.     X As Single
    6.     Y As Single
    7.  
    8. End Type
    9.  
    10. Private Type Sprite_Type
    11.  
    12.     Position As Vector
    13.     Width As Long
    14.     Height As Long
    15.    
    16.     'Collision Stuff
    17.     Collided As Boolean
    18.     NColl As Vector
    19.     DColl As Single
    20.  
    21. End Type
    22.  
    23. Private Player As Sprite_Type
    24. Private Monster As Sprite_Type
    25.  
    26. Private Running As Boolean
    27.  
    28. Private Const BUTTON_UP As Long = vbKeyW
    29. Private Const BUTTON_DOWN As Long = vbKeyS
    30. Private Const BUTTON_LEFT As Long = vbKeyA
    31. Private Const BUTTON_RIGHT As Long = vbKeyD
    32.  
    33. Private Const BUTTON_UP_FLAG As Long = 1
    34. Private Const BUTTON_DOWN_FLAG As Long = 2
    35. Private Const BUTTON_LEFT_FLAG As Long = 4
    36. Private Const BUTTON_RIGHT_FLAG As Long = 8
    37.  
    38. Public Key_State As Long
    39.  
    40. Private Function Check_Key(Key_Flag As Long) As Long
    41.  
    42.     Check_Key = Key_State And Key_Flag
    43.  
    44. End Function
    45.  
    46. Private Sub Keyboard_Controls()
    47.    
    48.     If Check_Key(BUTTON_UP_FLAG) Then
    49.         Player.Position.Y = Player.Position.Y - 1
    50.     End If
    51.            
    52.     If Check_Key(BUTTON_DOWN_FLAG) Then
    53.         Player.Position.Y = Player.Position.Y + 1
    54.     End If
    55.            
    56.     If Check_Key(BUTTON_LEFT_FLAG) Then
    57.         Player.Position.X = Player.Position.X - 1
    58.     End If
    59.            
    60.     If Check_Key(BUTTON_RIGHT_FLAG) Then
    61.         Player.Position.X = Player.Position.X + 1
    62.     End If
    63.  
    64. End Sub
    65.  
    66. 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)
    67.  
    68.     frmMain.Line (X, Y)-(X + Width, Y + Height), Color, BF
    69.  
    70. End Sub
    71.  
    72. Private Function Vector_New(ByVal X As Single, ByVal Y As Single) As Vector
    73.  
    74.     Vector_New.X = X
    75.     Vector_New.Y = Y
    76.    
    77. End Function
    78.  
    79. Private Function Vector_Subtract(A As Vector, B As Vector) As Vector
    80.  
    81.     Vector_Subtract.X = A.X - B.X
    82.     Vector_Subtract.Y = A.Y - B.Y
    83.    
    84. End Function
    85.  
    86. Private Function Vector_Multiply(A As Vector, B As Vector) As Single
    87.  
    88.     Vector_Multiply = A.X * B.X + A.Y * B.Y
    89.  
    90. End Function
    91.  
    92. Private Function Vector_Multiply2(A As Vector, ByVal Value As Single) As Vector
    93.  
    94.     Vector_Multiply2 = Vector_New(A.X * Value, A.Y * Value)
    95.  
    96. End Function
    97.  
    98. Private Sub Main()
    99.  
    100.     With frmMain
    101.    
    102.         .Show
    103.         .ScaleMode = vbPixels
    104.         .AutoRedraw = True
    105.    
    106.     End With
    107.    
    108.     With Player
    109.         .Position.X = frmMain.ScaleWidth / 2
    110.         .Position.Y = frmMain.ScaleHeight / 2
    111.         .Width = 30
    112.         .Height = 30
    113.     End With
    114.    
    115.     With Monster
    116.         .Position.X = 50
    117.         .Position.Y = 50
    118.         .Width = 30
    119.         .Height = 30
    120.     End With
    121.    
    122.     Running = True
    123.    
    124.     Do While Running = True
    125.    
    126.         frmMain.Cls
    127.         Keyboard_Controls
    128.         'Collision_Detection 'goes here. Uncomment once you have collision code pasted.
    129.         Draw_Filled_Rectangle Player.Position.X, Player.Position.Y, Player.Width, Player.Height, RGB(0, 255, 0)
    130.         Draw_Filled_Rectangle Monster.Position.X, Monster.Position.X, Monster.Width, Monster.Height, RGB(0, 0, 0)
    131.         DoEvents
    132.    
    133.     Loop
    134.  
    135. End Sub
    136.  
    137. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    138.  
    139.     Select Case KeyCode
    140.         Case BUTTON_UP
    141.             Key_State = Key_State Or BUTTON_UP_FLAG
    142.         Case BUTTON_DOWN
    143.             Key_State = Key_State Or BUTTON_DOWN_FLAG
    144.         Case BUTTON_LEFT
    145.             Key_State = Key_State Or BUTTON_LEFT_FLAG
    146.         Case BUTTON_RIGHT
    147.             Key_State = Key_State Or BUTTON_RIGHT_FLAG
    148.     End Select
    149.  
    150. End Sub
    151.  
    152. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    153.  
    154.     Select Case KeyCode
    155.         Case BUTTON_UP
    156.             Key_State = Key_State And (Not BUTTON_UP_FLAG)
    157.         Case BUTTON_DOWN
    158.             Key_State = Key_State And (Not BUTTON_DOWN_FLAG)
    159.         Case BUTTON_LEFT
    160.             Key_State = Key_State And (Not BUTTON_LEFT_FLAG)
    161.         Case BUTTON_RIGHT
    162.             Key_State = Key_State And (Not BUTTON_RIGHT_FLAG)
    163.     End Select
    164.  
    165. End Sub
    166.  
    167. Private Sub Form_Load()
    168.  
    169.     Main
    170.  
    171. End Sub
    172.  
    173. Private Sub Form_Unload(Cancel As Integer)
    174.    
    175.     Running = False
    176.     Unload frmMain
    177.  
    178. End Sub

    For rigid body collision, you'll need these:
    vb Code:
    1. 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
    2.    
    3.     Dim Axis(64) As Vector
    4.     Dim TAxis(64) As Single
    5.    
    6.     Dim Number_Of_Axes As Long: Number_Of_Axes = 0
    7.    
    8.     Dim I As Long, J As Long
    9.    
    10.     Dim E0 As Vector
    11.     Dim E1 As Vector
    12.     Dim E As Vector
    13.    
    14.     J = Number_Of_VerticesA - 1
    15.    
    16.     For I = 0 To J
    17.        
    18.         E0 = A(J)
    19.         E1 = A(I)
    20.        
    21.         E = Vector_Subtract(E1, E0)
    22.        
    23.         Axis(Number_Of_Axes).X = -E.Y
    24.         Axis(Number_Of_Axes).Y = E.X
    25.        
    26.         If (Interval_Intersect(A(), B(), Number_Of_VerticesA, Number_Of_VerticesB, Axis(Number_Of_Axes), Offset, TAxis(Number_Of_Axes))) = False Then
    27.        
    28.             Collide = False
    29.             Exit Function
    30.        
    31.         End If
    32.        
    33.         Number_Of_Axes = Number_Of_Axes + 1
    34.        
    35.         J = I
    36.        
    37.     Next I
    38.    
    39.     J = Number_Of_VerticesB - 1
    40.    
    41.     For I = 0 To J
    42.        
    43.         E0 = B(J)
    44.         E1 = B(I)
    45.        
    46.         E = Vector_Subtract(E1, E0)
    47.  
    48.         Axis(Number_Of_Axes).X = -E.Y
    49.         Axis(Number_Of_Axes).Y = E.X
    50.        
    51.         If (Interval_Intersect(A(), B(), Number_Of_VerticesA, Number_Of_VerticesB, Axis(Number_Of_Axes), Offset, TAxis(Number_Of_Axes))) = False Then
    52.        
    53.             Collide = False
    54.             Exit Function
    55.        
    56.         End If
    57.        
    58.         Number_Of_Axes = Number_Of_Axes + 1
    59.        
    60.         J = I
    61.        
    62.     Next I
    63.    
    64.     If (Find_Minimum_Translation_Distance(Axis(), TAxis(), Number_Of_Axes, N, T)) = False Then
    65.    
    66.         Collide = False
    67.         Exit Function
    68.        
    69.        
    70.     End If
    71.    
    72.     If Vector_Multiply(N, Offset) < 0 Then
    73.    
    74.         N.X = -N.X
    75.         N.Y = -N.Y
    76.        
    77.     End If
    78.    
    79.     Collide = True
    80.  
    81. End Function
    82.  
    83. Private Sub Get_Interval(Vertex_List() As Vector, Number_Of_Vertices As Long, Axis As Vector, Min As Single, Max As Single)
    84.  
    85.     Min = Vector_Multiply(Vertex_List(0), Axis)
    86.     Max = Vector_Multiply(Vertex_List(0), Axis)
    87.    
    88.     Dim I As Long
    89.    
    90.     For I = 1 To Number_Of_Vertices - 1
    91.    
    92.         Dim D As Single: D = Vector_Multiply(Vertex_List(I), Axis)
    93.    
    94.         If (D < Min) Then
    95.        
    96.             Min = D
    97.            
    98.         ElseIf (D > Max) Then
    99.        
    100.             Max = D
    101.            
    102.         End If
    103.    
    104.     Next I
    105.  
    106. End Sub
    107.  
    108. 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
    109.  
    110.     Dim Min(1) As Single, Max(1) As Single
    111.    
    112.     Get_Interval A(), Number_Of_VerticesA, Axis, Min(0), Max(0)
    113.     Get_Interval B(), Number_Of_VerticesB, Axis, Min(1), Max(1)
    114.    
    115.     Dim H As Single: H = Vector_Multiply(Offset, Axis)
    116.    
    117.     Min(0) = Min(0) + H
    118.     Max(0) = Max(0) + H
    119.    
    120.     Dim D0 As Single: D0 = Min(0) - Max(1)
    121.     Dim D1 As Single: D1 = Min(1) - Max(0)
    122.    
    123.     If ((D0 > 0) Or (D1 > 0)) Then
    124.    
    125.         Interval_Intersect = False
    126.         Exit Function
    127.        
    128.     Else
    129.  
    130.         If D0 > D1 Then
    131.        
    132.             TAxis = D0
    133.            
    134.         Else
    135.        
    136.             TAxis = D1
    137.            
    138.         End If
    139.        
    140.         Interval_Intersect = True
    141.         Exit Function
    142.        
    143.     End If
    144.  
    145. End Function
    146.  
    147. Private Function Normalize(Vec As Vector) As Single
    148.  
    149.     Dim Length As Single: Length = Sqr(Vec.X * Vec.X + Vec.Y * Vec.Y)
    150.        
    151.     If (Length = 0) Then
    152.    
    153.         Normalize = 0
    154.         Exit Function
    155.        
    156.     End If
    157.    
    158.     Vec = Vector_Multiply2(Vec, (1 / Length))
    159.  
    160.     Normalize = Length
    161.    
    162. End Function
    163.  
    164. 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
    165.  
    166.     Dim Mini As Long: Mini = -1
    167.  
    168.     T = 0
    169.     N = Vector_New(0, 0)
    170.    
    171.     Dim I As Long
    172.    
    173.     For I = 0 To Number_Of_Axes - 1
    174.    
    175.         Dim N2 As Single: N2 = Normalize(Axis(I))
    176.        
    177.         TAxis(I) = TAxis(I) / N2
    178.        
    179.         If TAxis(I) > T Or Mini = -1 Then
    180.    
    181.             Mini = I
    182.             T = TAxis(I)
    183.             N = Axis(I)
    184.  
    185.         End If
    186.        
    187.     Next I
    188.    
    189.     Find_Minimum_Translation_Distance = (Mini <> -1)
    190.  
    191. End Function
    192.  
    193. Private Function Collision_Detection() As Boolean
    194.    
    195.     Dim Vertex_List(4) As Vector
    196.     Dim Vertex_List2(4) As Vector
    197.    
    198.    'Tile wall
    199.     Vertex_List(0) = Vector_New(0, 0)
    200.     Vertex_List(1) = Vector_New(Monster.Width, 0)
    201.     Vertex_List(2) = Vector_New(Monster.Width, Monster.Height)
    202.     Vertex_List(3) = Vector_New(0, Monster.Height)
    203.    
    204.    'Player
    205.     Vertex_List2(0) = Vector_New(0, 0)
    206.     Vertex_List2(1) = Vector_New(Player.Width, 0)
    207.     Vertex_List2(2) = Vector_New(Player.Width, Player.Height)
    208.     Vertex_List2(3) = Vector_New(0, Player.Height)
    209.    
    210.     With Player
    211.        
    212.         .Collided = Collide(Vertex_List2(), Vertex_List(), 4, 4, Vector_Subtract(.Position, Monster.Position), .NColl, .DColl)
    213.            
    214.             If .Collided = True Then
    215.                 Collision_Detection = True
    216.                
    217.                 'Collision Response
    218.                 .Position = Vector_Subtract(.Position, Vector_Multiply2(.NColl, (.DColl * 1.01)))
    219.             End If
    220.        
    221.     End With
    222.    
    223. 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:
    1. 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
    2.    
    3.     Const NO_COLLISION As Long = 0
    4.     Const COL_LEFT As Long = 1
    5.     Const COL_RIGHT As Long = 2
    6.     Const COL_UP As Long = 3
    7.     Const COL_DOWN As Long = 4
    8.    
    9.     Dim Side As Long
    10.     Dim Overlap As Long
    11.    
    12.     If Not (B1_X < (B2_X + B2_Width) And _
    13.        (B1_X + B1_Width) > B2_X And _
    14.        B1_Y < (B2_Y + B2_Height) And _
    15.        (B1_Y + B1_Height) > B2_Y) Then
    16.         Collision_Box_To_Box = 0
    17.         Exit Function
    18.     End If
    19.    
    20.     Side = COL_LEFT
    21.     Overlap = Abs(B1_X - (B2_X + B2_Width))
    22.  
    23.     If Abs((B1_X + B1_Width) - B2_X) < Overlap Then
    24.         Side = COL_RIGHT
    25.         Overlap = Abs((B1_X + B1_Width) - B2_X)
    26.     End If
    27.    
    28.     If Abs(B1_Y - (B2_Y + B2_Height)) < Overlap Then
    29.         Side = COL_UP
    30.         Overlap = Abs(B1_Y - (B2_Y + B2_Height))
    31.     End If
    32.    
    33.     If Abs((B1_Y + B1_Height) - B2_Y) < Overlap Then
    34.         Side = COL_DOWN
    35.         Overlap = Abs((B1_Y + B1_Height) - B2_Y)
    36.     End If
    37.  
    38.     Collision_Box_To_Box = Side
    39.    
    40. End Function
    41.    
    42. Private Function Collision_Detection2(ByVal Overlap As Long)
    43.  
    44.     Const NO_COLLISION As Long = 0
    45.     Const COL_LEFT As Long = 1
    46.     Const COL_RIGHT As Long = 2
    47.     Const COL_UP As Long = 3
    48.     Const COL_DOWN As Long = 4
    49.  
    50.     Dim Side As Long
    51.  
    52.     With Player
    53.        
    54.          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)
    55.        
    56.          If Side <> 0 Then
    57.              Collision_Detection2 = True
    58.              .Collided = True
    59.              
    60.              'Collision Response
    61.              Select Case Side
    62.                  Case COL_LEFT: .Position.X = .Position.X + Overlap
    63.                  Case COL_RIGHT:: .Position.X = .Position.X - Overlap
    64.                  Case COL_UP:: .Position.Y = .Position.Y + Overlap
    65.                  Case COL_DOWN:: .Position.Y = .Position.Y - Overlap
    66.              End Select
    67.          End If
    68.     End With
    69.    
    70. End Function

  3. #3
    Elite Hacker Jacob Roman's Avatar
    Join Date
    Aug 2004
    Location
    Miami Beach, FL
    Posts
    5,349

    Re: [VB6] - Building games with API functions

    (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:
    1. Public Function Collision_Detection() As Boolean
    2.    
    3.     Dim Vertex_List(4) As Vector
    4.     Dim Vertex_List2(4) As Vector
    5.     Dim Boundry(8) As Vector
    6.     Dim Position As Vector
    7.     Dim I As Long
    8.    
    9.     Vertex_List(0) = Vector_New(0, 0)
    10.     Vertex_List(1) = Vector_New(TILE_SIZE, 0)
    11.     Vertex_List(2) = Vector_New(TILE_SIZE, TILE_SIZE)
    12.     Vertex_List(3) = Vector_New(0, TILE_SIZE)
    13.    
    14.     Vertex_List2(0) = Vector_New(0, 0)
    15.     Vertex_List2(1) = Vector_New(TILE_SIZE, 0)
    16.     Vertex_List2(2) = Vector_New(TILE_SIZE, TILE_SIZE)
    17.     Vertex_List2(3) = Vector_New(0, TILE_SIZE)
    18.    
    19.     With Player
    20.    
    21.         Boundry(0).X = .Coordinates.X - 1: Boundry(0).Y = .Coordinates.Y
    22.         Boundry(1).X = .Coordinates.X:     Boundry(1).Y = .Coordinates.Y - 1
    23.         Boundry(2).X = .Coordinates.X + 1: Boundry(2).Y = .Coordinates.Y
    24.         Boundry(3).X = .Coordinates.X:     Boundry(3).Y = .Coordinates.Y + 1
    25.         Boundry(4).X = .Coordinates.X:     Boundry(4).Y = .Coordinates.Y
    26.         Boundry(5).X = .Coordinates.X - 1:     Boundry(5).Y = .Coordinates.Y - 1
    27.         Boundry(6).X = .Coordinates.X + 1:     Boundry(6).Y = .Coordinates.Y - 1
    28.         Boundry(7).X = .Coordinates.X - 1:      Boundry(7).Y = .Coordinates.Y + 1
    29.         Boundry(8).X = .Coordinates.X + 1:     Boundry(8).Y = .Coordinates.Y + 1
    30.    
    31.         For I = 0 To 8
    32.             If Boundry(I).X <= 0 Then Boundry(I).X = 0
    33.             If Boundry(I).Y <= 0 Then Boundry(I).Y = 0
    34.             If Boundry(I).X >= Map.Width - 1 Then Boundry(I).X = Map.Width - 1
    35.             If Boundry(I).Y >= Map.Height - 1 Then Boundry(I).Y = Map.Height - 1
    36.        
    37.             Position.X = Map.Collision_Map.Vertex_List(Boundry(I).X, Boundry(I).Y).X
    38.             Position.Y = Map.Collision_Map.Vertex_List(Boundry(I).X, Boundry(I).Y).Y
    39.             .Collided = Collide(Vertex_List2(), Vertex_List(), 4, 4, Vector_Subtract(.Position, Position), .NColl, .DColl)
    40.            
    41.             If .Collided = True Then
    42.                 If Map.Collision_Map.Response(Boundry(I).X, Boundry(I).Y) = COLLISION_WALL Then
    43.                     Collision_Detection = True
    44.                     .Position = Vector_Subtract(.Position, Vector_Multiply2(.NColl, (.DColl * 1.01)))
    45.                 End If
    46.             End If
    47.         Next I
    48.        
    49.     End With
    50.  
    51. 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:
    1. Public Sub Convert_Position_To_Coordinates(Sprite As Sprite_Type)
    2.  
    3.     Sprite.Coordinates.X = Int(Sprite.Position.X / TILE_SIZE)
    4.     Sprite.Coordinates.Y = Int(Sprite.Position.Y / TILE_SIZE)
    5.  
    6. End Sub

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

    vb Code:
    1. Public Function Collision_Detection2(ByVal Overlap As Long)
    2.  
    3.     Const NO_COLLISION As Long = 0
    4.     Const COL_LEFT As Long = 1
    5.     Const COL_RIGHT As Long = 2
    6.     Const COL_UP As Long = 3
    7.     Const COL_DOWN As Long = 4
    8.  
    9.     Dim Boundry(8) As Vector
    10.     Dim Side As Long
    11.     Dim I As Long
    12.  
    13.     With Player
    14.    
    15.         Boundry(0).X = .Coordinates.X - 1: Boundry(0).Y = .Coordinates.Y
    16.         Boundry(1).X = .Coordinates.X:     Boundry(1).Y = .Coordinates.Y - 1
    17.         Boundry(2).X = .Coordinates.X + 1: Boundry(2).Y = .Coordinates.Y
    18.         Boundry(3).X = .Coordinates.X:     Boundry(3).Y = .Coordinates.Y + 1
    19.         Boundry(4).X = .Coordinates.X:     Boundry(4).Y = .Coordinates.Y
    20.         Boundry(5).X = .Coordinates.X - 1:     Boundry(5).Y = .Coordinates.Y - 1
    21.         Boundry(6).X = .Coordinates.X + 1:     Boundry(6).Y = .Coordinates.Y - 1
    22.         Boundry(7).X = .Coordinates.X - 1:      Boundry(7).Y = .Coordinates.Y + 1
    23.         Boundry(8).X = .Coordinates.X + 1:     Boundry(8).Y = .Coordinates.Y + 1
    24.        
    25.         For I = 0 To 8
    26.        
    27.             If Boundry(I).X <= 0 Then Boundry(I).X = 0
    28.             If Boundry(I).Y <= 0 Then Boundry(I).Y = 0
    29.             If Boundry(I).X >= Map.Width - 1 Then Boundry(I).X = Map.Width - 1
    30.             If Boundry(I).Y >= Map.Height - 1 Then Boundry(I).Y = Map.Height - 1
    31.  
    32.             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)
    33.            
    34.             If Side <> 0 Then
    35.                 If Map.Collision_Map.Response(Boundry(I).X, Boundry(I).Y) = COLLISION_WALL Then
    36.                     Collision_Detection2 = True
    37.                     .Collided = True
    38.                     Select Case Side
    39.                         Case COL_LEFT: .Position.X = .Position.X + Overlap
    40.                         Case COL_RIGHT:: .Position.X = .Position.X - Overlap
    41.                         Case COL_UP:: .Position.Y = .Position.Y + Overlap
    42.                         Case COL_DOWN:: .Position.Y = .Position.Y - Overlap
    43.                     End Select
    44.                 End If
    45.             End If
    46.            
    47.         Next I
    48.        
    49.     End With
    50.    
    51. 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
    Attached Files Attached Files

  4. #4

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    3,964

    Re: [VB6] - Building games with API functions

    Quote Originally Posted by Jacob Roman View Post
    (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:
    1. Public Function Collision_Detection() As Boolean
    2.    
    3.     Dim Vertex_List(4) As Vector
    4.     Dim Vertex_List2(4) As Vector
    5.     Dim Boundry(8) As Vector
    6.     Dim Position As Vector
    7.     Dim I As Long
    8.    
    9.     Vertex_List(0) = Vector_New(0, 0)
    10.     Vertex_List(1) = Vector_New(TILE_SIZE, 0)
    11.     Vertex_List(2) = Vector_New(TILE_SIZE, TILE_SIZE)
    12.     Vertex_List(3) = Vector_New(0, TILE_SIZE)
    13.    
    14.     Vertex_List2(0) = Vector_New(0, 0)
    15.     Vertex_List2(1) = Vector_New(TILE_SIZE, 0)
    16.     Vertex_List2(2) = Vector_New(TILE_SIZE, TILE_SIZE)
    17.     Vertex_List2(3) = Vector_New(0, TILE_SIZE)
    18.    
    19.     With Player
    20.    
    21.         Boundry(0).X = .Coordinates.X - 1: Boundry(0).Y = .Coordinates.Y
    22.         Boundry(1).X = .Coordinates.X:     Boundry(1).Y = .Coordinates.Y - 1
    23.         Boundry(2).X = .Coordinates.X + 1: Boundry(2).Y = .Coordinates.Y
    24.         Boundry(3).X = .Coordinates.X:     Boundry(3).Y = .Coordinates.Y + 1
    25.         Boundry(4).X = .Coordinates.X:     Boundry(4).Y = .Coordinates.Y
    26.         Boundry(5).X = .Coordinates.X - 1:     Boundry(5).Y = .Coordinates.Y - 1
    27.         Boundry(6).X = .Coordinates.X + 1:     Boundry(6).Y = .Coordinates.Y - 1
    28.         Boundry(7).X = .Coordinates.X - 1:      Boundry(7).Y = .Coordinates.Y + 1
    29.         Boundry(8).X = .Coordinates.X + 1:     Boundry(8).Y = .Coordinates.Y + 1
    30.    
    31.         For I = 0 To 8
    32.             If Boundry(I).X <= 0 Then Boundry(I).X = 0
    33.             If Boundry(I).Y <= 0 Then Boundry(I).Y = 0
    34.             If Boundry(I).X >= Map.Width - 1 Then Boundry(I).X = Map.Width - 1
    35.             If Boundry(I).Y >= Map.Height - 1 Then Boundry(I).Y = Map.Height - 1
    36.        
    37.             Position.X = Map.Collision_Map.Vertex_List(Boundry(I).X, Boundry(I).Y).X
    38.             Position.Y = Map.Collision_Map.Vertex_List(Boundry(I).X, Boundry(I).Y).Y
    39.             .Collided = Collide(Vertex_List2(), Vertex_List(), 4, 4, Vector_Subtract(.Position, Position), .NColl, .DColl)
    40.            
    41.             If .Collided = True Then
    42.                 If Map.Collision_Map.Response(Boundry(I).X, Boundry(I).Y) = COLLISION_WALL Then
    43.                     Collision_Detection = True
    44.                     .Position = Vector_Subtract(.Position, Vector_Multiply2(.NColl, (.DColl * 1.01)))
    45.                 End If
    46.             End If
    47.         Next I
    48.        
    49.     End With
    50.  
    51. 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:
    1. Public Sub Convert_Position_To_Coordinates(Sprite As Sprite_Type)
    2.  
    3.     Sprite.Coordinates.X = Int(Sprite.Position.X / TILE_SIZE)
    4.     Sprite.Coordinates.Y = Int(Sprite.Position.Y / TILE_SIZE)
    5.  
    6. End Sub

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

    vb Code:
    1. Public Function Collision_Detection2(ByVal Overlap As Long)
    2.  
    3.     Const NO_COLLISION As Long = 0
    4.     Const COL_LEFT As Long = 1
    5.     Const COL_RIGHT As Long = 2
    6.     Const COL_UP As Long = 3
    7.     Const COL_DOWN As Long = 4
    8.  
    9.     Dim Boundry(8) As Vector
    10.     Dim Side As Long
    11.     Dim I As Long
    12.  
    13.     With Player
    14.    
    15.         Boundry(0).X = .Coordinates.X - 1: Boundry(0).Y = .Coordinates.Y
    16.         Boundry(1).X = .Coordinates.X:     Boundry(1).Y = .Coordinates.Y - 1
    17.         Boundry(2).X = .Coordinates.X + 1: Boundry(2).Y = .Coordinates.Y
    18.         Boundry(3).X = .Coordinates.X:     Boundry(3).Y = .Coordinates.Y + 1
    19.         Boundry(4).X = .Coordinates.X:     Boundry(4).Y = .Coordinates.Y
    20.         Boundry(5).X = .Coordinates.X - 1:     Boundry(5).Y = .Coordinates.Y - 1
    21.         Boundry(6).X = .Coordinates.X + 1:     Boundry(6).Y = .Coordinates.Y - 1
    22.         Boundry(7).X = .Coordinates.X - 1:      Boundry(7).Y = .Coordinates.Y + 1
    23.         Boundry(8).X = .Coordinates.X + 1:     Boundry(8).Y = .Coordinates.Y + 1
    24.        
    25.         For I = 0 To 8
    26.        
    27.             If Boundry(I).X <= 0 Then Boundry(I).X = 0
    28.             If Boundry(I).Y <= 0 Then Boundry(I).Y = 0
    29.             If Boundry(I).X >= Map.Width - 1 Then Boundry(I).X = Map.Width - 1
    30.             If Boundry(I).Y >= Map.Height - 1 Then Boundry(I).Y = Map.Height - 1
    31.  
    32.             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)
    33.            
    34.             If Side <> 0 Then
    35.                 If Map.Collision_Map.Response(Boundry(I).X, Boundry(I).Y) = COLLISION_WALL Then
    36.                     Collision_Detection2 = True
    37.                     .Collided = True
    38.                     Select Case Side
    39.                         Case COL_LEFT: .Position.X = .Position.X + Overlap
    40.                         Case COL_RIGHT:: .Position.X = .Position.X - Overlap
    41.                         Case COL_UP:: .Position.Y = .Position.Y + Overlap
    42.                         Case COL_DOWN:: .Position.Y = .Position.Y - Overlap
    43.                     End Select
    44.                 End If
    45.             End If
    46.            
    47.         Next I
    48.        
    49.     End With
    50.    
    51. 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
    thanks for everything
    VB6 2D Sprite control

    To live is difficult, but we do it.

  5. #5

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    3,964

    Re: [VB6] - Building games with API functions

    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")
    VB6 2D Sprite control

    To live is difficult, but we do it.

  6. #6
    Elite Hacker Jacob Roman's Avatar
    Join Date
    Aug 2004
    Location
    Miami Beach, FL
    Posts
    5,349

    Re: [VB6] - Building games with API functions

    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

    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:
    1. Option Explicit
    2.  
    3. Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
    4. Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpPerformanceCount As Currency) As Long
    5.  
    6. Private Ticks_Per_Second As Currency
    7. Private Start_Time As Currency
    8.  
    9. Private Time As Single
    10. Private Milliseconds As Single
    11.  
    12. Private Running As Boolean
    13.  
    14. 'Some boolean variable to control time
    15. Private Time_Enabled As Boolean
    16.  
    17. Private Function Hi_Res_Timer_Initialize() As Boolean
    18.  
    19.     If QueryPerformanceFrequency(Ticks_Per_Second) = 0 Then
    20.         Hi_Res_Timer_Initialize = False
    21.     Else
    22.         QueryPerformanceCounter Start_Time
    23.         Hi_Res_Timer_Initialize = True
    24.     End If
    25.  
    26. End Function
    27.  
    28. Private Function Get_Elapsed_Time() As Single
    29.    
    30.     Dim Last_Time As Currency
    31.     Dim Current_Time As Currency
    32.    
    33.     QueryPerformanceCounter Current_Time
    34.     Get_Elapsed_Time = (Current_Time - Last_Time) / Ticks_Per_Second
    35.     QueryPerformanceCounter Last_Time
    36.    
    37. End Function
    38.  
    39. Private Sub cmdStart_Click()
    40.     If Time_Enabled = False Then
    41.         Milliseconds = Get_Elapsed_Time
    42.         Time_Enabled = True
    43.     End If
    44. End Sub
    45.  
    46. Private Sub cmdStartOver_Click()
    47.     Milliseconds = Get_Elapsed_Time
    48.     Time = Get_Elapsed_Time - Milliseconds
    49. End Sub
    50.  
    51. Private Sub cmdStop_Click()
    52.     Time_Enabled = False
    53. End Sub
    54.  
    55. Private Sub Form_Load()
    56.  
    57.     Me.Show
    58.     Me.AutoRedraw = True
    59.    
    60.     Hi_Res_Timer_Initialize
    61.     Running = True
    62.    
    63.     Do While Running = True
    64.         Me.Cls
    65.         If Time_Enabled = True Then
    66.             Time = Get_Elapsed_Time - Milliseconds
    67.         End If
    68.         Print Time
    69.         DoEvents
    70.     Loop
    71.    
    72. End Sub
    73.  
    74. Private Sub Form_Unload(Cancel As Integer)
    75.  
    76.     Running = False
    77.     Unload Me
    78.  
    79. 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:
    1. Public Sub Lock_Framerate(Target_FPS As Long)
    2.  
    3.     Static Last_Time As Currency
    4.     Dim Current_Time As Currency
    5.     Dim FPS As Single
    6.    
    7.     Do
    8.         QueryPerformanceCounter Current_Time
    9.         FPS = Ticks_Per_Second / (Current_Time - Last_Time)
    10.     Loop While (FPS > Target_FPS)
    11.    
    12.     QueryPerformanceCounter Last_Time
    13.  
    14. End Sub

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

    vb Code:
    1. Option Explicit
    2.  
    3. Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
    4. Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpPerformanceCount As Currency) As Long
    5.  
    6. Private Ticks_Per_Second As Currency
    7. Private Start_Time As Currency
    8.  
    9. Private Milliseconds As Single
    10. Private Frame_Count As Long
    11. Private Get_FPS As Long
    12.  
    13. Private Running As Boolean
    14.  
    15.  
    16. Private Function Hi_Res_Timer_Initialize() As Boolean
    17.  
    18.     If QueryPerformanceFrequency(Ticks_Per_Second) = 0 Then
    19.         Hi_Res_Timer_Initialize = False
    20.     Else
    21.         QueryPerformanceCounter Start_Time
    22.         Hi_Res_Timer_Initialize = True
    23.     End If
    24.  
    25. End Function
    26.  
    27. Private Function Get_Elapsed_Time() As Single
    28.    
    29.     Dim Last_Time As Currency
    30.     Dim Current_Time As Currency
    31.    
    32.     QueryPerformanceCounter Current_Time
    33.     Get_Elapsed_Time = (Current_Time - Last_Time) / Ticks_Per_Second
    34.     QueryPerformanceCounter Last_Time
    35.    
    36. End Function
    37.  
    38. Private Sub Lock_Framerate(Target_FPS As Long)
    39.  
    40.     Static Last_Time As Currency
    41.     Dim Current_Time As Currency
    42.     Dim FPS As Single
    43.    
    44.     Do
    45.         QueryPerformanceCounter Current_Time
    46.         FPS = Ticks_Per_Second / (Current_Time - Last_Time)
    47.     Loop While (FPS > Target_FPS)
    48.    
    49.     QueryPerformanceCounter Last_Time
    50.  
    51. End Sub
    52.  
    53.  
    54. Private Sub Form_Load()
    55.  
    56.     Me.Show
    57.     Me.AutoRedraw = True
    58.    
    59.     Hi_Res_Timer_Initialize
    60.     Milliseconds = Get_Elapsed_Time
    61.     Running = True
    62.    
    63.     Do While Running = True
    64.         Me.Cls
    65.         Me.Caption = "Frames Per Second: " & Get_FPS
    66.         'Getting FPS should be at the end of the game loop
    67.         Frame_Count = Frame_Count + 1
    68.         If Get_Elapsed_Time - Milliseconds >= 1 Then
    69.             Get_FPS = Frame_Count
    70.             Frame_Count = 0
    71.             Milliseconds = Get_Elapsed_Time
    72.         End If
    73.         Lock_Framerate 60 '60 frames per second
    74.         DoEvents
    75.     Loop
    76.    
    77. End Sub
    78.  
    79. Private Sub Form_Unload(Cancel As Integer)
    80.  
    81.     Running = False
    82.     Unload Me
    83.  
    84. 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:
    1. Private Const BUTTON_UP As Long = vbKeyW
    2. Private Const BUTTON_DOWN As Long = vbKeyS
    3. Private Const BUTTON_LEFT As Long = vbKeyA
    4. Private Const BUTTON_RIGHT As Long = vbKeyD
    5.  
    6. 'IMPORTANT - Needs to be in bits with the more buttons you use. ex: 1, 2, 4, 8, 16, 32, 64, 128, 256, etc.
    7. Private Const BUTTON_UP_FLAG As Long = 1
    8. Private Const BUTTON_DOWN_FLAG As Long = 2
    9. Private Const BUTTON_LEFT_FLAG As Long = 4
    10. Private Const BUTTON_RIGHT_FLAG As Long = 8
    11.  
    12. Private Key_State As Long
    13. Private Running As Boolean
    14.  
    15. Public Function Check_Key(Key_Flag As Long) As Long
    16.  
    17.     Check_Key = Key_State And Key_Flag
    18.  
    19. End Function
    20.  
    21. Public Sub Keyboard_Controls()
    22.    
    23.     If Check_Key(BUTTON_UP_FLAG) Then
    24.         Print "Up"
    25.     End If
    26.            
    27.     If Check_Key(BUTTON_DOWN_FLAG) Then
    28.         Print "Down"
    29.     End If
    30.            
    31.     If Check_Key(BUTTON_LEFT_FLAG) Then
    32.         Print "Left"
    33.     End If
    34.            
    35.     If Check_Key(BUTTON_RIGHT_FLAG) Then
    36.         Print "Right"
    37.     End If
    38.  
    39. End Sub
    40.  
    41. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    42.  
    43.     Select Case KeyCode
    44.         Case BUTTON_UP
    45.             Key_State = Key_State Or BUTTON_UP_FLAG
    46.         Case BUTTON_DOWN
    47.             Key_State = Key_State Or BUTTON_DOWN_FLAG
    48.         Case BUTTON_LEFT
    49.             Key_State = Key_State Or BUTTON_LEFT_FLAG
    50.         Case BUTTON_RIGHT
    51.             Key_State = Key_State Or BUTTON_RIGHT_FLAG
    52.     End Select
    53.  
    54. End Sub
    55.  
    56. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    57.  
    58.     Select Case KeyCode
    59.         Case BUTTON_UP
    60.             Key_State = Key_State And (Not BUTTON_UP_FLAG)
    61.         Case BUTTON_DOWN
    62.             Key_State = Key_State And (Not BUTTON_DOWN_FLAG)
    63.         Case BUTTON_LEFT
    64.             Key_State = Key_State And (Not BUTTON_LEFT_FLAG)
    65.         Case BUTTON_RIGHT
    66.             Key_State = Key_State And (Not BUTTON_RIGHT_FLAG)
    67.     End Select
    68.  
    69. End Sub
    70.  
    71.  
    72. Private Sub Form_Load()
    73.  
    74.     Me.Show
    75.     Me.AutoRedraw = True
    76.    
    77.     Running = True
    78.    
    79.     Do While Running = True
    80.         Me.Cls
    81.         Keyboard_Controls
    82.         DoEvents
    83.     Loop
    84.    
    85. End Sub
    86.  
    87. Private Sub Form_Unload(Cancel As Integer)
    88.  
    89.     Running = False
    90.     Unload Me
    91.  
    92. End Sub

  7. #7

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    3,964

    Re: [VB6] - Building games with API functions

    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?
    VB6 2D Sprite control

    To live is difficult, but we do it.

  8. #8
    Elite Hacker Jacob Roman's Avatar
    Join Date
    Aug 2004
    Location
    Miami Beach, FL
    Posts
    5,349

    Re: [VB6] - Building games with API functions

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

    vb Code:
    1. Option Explicit
    2.  
    3. Private Type Vector
    4.    
    5.     X As Single
    6.     Y As Single
    7.    
    8. End Type
    9.  
    10. Private Type RECT
    11.  
    12.     Left As Long
    13.     Top As Long
    14.     Right As Long
    15.     Bottom As Long
    16.  
    17. End Type
    18.  
    19. Private Type Animation_Type
    20.    
    21.     Frame_Size() As RECT
    22.     Number_Of_Frames As Long
    23.     Number_Of_Textures As Long
    24.     Current_Frame As Single
    25.     Current_Texture As Long
    26.     Frame_Counter As Long
    27.     Speed As Single
    28.     Mode As Long 'Single Shot, Loop, etc.
    29.     Offset() As Vector
    30.     Texture_Number() As Long
    31.    
    32. End Type
    33.  
    34. Private Type Sprite_Type
    35.  
    36.     X As Single
    37.     Y As Single
    38.     Animation_State() As Animation_Type
    39.     Texture_Path() As String
    40.     Texture_List() As Image
    41.     Total_Number_Of_Textures As Long
    42.     Transparency_Color As Long
    43.     Number_Of_Animation_States As Long
    44.     Current_Animation_State As Long
    45.    
    46. End Type
    47.  
    48. 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
    49.  
    50. Private Const ANIMATION_MODE_SINGLE_SHOT As Long = 0
    51. Private Const ANIMATION_MODE_LOOP As Long = 1
    52.  
    53. Private Sprite As Sprite_Type
    54. Private Running As Boolean
    55.  
    56. Private Sub Load_Textures()
    57.  
    58.     Dim Width As Long
    59.     Dim Height As Long
    60.     Dim Current_Texture As Long
    61.    
    62.     With Sprite
    63.    
    64.  
    65.         ReDim .Texture_Path(.Total_Number_Of_Textures) As String
    66.         ReDim .Texture_List(.Total_Number_Of_Textures) As Image
    67.        
    68.         .Texture_Path(0) = App.Path & "\Graphics\Ken1.bmp"
    69.         .Texture_Path(1) = App.Path & "\Graphics\Ken2.bmp"
    70.         .Texture_Path(2) = App.Path & "\Graphics\Ken3.bmp"
    71.         .Texture_Path(3) = App.Path & "\Graphics\Ken4.bmp"
    72.        
    73.         For Current_Texture = 0 To .Total_Number_Of_Textures - 1
    74.             .Texture_List(Current_Texture).Picture = .Texture_Path(Current_Texture)
    75.         Next Current_Texture
    76.        
    77.     End With
    78.        
    79. End Sub
    80.  
    81. Private Sub Setup_Sprite()
    82.  
    83.     With Sprite
    84.    
    85.         .X = 50
    86.         .Y = 100
    87.         .Total_Number_Of_Textures = 4
    88.         .Transparency_Color = RGB(0, 0, 0)
    89.         .Number_Of_Animation_States = 1
    90.        
    91.         ReDim .Animation_State(.Number_Of_Animation_States - 1) As Animation_Type
    92.        
    93.         With .Animation_State(0)
    94.        
    95.             .Number_Of_Frames = 6
    96.             .Number_Of_Textures = 4
    97.             .Speed = 0.25
    98.            
    99.             .Mode = ANIMATION_MODE_LOOP
    100.            
    101.             ReDim .Frame_Size(.Number_Of_Textures) As RECT
    102.             ReDim .Offset(.Number_Of_Textures) As Vector
    103.             ReDim .Texture_Number(.Number_Of_Frames) As Long
    104.            
    105.             .Frame_Size(0).Left = 0: .Frame_Size(0).Top = 0: .Frame_Size(0).Right = 60: .Frame_Size(0).Bottom = 92
    106.             .Frame_Size(1).Left = 0: .Frame_Size(1).Top = 0: .Frame_Size(1).Right = 61: .Frame_Size(1).Bottom = 91
    107.             .Frame_Size(2).Left = 0: .Frame_Size(2).Top = 0: .Frame_Size(2).Right = 59: .Frame_Size(2).Bottom = 94
    108.             .Frame_Size(3).Left = 0: .Frame_Size(3).Top = 0: .Frame_Size(3).Right = 56: .Frame_Size(3).Bottom = 95
    109.            
    110.             .Offset(0).X = 0: .Offset(0).Y = 3
    111.             .Offset(1).X = -1: .Offset(1).Y = 4
    112.             .Offset(2).X = 1: .Offset(2).Y = 1
    113.             .Offset(3).X = 2: .Offset(3).Y = 0
    114.            
    115.             .Texture_Number(0) = 0
    116.             .Texture_Number(1) = 1
    117.             .Texture_Number(2) = 0
    118.             .Texture_Number(3) = 2
    119.             .Texture_Number(4) = 3
    120.             .Texture_Number(5) = 2
    121.        
    122.         End With
    123.    
    124.     End With
    125.    
    126. End Sub
    127.  
    128. Private Sub Animate_Sprite()
    129.    
    130.     With Sprite
    131.        
    132.         With .Animation_State(.Current_Animation_State)
    133.             If .Number_Of_Frames <> 0 Then
    134.                 Select Case .Mode
    135.                     Case ANIMATION_MODE_SINGLE_SHOT
    136.                         If Int(.Current_Frame) > (.Number_Of_Frames - 1) Then
    137.                             .Current_Frame = (.Number_Of_Frames - 1)
    138.                         End If
    139.                     Case ANIMATION_MODE_LOOP
    140.                         If Int(.Current_Frame) > (.Number_Of_Frames - 1) Then
    141.                             .Current_Frame = 0
    142.                         End If
    143.                 End Select
    144.             End If
    145.            
    146.             .Current_Texture = .Texture_Number(Int(.Current_Frame))
    147.    
    148.             Frame.Left = (.X + .Frame_Size(.Current_Texture).Left + .Offset(.Current_Texture).X)
    149.             Frame.Top = (.Y + .Frame_Size(.Current_Texture).Top + .Offset(.Current_Texture).Y)
    150.             Frame.Right = (.X + .Frame_Size(.Current_Texture).Right + .Offset(.Current_Texture).X)
    151.             Frame.Bottom = (.Y + .Frame_Size(.Current_Texture).Bottom + .Offset(.Current_Texture).Y)
    152.            
    153.             Draw_Sprite
    154.                                              
    155.             .Current_Frame = .Current_Frame + .Speed
    156.    
    157.         End With
    158.    
    159.     End With
    160.  
    161. End Sub
    162.  
    163. Private Sub Draw_Sprite()
    164.    
    165.     With Sprite
    166.         TransparentBlt Me.hDC, _
    167.                       .X, .Y, _
    168.                       .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, _
    169.                       .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, _
    170.                       .Texture_List(.Animation_State(.Current_Animation_State).Current_Texture).hDC, _
    171.                       .X, .Y, _
    172.                       .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, _
    173.                       .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
    174.                       .Transparency_Color
    175.     End With
    176.  
    177. End Sub
    178.  
    179.  
    180. Private Sub Form_Load()
    181.  
    182.     Me.Show
    183.     Me.ScaleMode = vbPixels
    184.     Me.AutoRedraw = True
    185.    
    186.     Setup_Sprite
    187.     Load_Textures
    188.    
    189.     Running = True
    190.    
    191.     Do While Running = True
    192.         Me.Cls
    193.         Animate_Sprite
    194.         DoEvents
    195.     Loop
    196.  
    197. 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
    Attached Files Attached Files

  9. #9

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    3,964

    Re: [VB6] - Building games with API functions

    "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)
    VB6 2D Sprite control

    To live is difficult, but we do it.

  10. #10
    Elite Hacker Jacob Roman's Avatar
    Join Date
    Aug 2004
    Location
    Miami Beach, FL
    Posts
    5,349

    Re: [VB6] - Building games with API functions

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

    vb Code:
    1. Option Explicit
    2.      
    3.     Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
    4.     Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpPerformanceCount As Currency) As Long
    5.      
    6.     Private Ticks_Per_Second As Currency
    7.     Private Start_Time As Currency
    8.      
    9.     Private Milliseconds As Single
    10.     Private Frame_Count As Long
    11.     Private Get_FPS As Long
    12.      
    13.     Private Running As Boolean
    14.      
    15.      
    16.     Private Function Hi_Res_Timer_Initialize() As Boolean
    17.      
    18.         If QueryPerformanceFrequency(Ticks_Per_Second) = 0 Then
    19.             Hi_Res_Timer_Initialize = False
    20.         Else
    21.             QueryPerformanceCounter Start_Time
    22.             Hi_Res_Timer_Initialize = True
    23.         End If
    24.      
    25.     End Function
    26.      
    27.     Private Function Get_Elapsed_Time() As Single
    28.        
    29.         Dim Last_Time As Currency
    30.         Dim Current_Time As Currency
    31.        
    32.         QueryPerformanceCounter Current_Time
    33.         Get_Elapsed_Time = (Current_Time - Last_Time) / Ticks_Per_Second
    34.         QueryPerformanceCounter Last_Time
    35.        
    36.     End Function
    37.      
    38.     Private Sub Lock_Framerate(Target_FPS As Long)
    39.      
    40.         Static Last_Time As Currency
    41.         Dim Current_Time As Currency
    42.         Dim FPS As Single
    43.        
    44.         Do
    45.             QueryPerformanceCounter Current_Time
    46.             FPS = Ticks_Per_Second / (Current_Time - Last_Time)
    47.         Loop While (FPS > Target_FPS)
    48.        
    49.         QueryPerformanceCounter Last_Time
    50.      
    51.     End Sub
    52.      
    53.      
    54.     Private Sub Form_Load()
    55.      
    56.         Me.Show
    57.         Me.AutoRedraw = True
    58.        
    59.         Hi_Res_Timer_Initialize
    60.         Milliseconds = Get_Elapsed_Time
    61.         Running = True
    62.        
    63.         Do While Running = True
    64.             Me.Cls
    65.             Me.Caption = "Frames Per Second: " & Get_FPS
    66.             'Getting FPS should be at the end of the game loop
    67.             Frame_Count = Frame_Count + 1
    68.             If Get_Elapsed_Time - Milliseconds >= 1 Then
    69.                 Get_FPS = Frame_Count
    70.                 Frame_Count = 0
    71.                 Milliseconds = Get_Elapsed_Time
    72.             End If
    73.             Lock_Framerate 60 '60 frames per second
    74.             DoEvents
    75.         Loop
    76.        
    77.     End Sub
    78.      
    79.     Private Sub Form_Unload(Cancel As Integer)
    80.      
    81.         Running = False
    82.         Unload Me
    83.      
    84.     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

  11. #11

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    3,964

    Re: [VB6] - Building games with API functions

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

    To live is difficult, but we do it.

  12. #12
    Elite Hacker Jacob Roman's Avatar
    Join Date
    Aug 2004
    Location
    Miami Beach, FL
    Posts
    5,349

    Re: [VB6] - Building games with API functions

    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.

  13. #13

    Thread Starter
    PowerPoster joaquim's Avatar
    Join Date
    Apr 2007
    Posts
    3,964

    Re: [VB6] - Building games with API functions

    Quote Originally Posted by Jacob Roman View Post
    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)
    VB6 2D Sprite control

    To live is difficult, but we do it.

  14. #14
    Elite Hacker Jacob Roman's Avatar
    Join Date
    Aug 2004
    Location
    Miami Beach, FL
    Posts
    5,349

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

    If ya have any more questions, feel free to ask

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