VB6源代碼--A*最短路徑算法(AStar Shortest Path Finder)

'--------Form1代碼--------------

<span style="font-family: Arial, Helvetica, sans-serif;">Option Explicit</span>
           

Dim Running As Boolean
Dim Done As Boolean

Private Sub Game_Loop()
    
        Collision_Detection
        Get_Player_Info
        Get_Sprite_Info Monster
        Render Map
        Get_Player_Info
        AStar_Find_Path Map, Monster, Player
        Draw_Sprite Monster, RGB(255, 0, 0)
        Draw_Player RGB(0, 255, 0)
        Draw_AStar_Path Monster
        
End Sub

Private Sub Form_Load()

    With Picture1
        .AutoRedraw = True
        .BackColor = RGB(0, 0, 0)
        .ScaleMode = vbPixels
        .ScaleWidth = 375
        .ScaleHeight = 375
    End With
    
    Player.Position.X = 1 * TILE_SIZE: Player.Position.Y = 1 * TILE_SIZE
    Monster.Position.X = 22 * TILE_SIZE: Monster.Position.Y = 1 * TILE_SIZE
    Map_Setup
    Me.Show
    Running = True
    Game_Loop

End Sub

Private Sub Shutdown()

    Running = False
    Unload Form1
    
End Sub

'------------------------

Private Sub Draw_Pixel(ByVal X As Long, ByVal Y As Long, ByVal Color As Long)

    Picture1.PSet (X, Y), Color

End Sub

Private Sub Draw_Rectangle(ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long, ByVal Color As Long)

    Picture1.Line (X, Y)-(X + Width, Y + Height), Color, B

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)

    Picture1.Line (X, Y)-(X + Width, Y + Height), Color, BF

End Sub

Private Sub Draw_Circle(ByVal X As Long, ByVal Y As Long, ByVal Radius As Long, ByVal Color As Long)

    Picture1.Circle (X, Y), Radius, Color

End Sub

Private Sub Render(Map As Map_Type)

    Dim Current As Vector
    
    'Asume proper drawing order....
    
    For Current.Y = 0 To Map.Height - 1
        For Current.X = 0 To Map.Width - 1
            
            'Draw the walls
            If Map.Tile(Current.X, Current.Y) = COLLISION_WALL Then
                Draw_Filled_Rectangle Current.X * TILE_SIZE, Current.Y * TILE_SIZE, TILE_SIZE, TILE_SIZE, RGB(0, 0, 255)
            ElseIf Map.Tile(Current.X, Current.Y) = COLLISION_NONE Then
                Draw_Filled_Rectangle Current.X * TILE_SIZE, Current.Y * TILE_SIZE, TILE_SIZE, TILE_SIZE, RGB(0, 0, 0)
            End If

            'Draw the grid
            Draw_Rectangle Current.X * TILE_SIZE, Current.Y * TILE_SIZE, TILE_SIZE, TILE_SIZE, RGB(255, 255, 255)
            
        Next Current.X
    Next Current.Y

End Sub

Private Sub Draw_Player(Color As Long)

    With Player
        Draw_Filled_Rectangle .Position.X, .Position.Y, TILE_SIZE, TILE_SIZE, Color
    End With
        
End Sub

Private Sub Draw_Sprite(Sprite As Sprite_Type, Color As Long)
        
    With Sprite
        Draw_Filled_Rectangle .Position.X, .Position.Y, TILE_SIZE, TILE_SIZE, Color
    End With
        
End Sub

Private Sub Draw_AStar_Path(Sprite As Sprite_Type)
    
    Dim Current_Node As Long
    Dim Position As Vector
    
    If IsArrayInitialized(VarPtrArray(Sprite.AStar_Path)) = False Then
        Exit Sub
    End If
    If Sprite.Length_Of_AStar_Path <= 0 Then
        Exit Sub
    End If
    If Sprite.Path_Found = True And Sprite.Path_Hunt = False Then
        For Current_Node = Sprite.Length_Of_AStar_Path To 0 Step -1
            Position.X = (Sprite.AStar_Path(Current_Node).X * TILE_SIZE) + (TILE_SIZE / 2)
            Position.Y = (Sprite.AStar_Path(Current_Node).Y * TILE_SIZE) + (TILE_SIZE / 2)
'            Draw_Pixel Position.X, Position.Y, RGB(255, 255, 0)
            Draw_Filled_Rectangle Position.X - TILE_SIZE / 4, Position.Y - TILE_SIZE / 4, TILE_SIZE / 2, TILE_SIZE / 2, RGB(255, 255, 0)
        Next Current_Node
    End If

End Sub
           

’------------Module1代碼----------------

Option Explicit

