请教一吓``用VB怎样求两点间最短路径``谢谢``

CrazBoy 2004-07-14 05:22:50
就是在有障碍的情况下`我想求最短路径``该怎样去实现``谢谢``
...全文
120 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
MS_0083 2005-03-17
  • 打赏
  • 举报
 回复
'//* ************************ ModMove.bas ******************
'//* 这个是定型的方向走的 白痴算法


'//* 方法二 用了 Randomize 随即的 也是傻瓜的方法

Option Explicit
Dim i As Byte, II As Byte, PP As Byte
Dim Tmp As String


Public Sub JS_Move1()
Dim KK As Boolean
'S_x = i: S_y = II '起点 '都是以左侧为起点
'横向 20 个,纵向 15 个
Next_x = S_x: Next_y = S_y '初始的坐标
i = 0: PP = 0
Dim ForkWay As Byte 'Fork way 叉道
SaveWay = 0 '记录有分道扬镖的点 '分支号记帐器
'//*_ 开头 Save_Map(S_x , S_y)
Move_XY(0, 0) = (S_x & "," & S_y)
On Error Resume Next
Start_0:
Tmp_x = Next_x: Tmp_y = Next_y
If Next_x < 0 Or Next_y < 0 Then GoTo Start_1
If Next_x > 19 Or Next_y > 14 Then GoTo Start_1
ForkWay = 0 '初始化记数器
If Tmp_x > 0 Then
If Save_Map(Tmp_x - 1, Tmp_y) = True Then
ForkWay = ForkWay + 1 '目标判断 左 '有通路
Else
Save_Map(Tmp_x - 1, Tmp_y) = False
End If '------------------
End If
If Tmp_y > 0 Then
If Save_Map(Tmp_x, Tmp_y - 1) = True Then
ForkWay = ForkWay + 1 '目标判断 上 '有通路
Else
Save_Map(Tmp_x, Tmp_y - 1) = False
End If '-------------------
End If
If Tmp_x < 19 Then
If Save_Map(Tmp_x + 1, Tmp_y) = True Then
ForkWay = ForkWay + 1 '目标判断 右 '有通路
Else
Save_Map(Tmp_x + 1, Tmp_y) = False
End If '------------------
End If
If Tmp_y < 14 Then
If Save_Map(Tmp_x, Tmp_y + 1) = True Then
ForkWay = ForkWay + 1 '目标判断 下 '有通路
Else
Save_Map(Tmp_x, Tmp_y + 1) = False
End If '-----------------------------------------------
End If
KK = False
If ForkWay > 1 Then
For II = 0 To 255
If Save_ForkWay(II) = (Tmp_x & "," & Tmp_y) Then KK = True
Next II
If KK = False Then
Save_ForkWay(SaveWay) = Tmp_x & "," & Tmp_y '是有 记录 叉道 坐标
Move_XY(SaveWay, PP) = Tmp_x & "," & Tmp_y
SaveWay = SaveWay + 1 '多个分支
PP = 0
Move_XY(SaveWay, PP) = Tmp_x & "," & Tmp_y
End If
ElseIf ForkWay = 0 Then
GoTo Start_1
End If '记完了接着走
'--------------------------------------
'无通路
Dim CurrentColor As Byte
Dim Current As String
Current = ""
sRnd_O:
Randomize
CurrentColor = Int((4 * Rnd) + 1)
If Len(Current) = 4 Then GoTo Start_1

If CurrentColor = 1 Then
If InStr(1, Current, "L") > 0 Then GoTo sRnd_O
GoTo sRnd_L
ElseIf CurrentColor = 2 Then
If InStr(1, Current, "R") > 0 Then GoTo sRnd_O
GoTo sRnd_R
ElseIf CurrentColor = 3 Then
If InStr(1, Current, "U") > 0 Then GoTo sRnd_O
GoTo sRnd_U
ElseIf CurrentColor = 4 Then
If InStr(1, Current, "D") > 0 Then GoTo sRnd_O
GoTo sRnd_D
End If
'下一个位，是否通行

'
sRnd_L:
Current = "L" & Current
If Save_Map(Tmp_x - 1, Tmp_y) = True Then '左
Next_x = Tmp_x - 1: Next_y = Tmp_y
Save_Map(Tmp_x, Tmp_y) = False
Save_Map(Tmp_x - 1, Next_y) = False

Move_XY(SaveWay, PP) = Next_x & "," & Next_y
PP = PP + 1
'frmGoTo.PaintPicture frmGoTo.Image5, Next_x * 32, Next_y * 32
If Next_x = D_x And Next_y = D_y Then Exit Sub
GoTo Start_0
End If
GoTo sRnd_O
sRnd_U:
Current = "U" & Current
If Save_Map(Tmp_x, Tmp_y - 1) = True Then '上
Next_x = Tmp_x: Next_y = Tmp_y - 1
Save_Map(Tmp_x, Tmp_y) = False
Save_Map(Next_x, Next_y) = False

Move_XY(SaveWay, PP) = Next_x & "," & Next_y
PP = PP + 1
'frmGoTo.PaintPicture frmGoTo.Image5, Next_x * 32, Next_y * 32
If Next_x = D_x And Next_y = D_y Then Exit Sub
GoTo Start_0
End If
GoTo sRnd_O
sRnd_R:
Current = "R" & Current
If Save_Map(Tmp_x + 1, Tmp_y) = True Then '右
Next_x = Tmp_x + 1: Next_y = Tmp_y
Save_Map(Tmp_x, Tmp_y) = False
Save_Map(Next_x, Next_y) = False

Move_XY(SaveWay, PP) = Next_x & "," & Next_y
PP = PP + 1
'frmGoTo.PaintPicture frmGoTo.Image5, Next_x * 32, Next_y * 32
If Next_x = D_x And Next_y = D_y Then Exit Sub
GoTo Start_0
End If
GoTo sRnd_O
sRnd_D:
Current = "D" & Current
If Save_Map(Tmp_x, Tmp_y + 1) = True Then '下
Next_x = Tmp_x: Next_y = Tmp_y + 1
Save_Map(Tmp_x, Tmp_y) = False
Save_Map(Next_x, Next_y) = False

Move_XY(SaveWay, PP) = Next_x & "," & Next_y
PP = PP + 1
'frmGoTo.PaintPicture frmGoTo.Image5, Next_x * 32, Next_y * 32
If Next_x = D_x And Next_y = D_y Then Exit Sub
GoTo Start_0
End If
GoTo sRnd_O

Start_1:
Current = ""
If SaveWay > 0 Then
'Next_x , Next_y
II = InStr(1, Save_ForkWay(SaveWay - 1), ",")
Next_x = Mid(Save_ForkWay(SaveWay - 1), 1, (II - 1))
Next_y = Mid(Save_ForkWay(SaveWay - 1), (II + 1))
For i = 0 To 255
Move_XY(SaveWay, i) = ""
Move_XY(SaveWay - 1, i) = ""
Next i
PP = 0: i = 0: II = 0
SaveWay = SaveWay - 1
GoTo Start_0
Else
Exit Sub
End If '记完了接着走
End Sub

MS_0083 2005-03-17
  • 打赏
  • 举报
 回复
'//* ************************ ModMove.bas ******************
'//* 这个是定型的方向走的 白痴算法
Option Explicit

Public Me_W As String, Me_H As String
Public Me_WX As Byte, Me_HY As Byte
Public Map(40, 29) As Byte
Public JJ As Byte
Public yIcon As Byte
'-------------------------------------------------
Public Tmp_x As Long, Tmp_y As Long ' 临时(点)
Public Next_x As Long, Next_y As Long ' 临时(点)
' Dim ForkWay_XY As Long

Public S_x As Long, S_y As Long ' '源点 (起点) X Y 坐标
Public D_x As Long, D_y As Long '‘目标点 (要到达的点) X Y坐标
Public Save_ForkWay(255) As String '记录有分道扬镖的点
Public SaveWay As Byte '记录有分道扬镖的点 '分支号记帐器
Public Save_Map(255, 255) As Boolean ''记录地图,临时用

Public Move_XY(255, 255) As String '走过的路

'-------------------------------------------
Dim i As Byte, II As Byte, PP As Byte
Dim Tmp As String





Public Sub JS_Move()
'S_x = i: S_y = II '起点 '都是以左侧为起点
'横向 20 个,纵向 15 个
Next_x = S_x: Next_y = S_y '初始的坐标
i = 0
Dim ForkWay As Byte 'Fork way 叉道
SaveWay = 0 '记录有分道扬镖的点 '分支号记帐器
'//*_ 开头 Save_Map(S_x , S_y)
On Error Resume Next
Start_0:
Tmp_x = Next_x: Tmp_y = Next_y

ForkWay = 0 '初始化记数器
If Tmp_x > 0 Then
If Save_Map(Tmp_x - 1, Tmp_y) = True Then
ForkWay = ForkWay + 1 '目标判断 左 '有通路
Else
Save_Map(Tmp_x - 1, Tmp_y) = False
End If '------------------
End If
If Tmp_y > 0 Then
If Save_Map(Tmp_x, Tmp_y - 1) = True Then
ForkWay = ForkWay + 1 '目标判断 上 '有通路
Else
Save_Map(Tmp_x, Tmp_y - 1) = False
End If '-------------------
End If
If Tmp_x < 19 Then
If Save_Map(Tmp_x + 1, Tmp_y) = True Then
ForkWay = ForkWay + 1 '目标判断 右 '有通路
Else
Save_Map(Tmp_x + 1, Tmp_y) = False
End If '------------------
End If
If Tmp_y < 14 Then
If Save_Map(Tmp_x, Tmp_y + 1) = True Then
ForkWay = ForkWay + 1 '目标判断 下 '有通路
Else
Save_Map(Tmp_x, Tmp_y + 1) = False
End If '-----------------------------------------------
End If
If ForkWay > 1 Then
Save_ForkWay(SaveWay) = Tmp_x & "," & Tmp_y '是有 记录 叉道 坐标
SaveWay = SaveWay + 1 '多个分支
ElseIf ForkWay = 0 Then
GoTo Start_1
End If '记完了接着走

'无通路
'Randomize
'If Int((3 * Rnd) + 1) Then

'下一个位，是否通行
If Save_Map(Tmp_x - 1, Tmp_y) = True Then '左
Next_x = Tmp_x - 1: Next_y = Tmp_y
Save_Map(Tmp_x, Tmp_y) = False
Save_Map(Tmp_x - 1, Next_y) = False
PP = PP + 1
Move_XY(SaveWay, PP) = Next_x & "," & Next_y
frmGoTo.PaintPicture frmGoTo.Image5, Next_x * 32, Next_y * 32
If Next_x = D_x And Next_y = D_y Then Exit Sub
GoTo Start_0
ElseIf Save_Map(Tmp_x, Tmp_y - 1) = True Then '上
Next_x = Tmp_x: Next_y = Tmp_y - 1
Save_Map(Tmp_x, Tmp_y) = False
Save_Map(Next_x, Next_y) = False
PP = PP + 1
Move_XY(SaveWay, PP) = Next_x & "," & Next_y
frmGoTo.PaintPicture frmGoTo.Image5, Next_x * 32, Next_y * 32
If Next_x = D_x And Next_y = D_y Then Exit Sub
GoTo Start_0
ElseIf Save_Map(Tmp_x + 1, Tmp_y) = True Then '右
Next_x = Tmp_x + 1: Next_y = Tmp_y
Save_Map(Tmp_x, Tmp_y) = False
Save_Map(Next_x, Next_y) = False
PP = PP + 1
Move_XY(SaveWay, PP) = Next_x & "," & Next_y
frmGoTo.PaintPicture frmGoTo.Image5, Next_x * 32, Next_y * 32
If Next_x = D_x And Next_y = D_y Then Exit Sub
GoTo Start_0
ElseIf Save_Map(Tmp_x, Tmp_y + 1) = True Then '下
Next_x = Tmp_x: Next_y = Tmp_y + 1
Save_Map(Tmp_x, Tmp_y) = False
Save_Map(Next_x, Next_y) = False
PP = PP + 1
Move_XY(SaveWay, PP) = Next_x & "," & Next_y
frmGoTo.PaintPicture frmGoTo.Image5, Next_x * 32, Next_y * 32
If Next_x = D_x And Next_y = D_y Then Exit Sub
GoTo Start_0
End If
Start_1:

If SaveWay > 0 Then
'Next_x , Next_y
II = InStr(1, Save_ForkWay(SaveWay - 1), ",")
Next_x = Mid(Save_ForkWay(SaveWay - 1), 1, (II - 1))
Next_y = Mid(Save_ForkWay(SaveWay - 1), (II + 1))
SaveWay = SaveWay - 1
GoTo Start_0
Else
Exit Sub
End If '记完了接着走
End Sub

DarthVader 2004-07-18
  • 打赏
  • 举报
 回复
就是啊 只要看懂了算法 自己重新写一个也不成问题啊
本来这个问题就跟语言关系不大的
EndDuke 2004-07-17
  • 打赏
  • 举报
 回复
怎么转不成VB的？不会吧~~差不多，把C语言的硬性转成VB的
subzero 2004-07-14
  • 打赏
  • 举报
 回复
关键的是算法的思想，而不是用什么代码实现，否则给你了vb的代码，你也不懂
不够vb的a*我还真见过，去source-planet看看吧
CrazBoy 2004-07-14
  • 打赏
  • 举报
 回复
是啊``我也知道那里有``但是那些都是用C写的 ``没有VB的``郁闷``那个A*算法我看了好多次 ``还是不懂...
EndDuke 2004-07-14
  • 打赏
  • 举报
 回复
2D的？呵呵，有现成的算法啊~~你去www.gameres.com上找找。一定有这篇文章~~别再这里等，算法这东西在这里等很慢的
EndDuke 2004-07-14
  • 打赏
  • 举报
 回复
2D的？呵呵，有现成的算法啊~~你去gamers上找找。一定有这篇文章~~别再这里等，算法正东西在这里等很慢的
CrazBoy 2004-07-14
  • 打赏
  • 举报
 回复
我想做个RPG游戏``想用鼠标控制人物移动``但是人物移动过程会碰到障碍物``我想能智能的越过去```请问？
计算机二级（VB）
计算机二级（VB）教程，全面、系统、细致地介绍了计算机二级（VB）的相关知识点。 课程能够帮助学习者快速入门。 该课程面向对象： 备考计算机二级（VB）的课程 备课期末考试 自学VB程序设计 课程注意提高学习者实战...
VB水晶报表每讲学生反馈总结(总结人:陈佳云)
完成任务情况 上交25份，有23人规范完成任务，一个未批，一个没有完成任务。2．错误记录（1） 当点击取第一个字段值到list1的按钮时值变为-3。（2） 调用Adobc1控件的movecomplete属性时，出现编译错误“过程声明...
20155228 基于VirtualBox安装Ubuntu和学习linux命令的学习经历和心得
一.虚拟机VirtualBox的下载安装 基于VirtualBox虚拟机安装Ubuntu图文教程 虽然娄老师的教程对于VirtualBox的下载安装讲的很简单，可以说是一笔带过，但是我在下载安装的过程中的确遇到意想不到的问题。 问题：在...
C++面试题
1.构造一个类MySingleton,使该类只能存在一个实例. 思路:  将构造函数写为private的，然后通过一个成员静态函数来调用构造函数即可:) 例: #include "iostream.h" class MySingleton { private: static ...
推荐一本写给IT项目经理的好书
原文地址:http://www.cnblogs.com/cbook/archive/2011/01/19/1939060.html（防止原文作者删除、只能拷贝一份了）推荐一本写给IT项目经理的好书清理电脑,十数年来,无数资料,近来每天抽空好好整理整理, 做IT的特别是整...
游戏开发

8,304

社区成员

23,682

社区内容

发帖
与我相关
我的任务
社区描述
游戏开发相关内容讨论专区
社区管理员
  • 游戏开发
  • 呆呆敲代码的小Y
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章