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