Private Const PI As Single = 3.14159265358979 'Atn(1) * 4

Public Type Vector

    X As Single
    Y As Single
    
End Type

Private Type Collision_Type

    Width As Single 'Same as map width
    Height As Single 'Same as map height
    Map() As String 'Only used for hardcoding maps. For loading maps you would just need Response()
    Response() As Long 'Your collision type. 0 for COLLISION_NONE. 1 for COLLISION_WALL. Other values can be for water, lava, etc.
    Vertex_List() As Vector
    
End Type

'You are welcome to adding more collision types such as COLLISION_WATER, COLLISION_LAVA, etc., to have predators avoid em, but you need to modify the AStar code a notch and
'program it in. To do this just copy and paste where the COLLISION_WALL code is and replace it with water, lava, etc.

Public Const COLLISION_NONE As Long = 0
Public Const COLLISION_WALL As Long = 1

Public Type Map_Type

    Position As Vector
    Number_Of_Tiles As Long
    Map() As String 'Only used for hardcoding maps. For loading maps you would just need Tile()
    Tile() As Long 'Tile type, such as 0 for nothing, 1 for wall, 2 or greater could be any other tile.
    Width As Long 'Width of map
    Height As Long 'Height of map
    Collision_Map As Collision_Type
    

End Type

Public Const TILE_SIZE As Long = 15

Public Map As Map_Type
Public Player As Sprite_Type
Public Monster As Sprite_Type

Private Type Node_Type

    OCList As Long
    G As Long
    H As Long
    F As Long
    X As Long
    Y As Long
    
End Type

Private Type Heap_Type

    Score As Long
    X As Long
    Y As Long
    
End Type

Public Type Sprite_Type

    Position As Vector
    Center_Position As Vector
    Previous_Position As Vector
    Previous_Coordinates As Vector
    Previous_Coordinates_Position As Vector
    Coordinates As Vector
    Coordinates_Position As Vector
    Center_Coordinates As Vector
    Center_Coordinates_Position As Vector
    Previous_Center_Coordinates As Vector
    Previous_Center_Coordinates_Position As Vector
    
    'Collision Stuff
    Collided As Boolean
    NColl As Vector
    DColl As Single
    Moving As Boolean
    
    'AI stuff
    Compute_AStar_Enabled As Boolean
    Length_Of_AStar_Path As Long
    Current_Path As Long
    Nodes() As Node_Type
    Size_Of_Heap As Long 'Size of the heap array
    Heap() As Heap_Type 'Heap Array
    AStar_Path() As Vector
    Path_Found As Boolean
    Path_Hunt As Boolean
    Vec As Vector
    AStar_Moving As Boolean
    
End Type

Private Const Opened As Long = 1
Private Const Closed As Long = 2

Private mu As Vector

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long

Public Sub Map_Setup()

    Dim X As Long, Y As Long
    Dim Temp As Variant
    
    With Map
        .Width = 25
        .Height = 25
        .Number_Of_Tiles = .Width * .Height
        
        ReDim Monster.Nodes(.Width - 1, .Height - 1) As Node_Type
        ReDim .Map(.Height - 1)
        ReDim .Tile(.Width - 1, .Height - 1)
        ReDim .Collision_Map.Map(.Height - 1)
        ReDim .Collision_Map.Response(.Width - 1, .Height - 1) As Long
        ReDim .Collision_Map.Vertex_List(.Width - 1, .Height - 1) As Vector
        
        .Map(0) = " 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1"
        .Map(1) = " 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1"
        .Map(2) = " 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1"
        .Map(3) = " 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 1"
        .Map(4) = " 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1"
        .Map(5) = " 1, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1"
        .Map(6) = " 1, 0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1"
        .Map(7) = " 1, 0, 0, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1, 1, 0, 1, 0, 0, 0, 1, 0, 0, 1"
        .Map(8) = " 1, 1, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 1"
        .Map(9) = " 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1"
        .Map(10) = "1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 1"
        .Map(11) = "1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 1"
        .Map(12) = "1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1"
        .Map(13) = "1, 0, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1"
        .Map(14) = "1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 1"
        .Map(15) = "1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1"
        .Map(16) = "1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1"
        .Map(17) = "1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 1"
        .Map(18) = "1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1"
        .Map(19) = "1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 0, 0, 1"
        .Map(20) = "1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 1"
        .Map(21) = "1, 0, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1"
        .Map(22) = "1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1"
        .Map(23) = "1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 1"
        .Map(24) = "1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1"
        
        For Y = 0 To .Height - 1
            Temp = Split(Map.Map(Y), ", ", -1)
            For X = 0 To Map.Width - 1
                .Tile(X, Y) = CLng(Temp(X))
            Next X
        Next Y
        
        With .Collision_Map
            .Width = Map.Width
            .Height = Map.Height
            For Y = 0 To .Height - 1
                .Map(Y) = Map.Map(Y)
                Temp = Split(.Map(Y), ", ", -1)
                For X = 0 To .Width - 1
                    .Response(X, Y) = CLng(Temp(X))
                    .Vertex_List(X, Y).X = TILE_SIZE * X
                    .Vertex_List(X, Y).Y = TILE_SIZE * Y
                Next X
            Next Y
            
        End With
    End With
    
