Продолжение приложения б

begin

if (vert = 1) then y := plan.Width-1

else x := 0;

while (x < plan.Width) and (y >= 0) { plan.Height) } and (not flag) do

begin

if (plan.Arr[x,y] <> 0) and (a.Arr[x,y] = 0) then

begin

a.Arr[x,y] := val;

if (x = x_m) and (vert = 0) then

flag := true;

end;

if (vert = 1) then dec(y)

else inc(x);

end;

end;

procedure Find( var x, y: integer; vert, val: integer );

begin

if (vert = 1) then y := 0

else x := 0;

while (x < plan.Width) and (y < plan.Height) do

begin

if a.Arr[x,y] = val then

break;

if (vert = 1) then inc(y)

else inc(x);

end;

end;

var

index, index2, x1, y1: integer;

path: array [0..100] of TPoint;

begin

FillChar( path, sizeof(path), 0 );

x_m := -1;

y_m := -1;

v_m := MaxInt;

for index := 0 to plan.Height-1 do

Продолжение приложения б

for index2 := 0 to plan.Width-1 do

if (potential.Arr[index2,index] < v_m) then

begin

x_m := index2;

y_m := index;

v_m := potential.Arr[index2,index];

end;

a := TData.Create;

a.AssignLT( plan );

a.Arr[x_m,y_m] := 1;

flag := false;

f := 1;

while not flag do

begin

for index := 0 to plan.Height-1 do

for index2 := 0 to plan.Width-1 do

if (a.Arr[index2,index] = f) then

begin

Line( index2, index, (f+1) and 1, f+1 );

{ Memo1.Lines.Add( 'path (' + IntToStr(f) + '):' );

Dump( a, 1 ); }

end;

inc( f );

end;

Memo1.Lines.Add( 'Ïóòü: ');

Dump( a, 1 );

x1 := x_m;

y1 := y_m;

f2 := f;

while (f >= 0) do

begin

path[f].x := x1;

path[f].y := y1;

Find( x1, y1, (f+1) and 1, f );

dec(f);

end;

Продолжение приложения б

v_m := MaxInt;

x_m := -1;

index := 1;

while (index < f2) do

begin

f := plan.Arr[ path[index].x, path[index].y ];

if (f < v_m) then

begin

v_m := f;

x_m := index;

end;

inc(index,2);

end;

for index := 0 to f2-1 do

begin

f := plan.Arr[ path[index].x, path[index].y ];

if ( (index and 1) = 0 ) then f := f + v_m

else f := f - v_m;

plan.Arr[ path[index].x, path[index].y ] := f;

end;

end;

procedure TForm1.Button5Click(Sender: TObject);

procedure c( x, y: integer; s: string );

begin

StringGrid1.Cells[ x, y ] := s;

end;

begin

StringGrid1.ColCount := 7;

StringGrid1.RowCount := 5;

c( 2, 1, '100' );

c( 3, 1, '110' );

c( 4, 1, '90' );

c( 5, 1, '100' );

c( 6, 1, '130' );

c( 1, 2, '150' );

c( 1, 3, '240' );

Продолжение приложения б

c( 1, 4, '140' );

c( 2, 2, '8' );

c( 3, 2, '2' );

c( 4, 2, '8' );

c( 5, 2, '3' );

c( 6, 2, '6' );

c( 2, 3, '2' );

c( 3, 3, '8' );

c( 4, 3, '4' );

c( 5, 3, '7' );

c( 6, 3, '6' );

c( 2, 4, '4' );

c( 3, 4, '3' );

c( 4, 4, '2' );

c( 5, 4, '4' );

c( 6, 4, '8' );

end;

function TForm1.IsOver(x, y: integer): integer;

var

index: integer;

fig: TFigure;

begin

for index := 0 to fFigures.Count-1 do

begin

fig := fFigures.Items[index];

if ( (abs( fig.x - x ) <= fFigSize) and

(abs( fig.y - y ) <= fFigSize) ) then

begin

Result := index;

exit;

end;

end;

Result := -1;

end;

procedure TForm1.AddRemoveLine(i1, i2: integer);

var

index, f: integer;