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
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。