описание игры:В классической игре на экране показано квадратное поле 9×9 клеток, в случайные клетки на котором программа выставляет три шарика разных цветов. Всего 7 возможных цветов. За один ход игрок может передвинуть один шарик, выделив его и указав его новое местоположение. Для совершения хода необходимо, чтобы между начальной и конечной клетками существовал путь из свободных клеток. Цель игры состоит в удалении максимального количества шариков, которые исчезают при выстраивании шариков одного цвета по пять и более в ряд (по горизонтали, вертикали или диагонали). При исчезновении ряда шариков новые три шарика не выставляются. В остальных случая каждый ход выставляются новые три шарика.

Прошу помочь мне исправить программу, необходимо чтобы при уничтожений линий с 4 квадратами начислялось 4 очка, линий из 5 квадратов 6 очков, и линий 6 квадратов начислялось 11 очков, то есть за каждый квадрат до 4 давалось 4 очка, а на последуещее добавление давалось 2,3,4 и.т.д.

procedure TForm1.FormCreate(Sender: TObject);
begin
score:=0;
numlines:=0;
Init(true,true,true);
NewSquare(3);
end;

procedure TForm1.DestroySquare(x,y,k,i,j:integer);
var
n,dx,dy:integer;
image:TImage;
begin
n:=0; dx:=x; dy:=y;
while n<>k do begin
image:=FindSquare(dx*30,dy*30); image.Destroy;
application.ProcessMessages;
Map[dx,dy]:=0;
n:=n+1; dx:=dx+i; dy:=dy+j;
end;
Data(k,1);
DestroyFlag:=true;
end;

function TForm1.FindLine(x,y,i,j:integer):integer;
var
dx,dy,k:integer;
begin
dx:=x; dy:=y; k:=0;
while Map[x,y]=Map[dx,dy] do begin
if ExitMap(dx,dy)=true then begin
dx:=dx+i;
dy:=dy+j;
k:=k+1;
end else break;
end;
result:=k;
end;

procedure TForm1.DestroyLines;
var
x,y,k,i,j:integer;
begin
DestroyFlag:=false;
for y:=0 to 8 do begin
for x:=0 to 8 do begin
 if Map[x,y]<>0 then begin
 if FindLine(x,y,1,0)>3  then DestroySquare(x,y,FindLine(x,y,1,0),1,0) else
 if FindLine(x,y,1,1)>3  then DestroySquare(x,y,FindLine(x,y,1,1),1,1)else
 if FindLine(x,y,0,1)>3  then DestroySquare(x,y,FindLine(x,y,0,1),0,1) else
 if FindLine(x,y,-1,1)>3 then DestroySquare(x,y,FindLine(x,y,-1,1),-1,1);
 end;
end;
end;
end;

function TForm1.EmptyPos(Pole:Desk):integer;
var
x,y,e:integer;
begin
e:=0;
for y:=0 to 8 do begin
for x:=0 to 8 do begin
if Pole[x,y]=0 then e:=e+1;
end;
end;
result:=e;
end;

procedure TForm1.Data(sc,nl:integer);
begin
numlines:=numlines+nl;
score:=score+sc;
Statusbar1.Panels[0].Text:='Уничтожено линий: '+inttostr(numlines);
Statusbar1.Panels[1].Text:='Очки: '+inttostr(score);
end;

Могу сделать за небольшое вознаграждение и предоставлении полного кода.

А как понимать это?
которые исчезают при выстраивании шариков одного цвета по пять и более в ряд
и
чтобы при уничтожений линий с 4 квадратами

А вообще это игра Lines
Исходники можно взять здесь
http://coder.at.ua/load/igry/delphipascal/igra_lines/15-1-0-19

> ADO  


Не лезь, сука!

[5]
ты не сильно шумишь?

>ADO
просто в своей версий данной игры у меня квадраты), а не шарики.
>СтудентИзИнститута
а за сколько сделаешь?

> BARI   (25.05.12 14:55) [7]
> а за сколько сделаешь?


Кидай сюда свою почту, там все и опишу, недорого.

> ты не сильно шумишь?


СИЛЬНО!!!

malevich.bari@gmail.com

Отправил.

Отправил 2-е письмо. Предлагайте свою цену, пожалуйста.

Отправил 2-е письмо. Предлагайте свою цену, пожалуйста.

procedure TForm1.Data(sc,nl:integer);
 var add:integer;  
     i:integer;
begin
add:=4;    
for i := 5 to sc do    
 inc(add,i-3);
numlines:=numlines+nl;
inc(score,add);    
Statusbar1.Panels[0].Text:='Уничтожено линий: '+inttostr(numlines);
Statusbar1.Panels[1].Text:='Очки: '+inttostr(score);
end;
ВОТ ТАКОЕ РЕШЕНИЕ МОЕЙ ПРОБЛЕМЫ)))

хрень!