//не проверял
const dx: array[0..2] of integer = (1, 1, 0);
const dy: array[0..2] of integer = (0, 1, 1);
var a: array[1 .. 10, 1 .. 10] of integer; //поле: 0 если пусто, цвет шарика если шарик
...
procedure FindLines()
var will_delete[1 .. 10, 1.. 10] of boolean; //здесь будем отмечать все шарики, которые пропадут за ход
i, j, dir, k, len, color: integer;
begin
for i := 1 to 10 do
for j := 1 to 10 do
will_delete[i, j] := false;
for i := 1 to 10 do
for j := 1 to 10 do
for dir := 0 to 2 do begin //направление: вправо, по диаголи или вниз
len := 1;
color := a[i, j];
if color = 0 then
continue;
//идем по направлению, пока не вылезем за поле/не встретим другой цвет
while (i + len * dy[dir] <= 10) and (j + len * dx[dir] <= 10) and
(a[i + len * dy[dir], j + len * dx[dir]] = color) do
Inc(len);
if (len >= 5)
for k := 0 to len - 1 do
will_delete[i + k * dy[dir], j + k * dx[dir]] := true;
end;
for i := 1 to 10 do
for j := 1 to 10 do
if will_delete[i, j] then
a[i, j] := 0;
end;
for i := 1 to 10 do
for j := 1 to 10 do
for dir := 0 to 2 do begin //направление: вправо, по диаголи или вниз
len := 1;
color := a[i, j];
if color = 0 then
continue;
//идем по направлению, пока не вылезем за поле/не встретим другой цвет
while (i + len * dy[dir] <= 10) and (j + len * dx[dir] <= 10) and
(a[i + len * dy[dir], j + len * dx[dir]] = color) do
Inc(len);
if (len >= 5)
for k := 0 to len - 1 do
will_delete[i + k * dy[dir], j + k * dx[dir]] := true;
end;
const dx: array[0..2] of integer = (1, 1, 0,-1);
const dy: array[0..2] of integer = (0, 1, 1,-1);
const dx: array[0..2] of integer = (1, 1, 0,-1);
const dy: array[0..2] of integer = (0, 1, 1,-1);
function volna(a:mas; x1,y1,x,y:integer):integer;
var b:mas; i,j:integer; ni,nk:integer; rez:integer;
begin
ni:=0;nk:=81;rez:=0;
for i:=1 to 9 do
for j:=1 to 9 do begin
if a[i,j]=0 then b[i,j]:=254;
if a[i,j]>0 then b[i,j]:=255;
if (i=x1) and (j=y1) then b[i,j]:=253;
if (i=x) and (j=y) then b[i,j]:=0;
end;
repeat
for i:=1 to 9 do begin
for j:=1 to 9 do begin
if b[i,j]=ni then begin
if b[i+1,j]=254 then b[i+1,j]:=ni+1;
if b[i+1,j]=253 then begin volna:=1;exit;end;
if b[i-1,j]=254 then b[i-1,j]:=ni+1;
if b[i-1,j]=253 then begin volna:=1;exit;end;
if b[i,j+1]=254 then b[i,j+1]:=ni+1;
if b[i,j+1]=253 then begin volna:=1;exit;end;
if b[i,j-1]=254 then b[i,j-1]:=ni+1;
if b[i,j-1]=253 then begin volna:=1;exit;end;
end;
end;inc(ni);
end;
until ni<=nk;
end;