End Sub

Private 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

Public Sub Get_Player_Info()
    
    'NOTE: FIX CODE CAUSE ASTAR IS DEPENDENT ON PLAYER / MONSTER COORDINATES TO FIRE ASTAR
    
    With Player
        If .Previous_Center_Coordinates.X <> .Center_Coordinates.X Or .Previous_Center_Coordinates.Y <> .Center_Coordinates.Y Then
            .Previous_Coordinates.X = .Coordinates.X
            .Previous_Coordinates.Y = .Coordinates.Y
            .Previous_Center_Coordinates.X = .Center_Coordinates.X
            .Previous_Center_Coordinates.Y = .Center_Coordinates.Y
            .Previous_Coordinates_Position.X = .Coordinates_Position.X
            .Previous_Coordinates_Position.Y = .Coordinates_Position.Y
            .Previous_Center_Coordinates_Position.X = .Center_Coordinates_Position.X
            .Previous_Center_Coordinates_Position.Y = .Center_Coordinates_Position.Y
            .Compute_AStar_Enabled = True
            Clear_AStar Map
        Else
            .Compute_AStar_Enabled = False
        End If
        .Coordinates.X = Int(.Position.X / TILE_SIZE)
        .Coordinates.Y = Int(.Position.Y / TILE_SIZE)
        .Center_Coordinates.X = Int((.Position.X + (TILE_SIZE / 2)) / TILE_SIZE)
        .Center_Coordinates.Y = Int((.Position.Y + (TILE_SIZE / 2)) / TILE_SIZE)
        .Coordinates_Position.X = Int(.Position.X / TILE_SIZE) * TILE_SIZE
        .Coordinates_Position.Y = Int(.Position.Y / TILE_SIZE) * TILE_SIZE
        .Center_Coordinates_Position.X = Int(.Position.X / TILE_SIZE) * TILE_SIZE + (TILE_SIZE / 2)
        .Center_Coordinates_Position.Y = Int(.Position.Y / TILE_SIZE) * TILE_SIZE + (TILE_SIZE / 2)
        .Center_Position.X = .Position.X + (TILE_SIZE / 2)
        .Center_Position.Y = .Position.Y + (TILE_SIZE / 2)
    End With

End Sub

Public Sub Get_Sprite_Info(Sprite As Sprite_Type)

    Static Temp As Vector

    With Sprite
        If .Position.X <= 0 Then .Position.X = 0
        If .Position.Y <= 0 Then .Position.Y = 0
        If .Position.X >= (Map.Width - 1) * TILE_SIZE Then .Position.X = (Map.Width - 1) * TILE_SIZE
        If .Position.Y >= (Map.Height - 1) * TILE_SIZE Then .Position.Y = (Map.Height - 1) * TILE_SIZE
        If Temp.X <> .Center_Coordinates.X Or Temp.Y <> .Center_Coordinates.Y Then
            Temp.X = .Center_Coordinates.X
            Temp.Y = .Center_Coordinates.Y
           ' .Compute_AStar_Enabled = True
           ' Clear_AStar Map
        Else
            .Compute_AStar_Enabled = False
        End If
        .Coordinates.X = Int(.Position.X / TILE_SIZE)
        .Coordinates.Y = Int(.Position.Y / TILE_SIZE)
        .Center_Coordinates.X = Int((.Position.X + (TILE_SIZE / 2)) / TILE_SIZE)
        .Center_Coordinates.Y = Int((.Position.Y + (TILE_SIZE / 2)) / TILE_SIZE)
        .Coordinates_Position.X = Int(.Position.X / TILE_SIZE) * TILE_SIZE
        .Coordinates_Position.Y = Int(.Position.Y / TILE_SIZE) * TILE_SIZE
        .Center_Coordinates_Position.X = Int(.Position.X / TILE_SIZE) * TILE_SIZE + (TILE_SIZE / 2)
        .Center_Coordinates_Position.Y = Int(.Position.Y / TILE_SIZE) * TILE_SIZE + (TILE_SIZE / 2)
        .Center_Position.X = .Position.X + (TILE_SIZE / 2)
        .Center_Position.Y = .Position.Y + (TILE_SIZE / 2)
    End With

