Построение матрицы смежности.

    ZeroPnt:TPoint= (x:0; y:0);
    EndPnt:TPoint= (x:100; y:100);
    TPoint=record x,y:integer; end;
    type TArrs=array[1..30] of Square;
 
    function CrossLine(p1,p2,p3,p4:TPoint):boolean;
    var a,b,c,d,e,f,dt,ds,det,t,s:real;
    begin
         a:=p2.x-p1.x;
         b:=p3.x-p4.x;
         c:=p3.x-p1.x;
         d:=p2.y-p1.y;
         e:=p3.y-p4.y;
         f:=p3.y-p1.y;
         det:=a*e-b*d;
         if det=0 then CrossLine:=false
                  else
                      begin
                           dt:=c*e-f*b;
                           ds:=a*f-c*d;
                           t:=dt/det;
                           s:=ds/det;
                           if (0<s) and (s<1) and
                              (0<t) and (t<1) then CrossLine:=true
                                              else CrossLine:=false;
                      end;
    end;
    
    function Check(sa:TArrs; num:byte; p1,p2:TPoint):boolean;
    var i:integer;
        crossq:boolean;
    begin
         crossq:=false;
         for i:=1 to num do
             begin
                  crossq:=CrossLine(sa[i][1],sa[i][2],p1,p2);
                  if not crossq then crossq:=CrossLine(sa[i][2],sa[i][3],p1,p2)
                                else break;
                  if not crossq then crossq:=CrossLine(sa[i][3],sa[i][4],p1,p2)
                                else break;
                  if not crossq then crossq:=CrossLine(sa[i][1],sa[i][4],p1,p2)
                                else break;
             end;
         Check:=crossq;
    end;
    
    procedure Path(sa:TArrs; num:byte; var graph:GMatrix);
    var i,j,n,m,k:integer;
    begin
         if not Check(sa,num,ZeroPnt,EndPnt) then begin
                                       graph[1,2]:=Dist(ZeroPnt,EndPnt);
                                       graph[2,1]:=Dist(ZeroPnt,EndPnt);
                                      end;
         for i:=1 to num do
             for j:=1 to 4 do
                 begin
                      if not Check(sa,num,ZeroPnt,sa[i][j]) then begin
                                                    graph[1,2+i*j]:=Dist(ZeroPnt,sa[i][j]);
                                                    graph[2+i*j,1]:=Dist(ZeroPnt,sa[i][j]);
                                                   end;
                      if not Check(sa,num,EndPnt,sa[i][j]) then begin
                                                    graph[2,2+i*j]:=Dist(EndPnt,sa[i][j]);
                                                    graph[2+i*j,2]:=Dist(EndPnt,sa[i][j]);
                                                   end;
                 end;
    end;