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