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

最新推荐文章于 2021-01-20 12:19:27 发布
最新推荐文章于 2021-01-20 12:19:27 发布
阅读量1.4k 收藏 4
点赞数 1
分类专栏： vb 6.0 文章标签： vb6.0 A 寻径 最短路径 shortest path finder
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/xjnzhidao/article/details/48785511
版权
本文介绍如何在VB6环境中应用A*算法来寻找最短路径，通过源代码详细展示了AStar Shortest Path Finder的工作原理和实现步骤。
摘要由CSDN通过智能技术生成

'--------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.47元/天 解锁文章
xjnzhidao
关注
  • 1
    点赞
  • 踩
  • 4
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
A*算法最短路径万能通用matlab代码
05-18
A*（A-star）算法是一种在图形搜索中用于找到从起始节点到目标节点最短路径的启发式搜索算法。它的核心思想是结合了Dijkstra算法的无偏搜索特性和Greedy最佳优先搜索的效率，通过引入启发式函数来估计从当前节点到...
a*算法VB6实现
07-22
A*（A-Star)算法是一种静态路网中求解最短路径最有效的直接搜索方法，也是解决许多搜索问题的有效算法。算法中的距离估算值与实际值越接近，最终搜索速度越快。
AStarPathFinder
04-07
Tucil-3-Stima-2020 创建该程序是为了完成IF 2211算法策略课程的任务 信息工程学学习计划电气工程与信息学院万隆技术学院 第二学期2020/2021年 描述 A *算法是一种流行的算法，用于查找两点之间的最短路径。 原则上，A *通过贪婪的最佳优先搜索方法工作，该方法使用启发式方法找到路径。 在搜索过程中，算法A *将Dijkstra的算法（优先考虑靠近起点的顶点）与贪婪的最佳优先搜索（优先考虑靠近终点的顶点）组合在一起。 在标准术语中，算法A *由以下公式表示 f（n）= g（n）+ h（n） 其中g（n）代表从起始节点到点n所需的确切成本，而h（n）代表从点n到目标节点的估计启发式值。 程序步骤： 阅读问题 将开始节点添加到打开的列表中 只要打开的列表不为空，请执行以下操作： 在打开的列表中搜索具有最小值的f，将其称为n（当前节点） 对于与当前节点相对的
Shortest Path Graph A star:使用 A* 算法在有向图上找到最排序的路径。-开源
06-29
它是有向图的 A* 算法的实现。 此外，还提供了 Graph 的实现。 为了图形的可视化和 A* 算法的结果，数据以 GraphViz（图形可视化软件）格式导出：http://www.graphviz.org/ 提供了各种示例性解决方案。 另请参阅我与 A* 算法相关的另外两个项目：https://sourceforge.net/projects/path-finder-qt/ https://sourceforge.net/projects/a-star/
VB A星寻路算法 VB A*寻路算法
10-20
VB 中的A星寻路算法 用了折半快速插入有序队列可以很快的添加结点数据 数组是以距离从大到小的一个有序队列 每次取数组中最后的数据,可以快速删除 例如:redim preserve A(ubound(A)-1)
最短路径分析基于VB
06-10
arcgis 最短路径分析基于VB 可以进行基本的应用。
Astar A*算法 最短路径算法
Nick
12-10 6649
通常情况下，迷宫寻路算法可以使用深度优先或者广度优先算法，但是由于效率的原因，不会直接使用这些算法，在路径搜索算法中最常见的就是A*寻路算法。使用A*算法的魅力之处在于它不仅能找到地图中从A到B的一条路径，还能保证找到的是一条最短路径，它是一种常见的启发式搜索算法，类似于Dijkstra算法一样的最短路径查找算法，很多游戏应用中的路径搜索基本都是采用这种算法或者是A*算法的变种。 下面我们来了解...
二维A*算法路径规划matlab代码
11-16
以复杂岛屿地图为例，做了二维A*路径规划。代码为MATLAB代码，解压后可以直接运行。文件夹内AstarCSDN为主文件，TrunToGridMap为地图转栅格文件，child_nodes_cal为计算子节点的函数，1234d.jpg为地图图片。
AStarPathFinder.rar_A * 算法_astar pathfinder_site:www.pudn.com
09-23
A*（A Star）算法是一种在图形搜索中广泛使用的最佳路径搜索算法，它结合了Dijkstra算法的全局最优性和BFS（广度优先搜索）的效率。A*算法的核心在于引入了一个评估函数来预估从起点到目标点的最优路径，从而在搜索...
AStar算法演示(VB)
03-22
有关详情请到我的博客: http://fdlvoe.139.com 里面有源文件下载
VB A星寻路算法 a* AStar
08-28
献给想用VB开发游戏的人,我本来想用VB做一个游戏结束和VB的相遇,然后进入另一个世界VC的世界,但是只差一点点就可以完成了,最后还是放弃了...自己的理想
容易理解的寻路算法 A* 寻路 最短路径
12-21
之前有弄出了最短路径的寻路算法,现在看起来,觉得条理不够清晰,注释也少,所以此次特地对寻路算法进行了整理,几乎每行都有注释,结构清晰了很多,接口友好,套用起来很方便...
VB.net dijkstra最短路径算法 源代码
04-08
vb.net编写的dijkstra最短路径算法源代码，可以直接用，干货啊。
用VB写的简单自动寻路基于A星算法.rar
11-22
A星寻路,可自定义障碍，代码理解简单
Astar.zip_Astar最短路径_Astar算法_astar matlab_最短路径_最短路径 matlab
07-14
标题中的"Astar.zip"指的是一个包含了与A*（Astar）算法相关的文件的压缩包，这个算法主要用于寻找图形或网格中的最短路径。A*算法是Dijkstra算法的一个改进版本，它结合了最佳优先搜索和启发式信息，提高了路径搜索...
寻路算法 A* （一）
Awolfly的专栏
11-02 480
大家好，今天gei
魔塔之拯救白娘子~我的第一个VB6+DX8做的小游戏源码~16开始游戏-自动寻路（A星算法）
gosub60的博客
01-20 2223
魔塔之拯救白娘子 完整工程下载地址： 《魔塔之拯救白娘子》流程分析2： ⑤游戏界面鼠标点击判断以及自动寻路： 自动寻路的效果如下： 源码如下： Sub 游戏界面鼠标点击判断() Dim map(12, 12) As Integer Dim j As Integer Dim k As Integer Dim a As POINTS Dim b As POINTS Dim m() As String '①先判断当前是不是弹出对话窗口 If Running <> 1 Then Exi
AStar(vb,c++).rar
11-11
一个vb和c++的A*寻路法。它使你更直观的了解寻路是怎么一会事
A*算法实现最短路径算法的python代码
最新发布
05-28
以下是实现A*算法的最短路径算法的Python代码示例： ```python import heapq def astar(start, goal, graph): """A* algorithm implementation""" # Initialize the open and closed lists open_list = [] closed_list = set() # Add the start node to the open list heapq.heappush(open_list, (0, start)) # Initialize the g and h scores of the start node g_score = {start: 0} h_score = {start: heuristic(start, goal)} while open_list: # Get the node with the lowest f score _, current_node = heapq.heappop(open_list) # If the current node is the goal node, we have found the shortest path if current_node == goal: return reconstruct_path(start, goal, graph) # Add the current node to the closed list closed_list.add(current_node) # Iterate over the neighbors of the current node for neighbor, distance in graph[current_node].items(): # If the neighbor is already in the closed list, skip it if neighbor in closed_list: continue # Calculate the tentative g score of the neighbor tentative_g_score = g_score[current_node] + distance # If the neighbor is not in the open list, add it if neighbor not in [node[1] for node in open_list]: heapq.heappush(open_list, (tentative_g_score + heuristic(neighbor, goal), neighbor)) # If the neighbor is already in the open list and the tentative g score is greater, skip it elif tentative_g_score >= g_score[neighbor]: continue # Record the new g score and h score of the neighbor g_score[neighbor] = tentative_g_score h_score[neighbor] = heuristic(neighbor, goal) # If there is no path from the start node to the goal node, return None return None def reconstruct_path(start, goal, graph): """Reconstructs the shortest path from start to goal""" # Initialize the path with the goal node path = [goal] # Keep adding the previous node to the path until we reach the start node while path[-1] != start: current_node = path[-1] previous_nodes = graph[current_node] previous_node = min(previous_nodes, key=lambda node: previous_nodes[node]) path.append(previous_node) # Reverse the path and return it return list(reversed(path)) def heuristic(node, goal): """Returns the estimated distance between node and goal""" # Use the Manhattan distance as the heuristic return abs(node[0] - goal[0]) + abs(node[1] - goal[1]) # Example usage: graph = { (0, 0): {(1, 0): 1, (0, 1): 1}, (1, 0): {(0, 0): 1, (1, 1): 1}, (0, 1): {(0, 0): 1, (1, 1): 1}, (1, 1): {(1, 0): 1, (0, 1): 1, (2, 1): 1}, (2, 1): {(1, 1): 1, (2, 2): 1}, (2, 2): {(2, 1): 1} } start = (0, 0) goal = (2, 2) print(astar(start, goal, graph)) # Output: [(0, 0), (1, 0), (1, 1), (2, 1), (2, 2)] ``` 该示例代码实现了A*算法，使用了堆（heapq）来优化寻找最小f值的节点。在计算路径时，使用了启发式函数（heuristic），这里使用的是曼哈顿距离（Manhattan distance）。该代码可以寻找从一个起始点到一个目标点的最短路径。
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值