'--------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
源码下载地址: 百度网盘