End Sub

Private Function ACos(ByVal Value As Double) As Double

    On Error GoTo Error_Handler
    ACos = Atn(-Value / Sqr(-Value * Value + 1)) + 2 * Atn(1)
    Exit Function
Error_Handler:
    ACos = 0
    
End Function

Private Function ASin(ByVal Value As Double) As Double

    On Error GoTo Error_Handler
    ASin = Atn(Value / Sqr(-Value * Value + 1))
    Exit Function
Error_Handler:
    ASin = 0

End Function

Private Function Ceil(ByVal Number) As Long

    If Number >= 0 Then
        If Number = Int(Number) Then
            Ceil = Number
        Else
            Ceil = Int(Number) + 1
        End If
    ElseIf Number < 0 Then
        Ceil = Int(Number)
        
    End If
End Function

Private Function Floor(ByVal Number) As Long

    Floor = Fix(Number)
    
End Function

Private Function Linear_Interpolation_1D(ByVal Vertex As Single, ByVal X_Start As Single, ByVal X_End As Single, ByRef mu As Single, ByVal Speed) As Boolean

    If (X_End >= X_Start) Then
        mu = mu + Convert_Speed_To_MU(Speed, X_Start, X_End)
    Else
        mu = mu + Convert_Speed_To_MU(-Speed, X_Start, X_End)
    End If
    
    If mu <= 0 Then mu = 0
    If mu >= 1 Then
        mu = 1
        Linear_Interpolation_1D = True
    End If
    
   Vertex = (X_Start * (1 - mu) + X_End * mu)

End Function

Private Function Linear_Interpolation_2D(ByRef Position As Vector, ByVal X_Start As Single, ByVal Y_Start As Single, ByVal X_End As Single, ByVal Y_End As Single, ByRef mu As Vector, ByVal Speed As Single) As Boolean
    
    Dim Radian As Single
    
    If (X_End - X_Start) = 0 And (Y_End - Y_Start) <> 0 Then
        mu.X = 1
    ElseIf (X_End - X_Start) <> 0 And (Y_End - Y_Start) = 0 Then
        mu.Y = 1
    ElseIf (X_End - X_Start) = 0 And (Y_End - Y_Start) = 0 Then
        Linear_Interpolation_2D = True
        Exit Function
    End If
    
    Radian = Get_Radian(X_Start, Y_Start, X_End, Y_End)
    
    mu.X = mu.X + Convert_Speed_To_MU(Speed, X_Start, X_End) * Cos(Radian)
    mu.Y = mu.Y + Convert_Speed_To_MU(Speed, Y_Start, Y_End) * Sin(Radian)

    If mu.X <= 0 Then mu.X = 0
    If mu.X >= 1 Then mu.X = 1

    If mu.Y <= 0 Then mu.Y = 0
    If mu.Y >= 1 Then mu.Y = 1
    
    Position.X = Ceil(X_Start * (1 - mu.X) + X_End * mu.X)
    Position.Y = Ceil(Y_Start * (1 - mu.Y) + Y_End * mu.Y)
    
    If mu.X = 1 And mu.Y = 1 Then
        Linear_Interpolation_2D = True
        Exit Function
    End If
    
End Function

Private Function Convert_Speed_To_MU(ByVal Speed As Single, ByVal X_Start As Single, ByVal X_End As Single) As Single
    
    If (X_End - X_Start) <> 0 Then Convert_Speed_To_MU = Speed / (X_End - X_Start)

