VB直角寻路学习1

Private Const Col_Num = 100
Private Const Row_Num = 100
Private Const a = 10

Private Type Ant_Type
    x       As Integer
    y       As Integer
    x1      As Integer
    y1      As Integer
    state   As Integer
    destX   As Integer
    destY   As Integer
    Now_place As Integer
End Type

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long,ByVal x As Long,ByVal y As Long,ByVal crColor As Long) As Long

Private ant(3) As Ant_Type
Dim Map() As Long
Dim XX As Long
Dim YY As Long
Dim XN As Long
Dim YN As Long

Private Sub Command1_Click()
    Cls
End Sub

Private Sub Form_Activate()
'
    Call DrawAnt(0,vbGreen)
End Sub

Private Sub Form_Load()
'
    ReDim Map(Row_Num,Col_Num)
    ant(1).state = 0
    XX = 1
    YY = 1
'    Call DrawAnt(1,1,vbGreen)
End Sub

Private Sub DrawAnt(lngX As Long,lngY As Long,Color As Long)
'
    Form1.Line (lngX * a + 2,lngY * a + 2)-Step(a - 4,a - 4),Color,BF
End Sub

Private Sub clear_AntDraw(lngX As Long,lngY As Long)
'
    Form1.Line (lngX * a + 2,Form1.BackColor,BF
End Sub

Private Sub Form_MouseDown(Button As Integer,Shift As Integer,x As Single,y As Single)
'
    Dim i As Integer,j As Integer,M As Long,n As Long
    If (x <= Row_Num * a) And (y <= Col_Num * a) Then
        M = Fix(x / a): Debug.Print M
        n = Fix(y / a): Debug.Print n
        Debug.Print Button
        If Button = 1 Then
            If Map(M,n) = 1 Then
                Map(M,n) = 0
                Call clear_AntDraw(M,n)
            Else
                Map(M,n) = 1
                Call DrawAnt(M,n,vbRed)
            End If
            Debug.Print Map(M,n)
        End If
        If Button = 2 Then
            XN = M
            YN = n
            Call autoFindWay(XX,YY,XN,YN)
        End If
    End If
End Sub

Public Function autoFindWay(lngStartX As Long,lngStartY As Long,lngEndX As Long,lngEndY As Long) As Boolean
'
    Dim f As Integer
    Dim path() As Long
    Dim lngOKPath As Long
    Dim PathLength As Long
    Dim CurrentX As Integer
    Dim CurrentY As Integer
    Dim PointState As Boolean
    Dim currentState As Boolean
    Dim MapArea As Long
    Dim Direction(3,1) As Integer
    Dim reSearched() As Boolean
    Dim MapWidth As Integer
    Dim MapHeight As Integer
    
    MapWidth = 100
    MapHeight = 100
    
    MapArea = MapWidth * MapHeight
    ReDim path(2,MapArea) As Long
    ReDim reSearched(MapWidth,MapHeight) As Boolean
    
    reSearched(lngStartX,lngStartY) = True
    path(0,0) = lngStartX
    path(1,0) = lngStartY
    path(2,0) = 0
    
    Direction(0,0) = -1:       Direction(0,1) = 0
    Direction(1,0) = 0:        Direction(1,1) = -1
    Direction(2,0) = 1:        Direction(2,1) = 0
    Direction(3,0) = 0:        Direction(3,1) = 1
    
    lngOKPath = 0:              PathLength = 0
    
    Do
        For f = 0 To 3
            CurrentX = path(0,lngOKPath) + Direction(f,0)
            CurrentY = path(1,1)
            If CurrentX = lngEndX And CurrentY = lngEndY Then
                Exit Do
            End If
            If CurrentX > 0 And CurrentX < MapWidth And CurrentY > 0 And CurrentY < MapHeight Then
                PointState = Map(CurrentX,CurrentY)
                If Not reSearched(CurrentX,CurrentY) Then
                    currentState = False
                    If PointState = 0 Then
                        currentState = True
                    End If
                    If currentState Then
                        reSearched(CurrentX,CurrentY) = True
                        PathLength = PathLength + 1
                        If PathLength >= UBound(path,2) Then
                            MapArea = MapArea + 100000
                            ReDim Preserve path(2,MapArea) As Long
                        End If
                        path(0,PathLength) = CurrentX
                        path(1,PathLength) = CurrentY
                        path(2,PathLength) = lngOKPath
                    End If
                End If
            End If
        Next f
        lngOKPath = lngOKPath + 1
        If path(0,lngOKPath) = 0 And path(1,lngOKPath) = 0 Then
            For PathLength = 0 To lngOKPath
            
            Next PathLength
            MsgBox "------------NO WAY-------------"
            autoFindWay = False
            Exit Function
        End If
    Loop
    PathLength = lngOKPath
    Do
        Form1.Line (path(0,PathLength) * 10,path(1,PathLength) * 10)-Step(a - 4,vbGreen,BF
        PathLength = path(2,PathLength)
    Loop Until PathLength = 0
    autoFindWay = True
    MsgBox "OK"
    
End Function

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!