Rubrik: Grafik und Font | VB-Versionen: VB.NET | 13.08.07 |
Wegberechnung (Pathfinding, Pfadfindung) (.NET) Berechnung des möglichst kürzesten Weges von A nach B | ||
Autor: mikeb69 | Bewertung: | Views: 12.287 |
www.powerdesktop-online.de | System: WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Die berechnung des möglichst kürzesten Weges von A nach B, evtl. um Hindernisse herum, ist gar nicht so schwer:
www.policyalmanac.org/games/aStarTutorial_de.html
In Anlehnung an diesen Artikel habe ich eine kleine Klasse programmiert, die die Funktionsweise des Pathfinding erklären soll.
Hier der Quellcode der Klasse:
Public Class ClassPathFinder Private startPoint As Point Private destPoint As Point Private sizeOfField As Size Private calcfinished As Boolean Private path As New List(Of Point) ' errechneter Weg Private calctime As Long ' benötigte Zeit Private openList As New List(Of pointValue) ' Liste aller möglchen Wegepunkte Private closedList As New List(Of pointValue) ' Liste aller Wegepunkte Private field(,) As Integer Public Const F_START As Integer = 1 ' Startpunkt Public Const F_DEST As Integer = 2 ' Zielpunkt Public Const F_BORDER As Integer = 3 ' Hindernis Public Const F_WAY As Integer = 4 ' errechneter Weg Private Structure pointValue Public Location As Point ' Punkt im Gitter Public WayCosts As Integer ' Wegekosten Public distance As Integer ' Entfernung zum Ziel Public TotalCost As Integer ' Gesamtkosten = waycosts + distance Public Parent As Point ' Ausgangspunkt dieses Punktes End Structure
''' <summary>New</summary> ''' <param name="start">Ausgangspunkt</param> ''' <param name="dest">Zielpunkt</param> ''' <param name="size">Größe des 'Spielfeldes'</param> ''' <param name="border">Height = 1 - wagerecht, Width = 1 - senkrecht</param> Public Sub New(ByVal start As Point, ByVal dest As Point, _ ByVal size As Size, ByVal border As Rectangle) startPoint = start destPoint = dest sizeOfField = size calcfinished = False ReDim field(size.Width, size.Height) ' Hindernisse ins Gitter setzen If border.Height = 1 Then ' Hindernis in x Ausdehnung einzeichnen For i As Integer = border.X To border.Width field(i, border.Y) = F_BORDER Next Else ' Hindernis in y Ausdehnung einzeichnen For i As Integer = border.Y To border.Height field(border.X, i) = F_BORDER Next End If ' Ziel- und Startpunkte ins Gitter setzen field(startPoint.X, startPoint.Y) = F_START field(destPoint.X, destPoint.Y) = F_DEST End Sub
''' <summary>Berechnet den Weg zwischen A und B.</summary> Public Sub Calculate() Dim t As New Stopwatch t.Start() ' mit dem Startpunkt beginnen Dim level As Integer = 0 Dim turn As Integer = 0 Dim actualPoint As pointValue actualPoint.Location = startPoint Do ' actual point aus der Openlist in die Closedlist verschieben gridarg = actualPoint Dim pos As Integer = openList.FindIndex(AddressOf Find_Grid_Location) Try openList.RemoveAt(pos) Catch ex As Exception End Try closedList.Add(actualPoint) ' alle Punkte links und rechts vom Standpunkt berechnen For x As Integer = 0 To 2 For y As Integer = 0 To 2 Dim pv As New pointValue pv.Location = AddPoint(actualPoint.Location, New Point(1 - x, 1 - y)) ' nur berechnen wenn noch nicht in der Openlist oder Closedlist ist gridarg = New pointValue gridarg.Location = pv.Location If openList.FindIndex(AddressOf Find_Grid_Location) = -1 And _ closedList.FindIndex(AddressOf Find_Grid_Location) = -1 Then ' nur berechnen, wenn nicht der aktuelle Standort und der Punkt ' innerhalb des Gitters liegt und keine Hinderniss da ist If pv.Location <> actualPoint.Location And _ pv.Location.X >= 0 And pv.Location.Y >= 0 And _ pv.Location.X <= sizeOfField.Width And _ pv.Location.Y <= sizeOfField.Height Then If field(pv.Location.X, pv.Location.Y) <> F_BORDER Then ' Entfernung berechnen Dim tempDist As Point = SubstractPoint(pv.Location, destPoint) pv.distance = (tempDist.X + tempDist.Y) * 10 ' Wegekosten berechnen If pv.Location.X <> actualPoint.Location.X And _ pv.Location.Y <> actualPoint.Location.Y Then ' Diagonal pv.WayCosts = 14 Else ' senkrecht oder wagerecht pv.WayCosts = 10 End If ' Gesamtkosten pv.TotalCost = pv.WayCosts + pv.distance ' Ausgangspunkt eintragen pv.Parent = actualPoint.Location ' Punkt in die offene Liste eintragen openList.Add(pv) End If pv = Nothing End If End If Next Next ' alle Grid-Elemente mit dem selben Eltern Grid-Element finden parentarg = actualPoint.Location Dim parents As List(Of pointValue) = openList.FindAll(AddressOf Find_All_Parents) ' nach totalcosts sortieren parents.Sort(AddressOf Sort_By_TotalCosts) ' erstes Parents-Element nehmen, da dieses die wenigsten Wegekosten hat Try actualPoint = parents(level) level = 0 Catch ex As Exception ' kein reguläres Parent-Grid-Element gefunden ' dieser Pfad führt nicht zum Ziel ' Berechnung neu starten, aber jetzt einen anderen Pfad nehmen actualPoint.Location = startPoint turn += 1 level = turn closedList.Clear() openList.Clear() ' nach drei vergeblichen Versuchen den Weg zu finden, Suche abbrechen If turn = 3 Then Exit Do End Try Loop Until actualPoint.Location = destPoint ' Anzeigen, dass die Berechnung beendet wurde calcfinished = True t.Stop() calctime = t.ElapsedMilliseconds t = Nothing ' einzelne Properties aktualisieren For i As Integer = 1 To closedList.Count - 1 ' Array aktualisieren Dim x As Integer = closedList(i).Location.X Dim y As Integer = closedList(i).Location.Y field(x, y) = F_WAY ' list(of point) aktualisieren path.Add(closedList(i).Location) Next End Sub
#Region "Suchen/Sortieren" ''' <summary>Liste nach den TotalCosts sortieren.</summary> Private Function Sort_By_TotalCosts(ByVal first As pointValue, _ ByVal second As pointValue) As Integer If first.TotalCost < second.TotalCost Then Return True Else Return False End If End Function
''' <summary>Findet gleiche Koordinaten im Spielfeld.</summary> Private gridarg As pointValue Private Function Find_Grid_Location(ByVal p As pointValue) As Boolean If p.Location = gridarg.Location Then Return True Else Return False End If End Function
''' <summary>Findet alle Koordinaten eines Elternfeldes.</summary> Private parentarg As Point Private Function Find_All_Parents(ByVal p As pointValue) As Boolean If p.Parent = parentarg Then Return True Else Return False End If End Function #End Region
#Region "Properties" ''' <summary>Gibt den Startpunkt an.</summary> Public ReadOnly Property LocationStart() As Point Get Return startPoint End Get End Property ''' <summary>Gibt den Zielpunkt an.</summary> Public ReadOnly Property LocationDest() As Point Get Return destPoint End Get End Property ''' <summary>Gibt den errechneten Weg zurück.</summary> Public ReadOnly Property CalculatedPath() As List(Of Point) Get Return path End Get End Property ''' <summary>Gibt das Array mit allen Informationen über die ''' Pfadfindung zurück.</summary> Public ReadOnly Property GridAsArray() As Integer(,) Get Return field End Get End Property ''' <summary>Gibt an, ob die Pfadfindung beendet wurde.</summary> Public ReadOnly Property CalculationFinished() As Boolean Get Return calcfinished End Get End Property ''' <summary>Gibt die Zeit (in ms) zurück, die zum Finden ''' des Weges gebraucht wurde.</summary> Public ReadOnly Property CalculationTime() As Long Get Return calctime End Get End Property #End Region
#Region "Math-Operation" ''' <summary>Subtrahiert zwei Point-Variablen - z.b. um die Distanz zwischen ''' zwei Punkten zu berechnen.</summary> Private Function SubstractPoint(ByVal point1 As Point, ByVal point2 As Point) Return New Point(Math.Abs(point1.X - point2.X), Math.Abs(point1.Y - point2.Y)) End Function ''' <summary>Addiert zwei Point-Variablen.</summary> Private Function AddPoint(ByVal point1 As Point, ByVal point2 As Point) Return New Point(point1.X + point2.X, point1.Y + point2.Y) End Function #End Region
End Class
Um die Funktion dieser Klasse veranschaulichen zu können, erstellen Sie am besten eine Form1. Auf dieser Plazieren Sie eine Picturebox1 und einen Button1.
Den folgenden Code kopieren Sie nun in Ihr Projekt:
Public Class Form1 Private c As ClassPathFinder Private WithEvents t As Timer Private Const G_X As Integer = 10 Private Const G_Y As Integer = 10
Private Sub Form1_Load(ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles MyBase.Load c = New ClassPathFinder(New Point(3, 2), New Point(7, 7), _ New Size(G_X, G_Y), New Rectangle(5, 2, 1, 8)) Me.Text = "Bitte 'Start-Taste' drücken" BuildPicture() End Sub
Private Sub BuildPicture() Dim b As New Bitmap(Me.PictureBox1.Width, Me.PictureBox1.Height) Dim g As Graphics = Graphics.FromImage(b) Dim h As Integer = Me.PictureBox1.Height / (G_Y + 1) Dim w As Integer = Me.PictureBox1.Width / (G_X + 1) For x As Integer = 0 To G_X For y As Integer = 0 To G_Y Dim rect As New Rectangle(x * w, y * h, w, h) g.DrawRectangle(Pens.Black, rect) Select Case c.GridAsArray(x, y) Case ClassPathFinder.F_START g.FillRectangle(Brushes.Green, rect) Case ClassPathFinder.F_DEST g.FillRectangle(Brushes.Red, rect) Case ClassPathFinder.F_BORDER g.FillRectangle(Brushes.Blue, rect) Case ClassPathFinder.F_WAY g.FillRectangle(Brushes.Yellow, rect) End Select Next Next Me.PictureBox1.Image = b End Sub
Private Sub Button1_Click(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles Button1.Click c.Calculate() t = New Timer t.Interval = 500 t.Start() End Sub
Private Sub t_Tick(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles t.Tick If c.CalculationFinished = True Then t.Stop() End If BuildPicture() Me.Text = "Elapsed Time = " & c.CalculationTime & "ms" End Sub
End Class