End Function

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(ByRef A As Vector, ByRef 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(ByRef A As Vector, ByRef B As Vector) As Single

    Vector_Multiply = A.X * B.X + A.Y * B.Y

End Function

Private Function Vector_Multiply2(ByRef A As Vector, ByVal Value As Single) As Vector

    Vector_Multiply2 = Vector_New(A.X * Value, A.Y * Value)

End Function

Private Function Vector_Dot_Product(ByRef A As Vector, ByRef B As Vector) As Single

    Vector_Dot_Product = (A.X * B.X) + (A.Y * B.Y)

End Function

Private Function Get_Radian(ByVal X1 As Single, ByVal Y1 As Single, ByVal X2 As Single, ByVal Y2 As Single) As Single

    Dim DX As Single, DY As Single
    Dim Angle As Single

        DX = X2 - X1
        DY = Y2 - Y1
        
        Angle = 0

        If DX = 0 Then
            If DY = 0 Then
                Angle = 0
            ElseIf DY > 0 Then
                Angle = PI / 2
            Else
                Angle = PI * 3 / 2
            End If
        ElseIf DY = 0 Then
            If DX > 0 Then
                Angle = 0
            Else
                Angle = PI
            End If
        Else
            If DX < 0 Then
                Angle = Atn(DY / DX) + PI
            ElseIf DY < 0 Then
                Angle = Atn(DY / DX) + (2 * PI)
            Else
                Angle = Atn(DY / DX)
            End If
        End If
        Get_Radian = Angle

End Function

Private Function Get_Degree(ByVal X1 As Single, ByVal Y1 As Single, ByVal X2 As Single, ByVal Y2 As Single) As Single

    Dim DX As Single, DY As Single
    Dim Angle As Single

        DX = X2 - X1
        DY = Y2 - Y1
        Angle = 0

        If DX = 0 Then
            If DY = 0 Then
                Angle = 0
            ElseIf DY > 0 Then
                Angle = PI / 2
            Else
                Angle = PI * 3 / 2
            End If
        ElseIf DY = 0 Then
            If DX > 0 Then
                Angle = 0
            Else
                Angle = PI
            End If
        Else
            If DX < 0 Then
                Angle = Atn(DY / DX) + PI
            ElseIf DY < 0 Then
                Angle = Atn(DY / DX) + (2 * PI)
            Else
                Angle = Atn(DY / DX)
            End If
        End If
        Angle = Angle * PI / 180
        Get_Degree = Angle

End Function

Private Function Angle_Between(ByVal X1 As Single, ByVal Y1 As Single, ByVal X2 As Single, ByVal Y2 As Single) As Single
    
    On Error GoTo Error_Handler
    
    Dim Dot As Single
    Dim V1 As Vector, V2 As Vector
    Dim Theta As Single
    Dim V1_Mag As Single, V2_Mag As Single
    
    V1.X = X1: V1.Y = Y1
    V2.X = X2: V2.Y = Y2
    
    Dot = Vector_Dot_Product(V1, V2)
    V1_Mag = CSng(Sqr((X1 * X1) + (Y1 * Y1)))
    V2_Mag = CSng(Sqr((X2 * X2) + (Y2 * Y2)))
    Theta = CSng(ACos(Dot / (V1_Mag * V2_Mag)))
    
    Angle_Between = Theta
    Exit Function
Error_Handler:
    Angle_Between = 0
    
'static private float angleBetween(PVector v1, PVector v2) {
'float dot = v1.dot(v2);
'float theta = (float) Math.acos(dot / (v1.mag() * v2.mag()));
'return theta;

End Function

Private Function Degree_To_Radian(ByVal Angle As Single) As Single

    Degree_To_Radian = Angle * PI / 180
    
End Function

Private Function Radian_To_Degree(ByVal Angle As Single) As Single

    Radian_To_Degree = Angle * 180 / PI
    
End Function

Private Function Collision_Box_To_Box(ByVal B1_X1 As Single, ByVal B1_Y1 As Single, ByVal B1_X2 As Single, ByVal B1_Y2 As Single, _
                                     ByVal B2_X1 As Single, ByVal B2_Y1 As Single, ByVal B2_X2 As Single, ByVal B2_Y2 As Single) As Boolean
                                     
    'Collision_Box_To_Box = ((Abs(B1_X - B2_X) * 2) < (B1_Width + B2_Width)) And ((Abs(B1_Y - B2_Y) * 2) < (B1_Height + B2_Height))
    
    If B1_X1 < B2_X2 And _
       B1_X2 > B2_X1 And _
       B1_Y1 < B2_Y2 And _
       B1_Y2 > B2_Y1 Then
           
        Collision_Box_To_Box = True
        
    End If
    
End Function

Private Function Collision_Box_To_Box2(ByVal B1_X As Single, ByVal B1_Y As Single, B1_Width As Single, B1_Height As Single, ByVal B2_X As Single, ByVal B2_Y As Single, B2_Width As Single, 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_Box2 = 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_Box2 = Side
    
End Function

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

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
        If .Moving Then
            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))
                    End If
                End If
            Next I
        End If
    End With
    
    With Monster
    
        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

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 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

Private Sub Clear_AStar(Map As Map_Type)

    Dim Current As Vector
    
    Reset_Heap Monster
    'If IsArrayInitialized(VarPtrArray(Sprite.Nodes)) = True Then
        For Current.Y = 0 To Map.Height - 1
            For Current.X = 0 To Map.Width - 1
                With Monster.Nodes(Current.X, Current.Y)
                    .F = 0
                    .G = 0
                    .H = 0
                    .OCList = 0
                    .X = 0
                    .Y = 0
                End With
            Next Current.X
        Next Current.Y
    'End If

End Sub

    'Reset the heap
Private Sub Reset_Heap(Sprite As Sprite_Type)

    Sprite.Size_Of_Heap = 0
    ReDim Sprite.Heap(0)
    
