Die berechnung des möglichst kürzesten Weges von A nach B, evtl. um Hindernisse herum, ist gar nicht so schwer: 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. 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 Dieser Tipp wurde bereits 12.307 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |