asp迷宫程序

'-------------------------
'迷宫程序
'作者：塞北的雪
'日期：2005年3月
'如下面的矩阵，左上脚为入口，右下脚为出口，0表示通过，1表示阻塞
'     00001100
'     11001001
'     01000110
'     00010000
'     00000100
'
' 此程序自动生成迷宫，然后自动搜寻路经
'此例的结果为：
'{0,0} {1,0} {2,0} {3,0} {3,1} {3,2} {4,2} {4,3} {5,3} {6,3} {7,3} {7,4}    
'-------------------------'坐标点类
Class Point
  public x
  public y
  private sub Class_Initialize()
     x=0
     y=0
  end sub
end Class'创建一个Point
sub CreatePoint(byref oPoint,oX,oY)
  set oPoint=new Point
  oPoint.x=oX
  oPoint.y=oY
end sub'比较两个Point
function ComparePoint(byref p1,byref p2)
   if(p1.x=p2.x and p1.y=p2.y) then
      ComparePoint=1
   else
      ComparePoint=0
   end if
end function'在Point数组中查找Point
function FindPoint(byref p1,byref pArray,pCount)
  if(pCount>0) then
 for i=pCount-1 to 0 step -1
    if ComparePoint(p1,pArray(i))=1 then
       FindPoint=1
       exit function
    end if
 next
  end if
  FindPoint=0
end function
'--------------------------'创建迷宫阵列
sub CreateMigong(m9,n9,byref liu9)
 redim liu9(m9,n9)
 for i=0 to m9-1
   for j=0 to n9-1
      liu9(i,j)=CreateRand()
   next
 next
end sub'显示迷宫输入阵列
sub ShowMigong(m9,n9,liu9)
 for i=0 to m9-1
   for j=0 to n9-1
      Response.write round(liu9(i,j),2)
   next
   Response.Write "<br>"
 next
end sub'创建一个随机的1 or 0
function CreateRand()
   dim rndTemp
   randomize(time())
   rndTemp=rnd
   if rndTemp>0.8 then
      CreateRand=1
   else
      CreateRand=0
   end if
end function'扩大一个Point数组
sub EnlargeArray(byref pArray,addStep,byref pLen)
   pLen=pLen+addStep
   redim preserve pArray(pLen-1)
end sub'数组中添加一个指定的Point（p1)
sub AppendPath(byref pArray,byref pLen,byref pArrayLen,byref p1)
  if (pLen>=pArrayLen) then
      EnlargeArray pArray,oStep,pArrayLen 
  end if
  pLen=pLen+1
  set pArray(pLen-1)=p1
end sub'数组中添加一个Point-----根据x,y生成一个point
sub AppendPath2(byref pArray,byref pLen,byref pArrayLen,x1,y1)
  if (pLen>=pArrayLen) then
      EnlargeArray pArray,oStep,pArrayLen 
  end if
  pLen=pLen+1
  CreatePoint aPoint,x1,y1
  set pArray(pLen-1)=aPoint
end sub'从数组中删除一个Point
sub DelPoint(byref  pArray,byref pLen)
  if pLen>0 then
    pLen=pLen-1
    set pArray(pLen)=nothing
  end if
end sub'打印路经
sub PrintPath(pArray,pLen)
  Response.Write "<br>========= 路经 =========<br>"
  for i=0 to pLen-1
     Response.Write " {" & pArray(i).x & "," & pArray(i).y & "}"
  next
end sub'输出迷宫错误，此为一个没有入口的或没有出口的迷宫
sub PrintErr
    Response.Write "走投无路！"
end subsub PrintMigong(m9,n9,liu9,oPath9,pathLen9)
   Response.Write "<br>========= 迷宫路经示意图 =========<br>"
   Response.Write "<div align=center>"
   Response.Write "<table id='table1' align=center border=0>"
   for i=0 to m9-1
      Response.Write "<tr>"
      for j=0 to n9-1
         Response.Write "<td style='#dddddd'>"
         Response.Write liu9(i,j)
         Response.Write "</td>"
      next
      Response.Write "</tr>"
   next
   Response.Write "</table>"
   Response.Write "</div>"
   for i=0 to PathLen9-1
      Response.Write vbcrlf & "<script language='javascript'>" & vbcrlf
      Response.Write "table1.rows[" & oPath9(i).y & "].cells[" & oPath9(i).x & "].style.backgroundColor='#999999'" & vbcrlf
      Response.Write "</script>" & vbcrlf
   next
