frmmain.vb

This a A* pathfinding example to illustrate how to implement a A* pathfinding algorithm into your pr

                                If Map(xCnt, yCnt).Wall = False Then

                                    'Don't cut across corners
                                    Dim CanWalk As Boolean = True
                                    If xCnt = ParentX - 1 Then
                                        If yCnt = ParentY - 1 Then
                                            If Map(ParentX - 1, ParentY).Wall = True Or Map(ParentX, ParentY - 1).Wall = True Then CanWalk = False
                                        ElseIf yCnt = ParentY + 1 Then
                                            If Map(ParentX, ParentY + 1).Wall = True Or Map(ParentX - 1, ParentY).Wall = True Then CanWalk = False
                                        End If
                                    ElseIf xCnt = ParentX + 1 Then
                                        If yCnt = ParentY - 1 Then
                                            If Map(ParentX, ParentY - 1).Wall = True Or Map(ParentX + 1, ParentY).Wall = True Then CanWalk = False
                                        ElseIf yCnt = ParentY + 1 Then
                                            If Map(ParentX + 1, ParentY).Wall = True Or Map(ParentX, ParentY + 1).Wall = True Then CanWalk = False
                                        End If
                                    End If

                                    'If we can move this way
                                    If CanWalk = True Then
                                        If Map(xCnt, yCnt).OCList <> inOpened Then

                                            'Calculate the GCost
                                            If Math.Abs(xCnt - ParentX) = 1 And Math.Abs(yCnt - ParentY) = 1 Then
                                                Map(xCnt, yCnt).GCost = Map(ParentX, ParentY).GCost + 14
                                            Else
                                                Map(xCnt, yCnt).GCost = Map(ParentX, ParentY).GCost + 10
                                            End If

                                            'Calculate the HCost
                                            Map(xCnt, yCnt).HCost = 10 * (Math.Abs(xCnt - EndX) + Math.Abs(yCnt - EndY))
                                            Map(xCnt, yCnt).FCost = (Map(xCnt, yCnt).GCost + Map(xCnt, yCnt).HCost)

                                            'Add the parent value
                                            Map(xCnt, yCnt).ParentX = ParentX
                                            Map(xCnt, yCnt).ParentY = ParentY

                                            'Add the item to the heap
                                            Heap.Add(Map(xCnt, yCnt).FCost, xCnt, yCnt)

                                            'Add the item to the open list
                                            Map(xCnt, yCnt).OCList = inOpened

                                        Else
                                            'We will check for better value
                                            Dim AddedGCost As Int16
                                            If Math.Abs(xCnt - ParentX) = 1 And Math.Abs(yCnt - ParentY) = 1 Then
                                                AddedGCost = 14
                                            Else
                                                AddedGCost = 10
                                            End If
                                            Dim tempCost As Int16 = Map(ParentX, ParentY).GCost + AddedGCost

                                            If tempCost < Map(xCnt, yCnt).GCost Then
                                                Map(xCnt, yCnt).GCost = tempCost
                                                Map(xCnt, yCnt).ParentX = ParentX
                                                Map(xCnt, yCnt).ParentY = ParentY
                                                If Map(xCnt, yCnt).OCList = inOpened Then
                                                    Dim NewCost As Int16 = Map(xCnt, yCnt).HCost + Map(xCnt, yCnt).GCost
                                                    Heap.Add(NewCost, xCnt, yCnt)
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    Next
                Next
            Else
                PathFound = False
                PathHunt = False
                Exit Sub
            End If

            'If we find a path
            If Map(EndX, EndY).OCList = inOpened Then
                PathFound = True
                PathHunt = False
            End If

        End While

        If PathFound Then
            Dim tX As Int16 = EndX
            Dim tY As Int16 = EndY
            Map(tX, tY).DrawPath = True
            While True
                Dim sX As Int16 = Map(tX, tY).ParentX
                Dim sY As Int16 = Map(tX, tY).ParentY
                Map(sX, sY).DrawPath = True
                tX = sX
                tY = sY
                If tX = StartX And tY = StartY Then Exit While
            End While

            Render()

        End If

    End Sub

    Private Sub Render()
        Dim xCnt, yCnt As Int16

        'Clear the backround
        oBuffG.Clear(Color.White)

        'Draw the starting/ending box
        oBuffG.FillRectangle(New SolidBrush(Color.LightGreen), StartX * 15, StartY * 15, 15, 15)
        oBuffG.FillRectangle(New SolidBrush(Color.Red), EndX * 15, EndY * 15, 15, 15)

        'Draw the walls
        For yCnt = 0 To 24
            For xCnt = 0 To 24
                If Map(xCnt, yCnt).Wall = True Then oBuffG.FillRectangle(New SolidBrush(Color.DarkGray), xCnt * 15, yCnt * 15, 15, 15)
                If Map(xCnt, yCnt).DrawPath = True Then
                    oBuffG.FillEllipse(New SolidBrush(Color.SteelBlue), xCnt * 15 + 4, yCnt * 15 + 4, 7, 7)
                End If

            Next
        Next

        'Draw the grid
        For xCnt = 0 To 25
            oBuffG.DrawLine(New Pen(Color.Black), xCnt * 15, 0, xCnt * 15, 375)
            oBuffG.DrawLine(New Pen(Color.Black), 0, xCnt * 15, 375, xCnt * 15)
        Next

        'Set the picture box image
        picMain.Image = CType(oBuff, Bitmap)

    End Sub

    Private Sub frmMain_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
        Render()
    End Sub

    Private Sub picMain_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picMain.MouseDown

        'Handle mouse down events
        If e.Button = MouseButtons.Left Then
            Dim xPos As Int16 = e.X \ 15
            Dim yPos As Int16 = e.Y \ 15

            'Process the click based on the radio button checked
            If radStart.Checked Then
                StartX = xPos
                StartY = yPos
            ElseIf radEnd.Checked Then
                EndX = xPos
                EndY = yPos
            ElseIf radWall.Checked Then
                If Map(xPos, yPos).Wall = True Then
                    Map(xPos, yPos).Wall = False
                Else
                    Map(xPos, yPos).Wall = True
                End If
            End If

            'Redraw the box
            Render()

        End If

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        FindPath()
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim xCnt, yCnt As Int16
        Heap.ResetHeap()
        For yCnt = 0 To 24
            For xCnt = 0 To 24
                With Map(xCnt, yCnt)
                    .DrawPath = False
                    .FCost = 0
                    .GCost = 0
                    .HCost = 0
                    .OCList = 0
                    .ParentX = 0
                    .ParentY = 0
                End With
            Next
        Next
        Render()
    End Sub

#End Region

End Class