Like I said, this just does the pathfinder. Not the movement, just the calculation. It may be a little slow but…. ``` Option Explicit Private Type Node Row As Integer Col As Integer ParId As Integer ScoreF As Integer ScoreG As Integer ScoreH As Integer Closed As Boolean End Type Dim OpenList() As Node Dim TargetNode As Node Public Function AstarTile(ByVal x As Integer, ByVal y As Integer) As Integer If isblocked(x - 1, y - 1) Then AstarTile = -1 Exit Function Else AstarTile = 0 Exit Function End If End Function Sub Pathfinder_A_star(PathEndX As Integer, PathEndy As Integer) Dim i As Long, j As Long, k As Long, N As Long, M As Long, NM As Long Dim Msg As String, k_best As Long, k1 As Long, k2 As Long, Nrow As Long, Ncol As Long Dim Goal As Boolean, Cutting_Corners As Boolean, ris As Boolean Dim CurrNode As Node N = MAX_MAPY M = MAX_MAPX NM = N * M N = MAX_MAPX + 1 M = MAX_MAPY + 1 ReDim OpenList(NM) OpenList(1).Row = GetPlayerX(MyIndex) + 1 OpenList(1).Col = GetPlayerY(MyIndex) + 1 TargetNode.Row = PathEndX + 1 TargetNode.Col = PathEndy + 1 Cutting_Corners = True k1 = 1 Compute_Score OpenList(k1) Do PickUp_TheBest_Node k_best If k_best = 0 Then 'No path =( Exit Sub End If k2 = k2 + 1 OpenList(k_best).Closed = True Nrow = OpenList(k_best).Row Ncol = OpenList(k_best).Col For i = Nrow - 1 To Nrow + 1 For j = Ncol - 1 To Ncol + 1 If ((j - Ncol = 0) Or (i - Nrow = 0)) Then If i > 0 And i 0 And j = 0 And (i Nrow Or j Ncol) Then ris = False If (Not Cutting_Corners) Then ris = CheckCuttingCorner(Nrow, Ncol, i, j) If Not ris Then k = getNode(i, j) If k > 0 Then If Not OpenList(k).Closed Then CurrNode.Row = i CurrNode.Col = j CurrNode.ParId = k_best Compute_Score CurrNode If CurrNode.ScoreF < OpenList(k).ScoreF Then OpenList(k) = CurrNode End If End If Else CurrNode.Row = i CurrNode.Col = j CurrNode.ParId = k_best Compute_Score CurrNode k1 = k1 + 1 OpenList(k1) = CurrNode If i = TargetNode.Row And j = TargetNode.Col Then Goal = True k2 = k2 + 1 OpenList(k1).Closed = True Exit Do End If End If End If End If End If End If Next j, i Loop i = k1: k = 0 Do k = k + 1 i = OpenList(i).ParId Loop Until i = 0 ReDim PathToWalk(1 To k, 1 To 2) i = k1 k = 0 Do k = k + 1 PathToWalk(k, 1) = OpenList(i).Row - 1 PathToWalk(k, 2) = OpenList(i).Col - 1 i = OpenList(i).ParId Loop Until i = 0 isWalkingPath = True PathIndex = k End Sub Private Function getNode(Nrow, Ncol) Dim k As Long getNode = 0 Do k = k + 1 If OpenList(k).Col = 0 Then Exit Do If OpenList(k).Col = Ncol And OpenList(k).Row = Nrow Then getNode = k End If Loop End Function Private Sub PickUp_TheBest_Node(k_best As Long) Dim ScoreMin As Long, k As Long, k_min As Long Do k = k + 1 If OpenList(k).Col = 0 Then Exit Do If Not OpenList(k).Closed Then If k_min = 0 Or ScoreMin >= OpenList(k).ScoreF Then ScoreMin = OpenList(k).ScoreF k_min = k End If End If Loop k_best = k_min End Sub Private Sub Compute_Score(P As Node) Dim L As Long, di As Long, dj As Long If P.ParId > 0 Then L = AstarTile(P.Row, P.Col) If L < 0 Then L = 100000 P.ScoreG = OpenList(P.ParId).ScoreG If OpenList(P.ParId).Row = P.Row Or OpenList(P.ParId).Col = P.Col Then P.ScoreG = P.ScoreG + 10 + 10 * L Else P.ScoreG = P.ScoreG + 14 + 14 * L End If End If di = Abs(P.Row - TargetNode.Row) dj = Abs(P.Col - TargetNode.Col) If dj > di Then P.ScoreH = 4 * di + 10 * dj Else P.ScoreH = 10 * di + 4 * dj End If P.ScoreF = P.ScoreG + P.ScoreH End Sub Private Function CheckCuttingCorner(Nrow, Ncol, i, j) As Boolean Dim di As Long, dj As Long, ris As Boolean di = i - Nrow dj = j - Ncol If di = 0 Or dj = 0 Then Exit Function If AstarTile(Nrow + di, Ncol) < 0 Or AstarTile(Nrow, Ncol + dj) < 0 Then CheckCuttingCorner = True Exit Function End If End Function ```
