A* Pathfinder in Visual Basic 2010

[Markus Gögele]

Ich hab mal angefangen einen A* Pathfinder in visual Basic zu schreibn. Und soweit funktioniert er ja auch halbwegs, aber hin und wieder nimmt er nicht den kürzesten Weg.

Falls sich jemand mit A* Pathfinder auskennt und mir vll. Tipps geben kann wär ich sehr dankbar


Hier der Code der Pathfinder Klasse:

Public Structure Node
    Dim X As Integer
    Dim Y As Integer
    Dim XP As Integer
    Dim YP As Integer
    Dim Distance As Integer
    Dim Cost As Integer
    Dim F As Integer
End Structure

Public Class Pathfinder

    Dim OL As New ArrayList
    Dim CL As New ArrayList
    Dim Path As New ArrayList

    Dim EndReached As Boolean = False

    Public StartNode As Node
    Public EndNode As Node
    Dim CurrentNode As Node
    Dim ChildNode As Node
    Dim PathNode As Node

    Public Map(,) As Integer
    Public Diagonal As Boolean = False
    Public ShowSearchWay As Boolean = False
    Public OL_Elements As Integer
    Public CL_Elements As Integer
    Public NoWay() As Integer

    Dim MaxX As Integer
    Dim MaxY As Integer

    Dim HCost As Integer = 10
    Dim DCost As Integer = 14

    Public Function Startisset()
        If StartNode.X <> Nothing And StartNode.Y <> Nothing Then
            Return True
        Else
            Return False
        End If
    End Function

    Public Function Endisset()
        If EndNode.X <> Nothing And EndNode.Y <> Nothing Then
            Return True
        Else
            Return False
        End If
    End Function

    Public Function Pathfinding()

        MaxX = Map.GetLength(0) - 1
        MaxY = Map.GetLength(1) - 1

        OL.Clear()
        CL.Clear()
        Path.Clear()

        CurrentNode = StartNode
        CurrentNode.Cost = 0
        CurrentNode.Distance = Distance(CurrentNode)

        OL.Add(CurrentNode)

        Do While OL.Count > 0

            CurrentNode.X = 999
            CurrentNode.Y = 999
            CurrentNode.Cost = 999999
            CurrentNode.F = 999999999

            For Each NextNode As Node In OL
                If NextNode.F <= CurrentNode.F Then
                    CurrentNode = NextNode
                End If
            Next

            CL.Add(CurrentNode)
            OL.Remove(CurrentNode)

            If CurrentNode.X <> StartNode.X Or CurrentNode.Y <> StartNode.Y Then
                If ShowSearchWay Then
                    Form1.Field(CurrentNode.X, CurrentNode.Y) = CL_Elements
                    Form1.Draw_Scene()
                End If
            End If

            If EndReached Then Exit Do

            If CurrentNode.Y > 1 Then
                Testing(0, -1)
            End If
            If CurrentNode.Y < MaxY Then
                Testing(0, 1)
            End If
            If CurrentNode.X > 1 Then
                Testing(-1, 0)
            End If
            If CurrentNode.X < MaxX Then
                Testing(1, 0)
            End If

            If Diagonal Then

                If CurrentNode.X > 1 And CurrentNode.Y > 1 Then
                    Testing(-1, -1)
                End If
                If CurrentNode.X < MaxX And CurrentNode.Y > 1 Then
                    Testing(1, -1)
                End If
                If CurrentNode.X < MaxX And CurrentNode.Y < MaxY Then
                    Testing(1, 1)
                End If
                If CurrentNode.X > 1 And CurrentNode.Y < MaxY Then
                    Testing(-1, 1)
                End If

            End If

        Loop

        If EndReached Then
            CurrentNode = EndNode
            Do While CurrentNode.XP <> StartNode.X Or CurrentNode.YP <> StartNode.Y
                PathNode.X = CurrentNode.XP
                PathNode.Y = CurrentNode.YP
                Path.Add(PathNode)

                For Each Node As Node In CL
                    If Node.X = PathNode.X And Node.Y = PathNode.Y Then
                        CurrentNode = Node
                    End If
                Next
            Loop

        Else

            MsgBox("Es wurde kein Pfad gefunden")

        End If

        ShowSearchWay = False
        Diagonal = False
        EndReached = False

        Return Path

    End Function

    Private Sub Testing(ByVal X As Integer, ByVal Y As Integer)

        ChildNode.XP = CurrentNode.X
        ChildNode.YP = CurrentNode.Y
        ChildNode.X = CurrentNode.X + X
        ChildNode.Y = CurrentNode.Y + Y
        ChildNode.Distance = Distance(ChildNode)

        If X <> 0 And Y <> 0 Then
            ChildNode.Cost = CurrentNode.Cost + DCost
        Else
            ChildNode.Cost = CurrentNode.Cost + HCost
        End If

        ChildNode.F = ChildNode.Cost + ChildNode.Distance

        For Each i As Integer In NoWay
            If Map(ChildNode.X, ChildNode.Y) = i Then
                Exit Sub
            End If
        Next

        If ChildNode.X = EndNode.X And ChildNode.Y = EndNode.Y Then
            EndNode.XP = CurrentNode.X
            EndNode.YP = CurrentNode.Y
            EndReached = True
            Exit Sub
        End If

        For Each CloseNode As Node In CL
            If ChildNode.X = CloseNode.X And ChildNode.Y = CloseNode.Y Then
                If ChildNode.Cost < CloseNode.Cost Then
                    CL.Remove(CloseNode)
                    CloseNode = ChildNode
                    CL.Add(CloseNode)
                End If
                Exit Sub
            End If
        Next

        OL.Add(ChildNode)

            If ShowSearchWay Then
            Form1.Field(ChildNode.X, ChildNode.Y) = OL_Elements
                Form1.Draw_Scene()
            End If

    End Sub

    Private Function Distance(ByVal Node As Node)

        Dim X As Integer
        Dim Y As Integer

        X = Math.Abs(Node.X - EndNode.X)
        Y = Math.Abs(Node.Y - EndNode.Y)

        If Diagonal Then

            If X > Y Then
                Return DCost * Y + HCost * (X - Y)
            Else
                Return DCost * X + HCost * (Y - X)
            End If

        Else
            Return (X + Y) * 10
        End If

    End Function

End Class

PS: Ich habe das projekt als Anhang hinzugefügt falls es sich jeman anschauen möchte...!