end sub'----------------------------
'  变量定义  初始化
'----------------------------dim m,n
m=5:n=8   '5行 8列
dim liu()   '迷宫数组dim oStep         '扩大数组的幅度
oStep=10dim oPathLen      '路径数组的长度
oPathLen=120
dim oPath()       '路径数组
redim oPath(oPathLen-1)
dim PathLen       '路径长度
PathLen=0dim errLen        '死节点数组长度
errLen=120
dim errPoint()    '死节点数组
redim errPoint(errLen-1)
dim errCount      '死节点数目
errCount=0dim aPoint     '公共节点变量
dim bPoint     '公共节点变量CreateMigong m,n,liu    '创建迷宫
ShowMigong m,n,liu      '显示迷宫
'开始寻径
if(liu(0,0))="0" then
   AppendPath2 oPath,PathLen,oPathLen,0,0  
   FindPath oPath(PathLen-1) 
else
   PrintErr
end if'搜寻路经
sub FindPath(cPoint)
   dim isFind
   isFind=0
   dim lPoint
   '分别对当前节点的四周四个节点进行判断
   if cPoint.x<n-1 and isFind=0 then
      if liu(cPoint.y,cPoint.x+1)=0  then
         CreatePoint aPoint,cPoint.x+1,cPoint.y
   set lPoint=aPoint 
   if not(FindPoint(lPoint,oPath,PathLen)=1 or FindPoint(lPoint,errPoint,errCount)=1) then
        isFind=1
   end if
   end if
   end if      if cPoint.y<m-1 and isFind=0 then
      if liu(cPoint.y+1,cPoint.x)=0  then
         CreatePoint aPoint,cPoint.x,cPoint.y+1
   set lPoint=aPoint
   if not(FindPoint(lPoint,oPath,PathLen)=1 or FindPoint(lPoint,errPoint,errCount)=1) then
        isFind=1
   end if
   end if
   end if
   
   if cPoint.x>0 and isFind=0 then
      if liu(cPoint.y,cPoint.x-1)=0  then
         CreatePoint aPoint,cPoint.x-1,cPoint.y
   set lPoint=aPoint
   if not(FindPoint(lPoint,oPath,PathLen)=1 or FindPoint(lPoint,errPoint,errCount)=1) then
        isFind=1
   end if
   end if
   end if
   
   if cPoint.y>0 and isFind=0 then
      if liu(cPoint.y-1,cPoint.x)=0  then
         CreatePoint aPoint,cPoint.x,cPoint.y-1
   set lPoint=aPoint 
   if not(FindPoint(lPoint,oPath,PathLen)=1 or FindPoint(lPoint,errPoint,errCount)=1) then
        isFind=1
   end if
   end if
   end if
   
      '至少有一个节点可以通过
      if isFind=1 then
     AppendPath oPath,PathLen,oPathLen,lPoint
   if not (lPoint.x=n-1 and lPoint.y=m-1) then 
      FindPath lPoint   '如果没有找到出口，继续往下寻找  （递归）
   else
      '如果已经搜寻到出口，则输出结果
      PrintPath oPath,PathLen
      PrintMigong m,n,liu,oPath,PathLen
   end if 
      '此节点下面所有节点君通不过
   else
      AppendPath errPoint,errCount,errLen,cPoint
      set cPoint=nothing
      set lPoint=nothing
      delPoint oPath,PathLen
      if PathLen>0 then
         FindPath oPath(PathLen-1) '如果路径中依然有节点，则退回去再重新寻找
      else
         '没有通过的路径
         PrintErr
      end if
   end ifend sub