于在 Visual Basic 中实现最短路径搜索的简单解决方案：
Game AI: 支持一个二维数组格式的自动路径查找！
Dim a As New AStar ' the pathfinding class
Dim m As New MathHelper ' some rotation and calculation functions
Dim l As New LineController ' the lineof view helper
Dim v As New VelocityController ' movement controller
Dim nCount As Long ' counter, used for the timer delay functions
Dim bCount As Boolean ' flag, used for the timer delay functions
Dim Map(10) As String * 10 ' used to define our labyrinth starting values
Private Sub Command1_Click()
'
' Functions finds the path from x1,y1 to x2,y2'
'
Dim x1 As Long ' positions
Dim y1 As Long
Dim x2 As Long
Dim y2 As Long
Dim x As Long
Dim y As Long
P1.Cls ' redraw our mace
plotMace
x1 = Format(Text1.Text) ' get the positions from the GUI
y1 = Format(Text2.Text)
x2 = Format(Text3.Text)
y2 = Format(Text4.Text)
If Check1.Value = vbChecked Then ' is diagonal movement allowed?
a.Allow8Directions True
Else
a.Allow8Directions False
End If
a.SetHeight Val(Text5.Text) ' set the player's height and width
a.SetWidth Val(Text5.Text)
If a.FindAPath(x1, y1, x2, y2) = False Then ' find the path
MsgBox "No way to the goal" ' sorry, no path to the goal
Exit Sub
End If
While Not a.GoalReached ' draw the path to the screen until goal reached
x = a.NodeGetX ' get current x position
y = a.NodeGetY ' get current y position
For i = 0 To Val(Text5.Text) - 1
For j = 0 To Val(Text5.Text) - 1
P1.Circle ((x + j) * 10 + 5, (y + i) * 10 + 5), 4, RGB(0, 255, 255)
Next j
Next i
a.NextPathNode ' step to next path position
Wend
End Sub
Private Sub Command2_Click()
'
' calculate the angle between start and end point'
'
plotMace
MsgBox Format(m.Angle2D(Val(Text1.Text), Val(Text2.Text), _
Val(Text3.Text), Val(Text4.Text)))
End Sub
Private Sub Command3_Click()
'
' calculate the angle between 2 angles'
'
Dim a1 As Long
Dim a2 As Long
a1 = Format(InputBox("Angle 1: ", "Absolute Difference between 2 Angles", "0"))
a2 = Format(InputBox("Angle 2: ", "Absolute Difference between 2 Angles", "90"))
MsgBox Format(m.AbsAngleDiff(a1, a2))
End Sub
Private Sub Command4_Click()
'
' calculate the distance between start and end point'
'
Dim d As Long
plotMace
d = m.Distance2D(Val(Text1.Text), Val(Text2.Text), Val(Text3.Text), Val(Text4.Text))
MsgBox "Distance: "&Format(d), , "Distance between 2 Points"
End Sub
Private Sub Command5_Click()
'
' draw a direct line between start and end point and check if we walk through walls'
'
Dim x As Long
Dim y As Long
Dim t As Long
plotMace
If DrawLine(Val(Text1.Text) * 10 + 5, Val(Text2.Text) * 10 + 5, Val(Text3.Text) * 10 + 5, Val(Text4.Text) * 10 + 5) Then
MsgBox "Start point can see the goal", vbInformation, "Line of View"
Else
MsgBox "Hey goal, where are you, I can't see you.", vbCritical, "Line of View"
End If
End Sub
Private Function DrawLine(x1 As Long, y1 As Long, x2 As Long, y2 As Long) As Boolean
'
' draws a diret line from x1,y1 to x2,y2 and returns false, if the line walks'
' through walls. The line is painted red on walls.'
'
Dim x As Long
Dim y As Long
Dim t As Long
Dim bCanSeeGoal As Boolean
bCanSeeGoal = True
l.InitLine x1, y1, x2, y2
Do
x = l.GetX
y = l.GetY
t = a.GetTile(x \ 10, y \ 10)
If t = 0 Then
P1.PSet (x, y), RGB(0, 255, 0)
Else
P1.PSet (x, y), RGB(255, 0, 0)
bCanSeeGoal = False
End If
Loop Until Not l.DoStep
If bCanSeeGoal Then
DrawLine = True
Else
DrawLine = False
End If
End Function
Private Sub Command6_Click()
'
' draw a sector of lines to simulate the line of view effect from the game'
' commandos.'
' To calculate the sector, the end point is rotated by 20 degrees around the'
' start point.'
'
Dim an As Long
Dim x1 As Long
Dim y1 As Long
Dim x2 As Long
Dim y2 As Long
Dim xx As Long
Dim yy As Long
Dim nx As Long
Dim ny As Long
x1 = Val(Text1.Text) * 10 + 5
y1 = Val(Text2.Text) * 10 + 5
x2 = Val(Text3.Text) * 10 + 5
y2 = Val(Text4.Text) * 10 + 5
xx = x2 - x1
yy = y2 - y1
yy = -yy
Dim w As Double
For i = -10 To 10
nx = m.GetRotatedX(xx, yy, i)
ny = m.GetRotatedY(xx, yy, i)
DrawLine x1, y1, nx + x1, y1 + ny
Next i
End Sub
Private Sub Command7_Click()
'
' refreshes the display of the maze'
'
plotMace
End Sub
Private Sub Command8_Click()
'
' let a point fly with increasing speed and rotating direction.'
' could be used to let a sprite move into any direction (not only 8 directions)'
'
Dim Speed As Double
Dim Angle As Long
Dim x As Long
Dim y As Long
plotMace
x = Val(Text1.Text) * 10 + 5
y = Val(Text2.Text) * 10 + 5
v.SetXY x, y
Speed = 1
Angle = 0
For i = 1 To 100
x = v.GetX
y = v.GetY
P1.PSet (x, y), RGB(0, 255, 255)
Angle = m.AngleAdd(Angle, 5)
Speed = Speed + 0.02
v.SetAngle Angle
v.SetSpeed Speed
v.Move
Next i
End Sub
Private Sub Form_Activate()
'
' show instruction once a startup of form'
'
Static onceonly As Boolean
If onceonly = False Then
onceonly = True
MsgBox "Use left mousebutton to set a wall and right" + vbCrLf + "mousebutton to clear a wall", _
vbInformation,"GameAI-Lib Demonstration"
End If
End Sub
Private Sub Form_Load()
'
' define or default maze. I used a simple string array to define the maze'
' easily within the Visual Basic editor. A "." stands for empty space and'
' a "x" for a wall.'
'
nCount = 0
bCount = False
Map(0) = ".......x..."
Map(1) = "..........."
Map(2) = "....x......"
Map(3) = "....x......"
Map(4) = "....x......"
Map(5) =".xxxx.xx..."
Map(6) = "......x...."
Map(7) = "..xxxxx...."
Map(8) = "..........."
Map(9) = "..........."
Map(10) = "..........."
a.NewMap 11, 11 ' create an empty walk map with the size 10x10 tiles
plotMace ' draw mace
End Sub
Private Sub plotMace()
'
' draw our mace to the screen and set the walls and empty spaces in the walk map'
'
P1.Cls
For i = 1 To 10
For j = 1 To 10
Select Case Mid$(Map(i - 1), j, 1)
Case "."
P1.PSet ((j - 1) * 10 + 5, (i - 1) * 10 + 5), RGB(255, 255, 255)
a.SetTile j - 1, i - 1, 0
Case "x"
P1.Circle ((j - 1) * 10 + 5, (i - 1) * 10 + 5), 4, RGB(130, 130, 130)
a.SetTile j - 1, i - 1, 1
End Select
Next j
Next i
Dim x As Long
Dim y As Long
x = Format(Text1.Text) ' draw the starting point
y = Format(Text2.Text)
For i = 0 To Val(Text5.Text) - 1
For j = 0 To Val(Text5.Text) - 1
P1.Circle ((x + j) * 10 + 5, (y + i) * 10 + 5), 2, RGB(0, 255, 0)
Next j
Next i
x = Format(Text3.Text) ' draw the end point
y = Format(Text4.Text)
For i = 0 To Val(Text5.Text) - 1
For j = 0 To Val(Text5.Text) - 1
P1.Circle ((x + j) * 10 + 5, (y + i) * 10 + 5), 2, RGB(255, 0, 0)
Next j
Next i
End Sub
Private Sub P1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'
' let the user set walls by using left mouse button and clear the walls by using'
' the right mouse button'
'
Dim xx As Long
Dim yy As Long
xx = x \ 10
yy = y \ 10
If xx > 9 Or yy > 9 Then Exit Sub
If Button = 1 Then
Mid$(Map(yy), xx + 1, 1) = "x"
Else
Mid$(Map(yy), xx + 1, 1) = "."
End If
plotMace
End Sub
Private Sub Timer1_Timer()
'
' simple timer function to get a delay'
' YES, I know I could use the Sleep API function;)'
'
If nCount > 0 Then
nCount = Count - 1
If nCount = 0 Then
bCount = True
End If
End If
End Sub
Private Sub Wait(TenthSeconds As Long)
'
' look above'
'
nCount = TenthSeconds
bCount = False
Do While Not bCount
DoEvents
Loop
End Sub
' 相关资源：
' GameAI-Library Demonstration - programmed by Torsten Damberg 02/2000'
'