mixster

type
  TPointArray = array of TPoint;
  TIntegerArray = array of Integer;

  PNode = ^TNode;
  PNodeArray = array of PNode;

  TNode = record
    pos: TPoint;
    parent: PNode;
    open, closed: Boolean;
    distance: Extended;
    index: Integer;
  end;

  TBox = record
    x1, y1: Integer;
    x2, y2: Integer;
  end;

  TBoxArray = array of TBox;

function FindNeighbours(var neigh: PNodeArray; start: Integer; maxdist: Extended): Boolean;
var
  i, maxY, minY, maxX, minX: Integer;
  h: Integer;

begin
  Result := False;

  h := -1;
  SetLength(neigh, 10);

  maxY := nodes[start].pos.y + Round(maxdist);
  minY := nodes[start].pos.y - Round(maxdist);
  maxX := nodes[start].pos.x + Round(maxdist);
  minX := nodes[start].pos.x - Round(maxdist);

  for i := start - 1 downto 0 do
  begin
    if (minY > nodes[i].pos.y) then
      Break;
    if (minX > nodes[i].pos.x) or (maxX < nodes[i].pos.x) then
      Continue;

    if sqrt(Sqr(nodes[i].pos.x - nodes[start].pos.x) + Sqr(nodes[i].pos.y - nodes[start].pos.y)) <= maxdist then
    begin
      Inc(h);
      neigh[h] := @nodes[i];
      if h mod 10 = 9 then
        SetLength(neigh, h + 11);
    end;
  end;

  for i := start + 1 to High(nodes) do
  begin
    if (maxY < nodes[i].pos.y) then
      Break;
    if (minX > nodes[i].pos.x) or (maxX < nodes[i].pos.x) then
      Continue;

    if sqrt(Sqr(nodes[i].pos.x - nodes[start].pos.x) + Sqr(nodes[i].pos.y - nodes[start].pos.y)) <= maxdist then
    begin
      Inc(h);
      neigh[h] := @nodes[i];
      if h mod 10 = 9 then
        SetLength(neigh, h + 11);
    end;
  end;

  SetLength(neigh, h + 1);

  Result := h <> -1;
end;

function Dijkstra(start: Integer; ending: TPointArray; maxdist: Integer): Boolean;
var
  len: Integer;
  open, closed, neigh: PNodeArray;
  openH, closeH: Integer;
  endBoxes: TBoxArray;
  st: TNode;
  cl: PNode;
  clI, i, counter: Integer;
  clD, tmpD: Extended;
begin
  Result := False;

  len := High(ending);
  SetLength(endBoxes, len + 1);

  for i := len downto 0 do
  begin
    clI := Ceil(maxdist);
    endBoxes[i].x1 := ending[i].x - clI;
    endBoxes[i].x2 := ending[i].x + clI;
    endBoxes[i].y1 := ending[i].y - clI;
    endBoxes[i].y2 := ending[i].y + clI;
  end;

  len := Length(nodes);
  SetLength(open, len);
  SetLength(closed, len);
  openH := 0;
  closeH := -1;

  nodes[start].open := True;

  open[0] := @nodes[start];

  repeat
    if openH = -1 then
      Break;

    clI := 0;
    clD := open[0]^.distance;
    for i := 1 to openH do
    begin
      if open[i]^.distance < clD then
      begin
        clD := open[i]^.distance;
        clI := i;
      end;
    end;

    cl := open[clI];

    Inc(closeH);
    closed[closeH] := cl;
    open[clI] := open[openH];
    Dec(openH);
    cl^.closed := True;

    for i := High(endBoxes) downto 0 do
    begin
      if (cl^.pos.x >= endBoxes[i].x1) and (cl^.pos.x <= endBoxes[i].x2) then
        if (cl^.pos.y >= endBoxes[i].y1) and (cl^.pos.y <= endBoxes[i].y2) then
        begin
          if sqrt(sqr(cl^.pos.x - ending[i].x) + sqr(cl^.pos.y - ending[i].y)) <= maxdist then
          begin
            Result := True;
            Break;
          end;
        end;
    end;

    if Result then
      Break;

    if not FindNeighbours(neigh, cl^.index, maxdist) then
      Continue;

    for i := High(neigh) downto 0 do
    begin
      tmpD := cl^.distance + sqrt(sqr(cl^.pos.x - neigh[i]^.pos.x) + sqr(cl^.pos.y - neigh[i]^.pos.y));

      if neigh[i]^.open then
      begin
        if tmpD < neigh[i]^.distance then
        begin
          neigh[i]^.distance := tmpD;
          neigh[i]^.parent   := cl;
        end;
      end
      else
      begin
        neigh[i]^.distance := tmpD;
        neigh[i]^.parent   := cl;
        neigh[i]^.open     := True;
        Inc(openH);
        open[openH] := neigh[i];
      end;
    end;
  until False;

  if Result then
    frmMain.Canvas.MoveTo(ending[i])
  else
  begin
    frmMain.Canvas.MoveTo(cl^.pos.x, cl^.pos.y);
    cl := cl^.parent;
    frmMain.Canvas.Pen.Color := clRed;
  end;

  while cl <> nil do
  begin
    frmMain.Canvas.LineTo(cl^.pos.x, cl^.pos.y);
    cl := cl^.parent;
  end;

  if not Result then
    frmMain.Canvas.Pen.Color := clBlack;
end;