End Sub

'Remove the Root Object from the heap
Private Sub Remove_Root(Sprite As Sprite_Type)
    
    Dim Parent As Long
    Dim Child_Index As Long
    
    'If only the root exists
    If Sprite.Size_Of_Heap <= 1 Then
        Sprite.Size_Of_Heap = 0
        ReDim Sprite.Heap(0)
        Exit Sub
    End If

    'First copy the very bottom object to the top
    Sprite.Heap(1) = Sprite.Heap(Sprite.Size_Of_Heap)

    'Resize the count
    Sprite.Size_Of_Heap = Sprite.Size_Of_Heap - 1

    'Shrink the array
    ReDim Preserve Sprite.Heap(Sprite.Size_Of_Heap)

    'Sort the top item to it's correct position
    Parent = 1
    Child_Index = 1

    'Sink the item to it's correct location
    Do While True
        Child_Index = Parent
        If 2 * Child_Index + 1 <= Sprite.Size_Of_Heap Then
            'Find the lowest value of the 2 child nodes
            If Sprite.Heap(Child_Index).Score >= Sprite.Heap(2 * Child_Index).Score Then Parent = 2 * Child_Index
            If Sprite.Heap(Parent).Score >= Sprite.Heap(2 * Child_Index + 1).Score Then Parent = 2 * Child_Index + 1
        Else 'Just process the one node
            If 2 * Child_Index <= Sprite.Size_Of_Heap Then
                If Sprite.Heap(Child_Index).Score >= Sprite.Heap(2 * Child_Index).Score Then Parent = 2 * Child_Index
            End If
        End If

        'Swap out the child/parent
        If Parent <> Child_Index Then
            Dim Temp_Heap As Heap_Type
            Temp_Heap = Sprite.Heap(Child_Index)
            Sprite.Heap(Child_Index) = Sprite.Heap(Parent)
            Sprite.Heap(Parent) = Temp_Heap
        Else
            Exit Do
        End If

    Loop

End Sub

'Add the new element to the heap
Private Sub Add(Sprite As Sprite_Type, ByVal Score As Long, ByVal X As Long, ByVal Y As Long)
    
    Dim Position As Long
    
    '**We will be ignoring the (0) place in the heap array because
    '**it's easier to handle the heap with a base of (1..?)

    'Increment the array count
    Sprite.Size_Of_Heap = Sprite.Size_Of_Heap + 1

    'Make room in the array
    ReDim Preserve Sprite.Heap(Sprite.Size_Of_Heap)

    'Store the data
    With Sprite.Heap(Sprite.Size_Of_Heap)
        .Score = Score
        .X = X
        .Y = Y
    End With

    'Bubble the item to its correct location
    
    Position = Sprite.Size_Of_Heap

    Do While Position <> 1
        If Sprite.Heap(Position).Score <= Sprite.Heap(Position / 2).Score Then
            Dim Temp_Heap As Heap_Type
            Temp_Heap = Sprite.Heap(Position / 2)
            Sprite.Heap(Position / 2) = Sprite.Heap(Position)
            Sprite.Heap(Position) = Temp_Heap
            Position = Position / 2
        Else
            Exit Do
        End If
    Loop

End Sub

Public Function AStar_Find_Path(Map As Map_Type, Predator As Sprite_Type, Prey As Sprite_Type) As Boolean
    
    Dim Parent As Vector
    Dim Current As Vector
    Dim tempCost As Long
    Dim Walkable As Boolean
    Dim Temp As Vector, Temp2 As Vector
    Dim Current_Node As Long

    If Predator.Compute_AStar_Enabled = True Or Prey.Compute_AStar_Enabled = True Then
    
        If Prey.Coordinates.X < 0 Or Prey.Coordinates.Y < 0 Or Prey.Coordinates.X > (Map.Width - 1) Or Prey.Coordinates.Y > (Map.Height - 1) Then Exit Function
        If Predator.Coordinates.X < 0 Or Predator.Coordinates.Y < 0 Or Predator.Coordinates.X > (Map.Width - 1) Or Predator.Coordinates.Y > (Map.Height - 1) Then Exit Function
        
        'Make sure the starting point and ending point are not the same
        If (Predator.Coordinates.X = Prey.Coordinates.X) And (Predator.Coordinates.Y = Prey.Coordinates.Y) Then Exit Function
        
        If Map.Collision_Map.Response(Predator.Coordinates.X, Predator.Coordinates.Y) = COLLISION_WALL Then Exit Function
        If Map.Collision_Map.Response(Prey.Coordinates.X, Prey.Coordinates.Y) = COLLISION_WALL Then Exit Function
    
        'Set the flags
        Predator.Path_Found = False
        Predator.Path_Hunt = True
    
        'Put the starting point on the open list
        Predator.Nodes(Predator.Coordinates.X, Predator.Coordinates.Y).OCList = Opened
        Add Predator, 0, Predator.Coordinates.X, Predator.Coordinates.Y
    
        'Find the children
        Do While Predator.Path_Hunt
            If Predator.Size_Of_Heap <> 0 Then
                'Get the parent node
                Parent.X = Predator.Heap(1).X
                Parent.Y = Predator.Heap(1).Y
    
                'Remove the root
                Predator.Nodes(Parent.X, Parent.Y).OCList = Closed
                Remove_Root Predator
    
                'Find the available children to add to the open list
                For Current.Y = (Parent.Y - 1) To (Parent.Y + 1)
                    For Current.X = (Parent.X - 1) To (Parent.X + 1)
    
                        'Make sure we are not out of bounds
                        If Current.X >= 0 And Current.X <= Map.Width - 1 And Current.Y >= 0 And Current.Y <= Map.Height - 1 Then
    
                            'Make sure it's not on the closed list
                            If Predator.Nodes(Current.X, Current.Y).OCList <> Closed Then
    
                                'Make sure no wall
                                If Map.Collision_Map.Response(Current.X, Current.Y) = COLLISION_NONE Then
    
                                    'Don't cut across corners
                                    Walkable = True
                                    
                                    If Current.X = Parent.X - 1 Then
                                        If Current.Y = Parent.Y - 1 Then
                                            If Map.Collision_Map.Response(Parent.X - 1, Parent.Y) = COLLISION_WALL Or Map.Collision_Map.Response(Parent.X, Parent.Y - 1) = COLLISION_WALL Then Walkable = False
                                        ElseIf Current.Y = Parent.Y + 1 Then
                                            If Map.Collision_Map.Response(Parent.X, Parent.Y + 1) = COLLISION_WALL Or Map.Collision_Map.Response(Parent.X - 1, Parent.Y) = COLLISION_WALL Then Walkable = False
                                        End If
                                    ElseIf Current.X = Parent.X + 1 Then
                                        If Current.Y = Parent.Y - 1 Then
                                            If Map.Collision_Map.Response(Parent.X, Parent.Y - 1) = COLLISION_WALL Or Map.Collision_Map.Response(Parent.X + 1, Parent.Y) = COLLISION_WALL Then Walkable = False
                                        ElseIf Current.Y = Parent.Y + 1 Then
                                            If Map.Collision_Map.Response(Parent.X + 1, Parent.Y) = COLLISION_WALL Or Map.Collision_Map.Response(Parent.X, Parent.Y + 1) = COLLISION_WALL Then Walkable = False
                                        End If
                                    End If
    
                                    'If we can move this way
                                    If Walkable = True Then
                                        If Predator.Nodes(Current.X, Current.Y).OCList <> Opened Then
    
                                            'Calculate the G
                                            If Math.Abs(Current.X - Parent.X) = 1 And Math.Abs(Current.Y - Parent.Y) = 1 Then
                                                Predator.Nodes(Current.X, Current.Y).G = Predator.Nodes(Parent.X, Parent.Y).G + 14
                                            Else
                                                Predator.Nodes(Current.X, Current.Y).G = Predator.Nodes(Parent.X, Parent.Y).G + 10
                                            End If
    
                                            'Calculate the H
                                            Predator.Nodes(Current.X, Current.Y).H = 10 * (Math.Abs(Current.X - Prey.Coordinates.X) + Math.Abs(Current.Y - Prey.Coordinates.Y))
                                            Predator.Nodes(Current.X, Current.Y).F = (Predator.Nodes(Current.X, Current.Y).G + Predator.Nodes(Current.X, Current.Y).H)
    
                                            'Add the parent value
                                            Predator.Nodes(Current.X, Current.Y).X = Parent.X
                                            Predator.Nodes(Current.X, Current.Y).Y = Parent.Y
    
                                            'Add the item to the heap
                                            Add Predator, Predator.Nodes(Current.X, Current.Y).F, Current.X, Current.Y
    
                                            'Add the item to the open list
                                            Predator.Nodes(Current.X, Current.Y).OCList = Opened
    
                                        Else
                                            'We will check for better value
                                            Dim AddedG As Long
                                            If Math.Abs(Current.X - Parent.X) = COLLISION_WALL And Math.Abs(Current.Y - Parent.Y) = COLLISION_WALL Then
                                                AddedG = 14
                                            Else
                                                AddedG = 10
                                            End If
                                            
                                            tempCost = Predator.Nodes(Parent.X, Parent.Y).G + AddedG
    
                                            If tempCost < Predator.Nodes(Current.X, Current.Y).G Then
                                                Predator.Nodes(Current.X, Current.Y).G = tempCost
                                                Predator.Nodes(Current.X, Current.Y).X = Parent.X
                                                Predator.Nodes(Current.X, Current.Y).Y = Parent.Y
                                                If Predator.Nodes(Current.X, Current.Y).OCList = Opened Then
                                                    Dim NewCost As Long: NewCost = Predator.Nodes(Current.X, Current.Y).H + Predator.Nodes(Current.X, Current.Y).G
                                                    Add Predator, NewCost, Current.X, Current.Y
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    Next Current.X
                Next Current.Y
            Else
                Predator.Path_Found = False
                Predator.Path_Hunt = False
                'MsgBox "Path Not Found", vbExclamation
                'Instead of a message box, you could have the  run back where it originated instead or not move at all.
                Exit Function
            End If
    
            'If we find a path
            If Predator.Nodes(Prey.Coordinates.X, Prey.Coordinates.Y).OCList = Opened Then
                Predator.Path_Found = True
                Predator.Path_Hunt = False
                'MsgBox "path found"
            End If
    
        Loop
        Dim V As Vector
        If Predator.Path_Found Then
            Temp.X = Prey.Coordinates.X
            Temp.Y = Prey.Coordinates.Y
            Do While True
                ReDim Preserve Predator.AStar_Path(Current_Node) As Vector
                Temp2.X = Predator.Nodes(Temp.X, Temp.Y).X
                Temp2.Y = Predator.Nodes(Temp.X, Temp.Y).Y
                Predator.AStar_Path(Current_Node).X = Temp.X
                Predator.AStar_Path(Current_Node).Y = Temp.Y
                If Temp.X = Predator.Coordinates.X And Temp.Y = Predator.Coordinates.Y Then Exit Do
                Current_Node = Current_Node + 1
                Temp.X = Temp2.X
                Temp.Y = Temp2.Y
            Loop
            Predator.Length_Of_AStar_Path = Current_Node
            Predator.Current_Path = Current_Node
        End If
    End If

End Function

Public Sub Follow_AStar_Path(Map As Map_Type, Predator As Sprite_Type, ByVal Speed As Single)
        
    Dim AStar_Position As Vector
    Static Temp_AStar_Path As Vector
    Dim Delta As Vector
    Dim Distance As Single
    Dim Move As Vector
    Dim Ratio As Single
    Dim New_Position As Vector
    Dim Angle As Single
    Dim Velocity As Vector
    Dim Vec As Vector
    
    If Predator.Path_Found = True And Predator.Path_Hunt = False Then
        If IsArrayInitialized(VarPtrArray(Predator.AStar_Path)) = True Then
            If Predator.Current_Path >= 0 Then
                If Predator.AStar_Moving = False Then
                    Temp_AStar_Path.X = Predator.AStar_Path(Predator.Current_Path).X
                    Temp_AStar_Path.Y = Predator.AStar_Path(Predator.Current_Path).Y
                End If
                
                AStar_Position.X = (Temp_AStar_Path.X * TILE_SIZE)
                AStar_Position.Y = (Temp_AStar_Path.Y * TILE_SIZE)
                
                Delta.X = AStar_Position.X - Predator.Position.X
                Delta.Y = AStar_Position.Y - Predator.Position.Y
                
                Distance = Sqr(Delta.X * Delta.X + Delta.Y * Delta.Y)
                
                If Distance > Speed Then
                    Ratio = Speed / Distance
                    Move.X = Ratio * Delta.X
                    Move.Y = Ratio * Delta.Y
                    Predator.Position.X = Predator.Position.X + Move.X
                    Predator.Position.Y = Predator.Position.Y + Move.Y
                    Predator.AStar_Moving = True
                Else
                    Predator.Position.X = AStar_Position.X
                    Predator.Position.Y = AStar_Position.Y
                    Predator.Current_Path = Predator.Current_Path - 1
                    If Predator.Current_Path <= 0 Then Predator.Current_Path = 0
                    Predator.AStar_Moving = False
                End If
            End If
        End If
    Else
        Clear_AStar Map
    End If

End Sub

Public Function IsArrayInitialized(ByVal Array_Pointer As Long) As Boolean
    
    Dim Destination_Pointer As Long
    
    IsArrayInitialized = False
    CopyMemory Destination_Pointer, ByVal Array_Pointer, 4
    If Destination_Pointer = False Then
        IsArrayInitialized = False
    Else
        IsArrayInitialized = True
    End If
        
End Function
           

源碼下載下傳位址： 百度網盤