Конференция "Игры" » Подсчет очков в игре [Delphi, Windows]
 
  • BARI (24.05.12 14:09) [0]
    описание игры:В классической игре на экране показано квадратное поле 9×9 клеток, в случайные клетки на котором программа выставляет три шарика разных цветов. Всего 7 возможных цветов. За один ход игрок может передвинуть один шарик, выделив его и указав его новое местоположение. Для совершения хода необходимо, чтобы между начальной и конечной клетками существовал путь из свободных клеток. Цель игры состоит в удалении максимального количества шариков, которые исчезают при выстраивании шариков одного цвета по пять и более в ряд (по горизонтали, вертикали или диагонали). При исчезновении ряда шариков новые три шарика не выставляются. В остальных случая каждый ход выставляются новые три шарика.

    Прошу помочь мне исправить программу, необходимо чтобы при уничтожений линий с 4 квадратами начислялось 4 очка, линий из 5 квадратов 6 очков, и линий 6 квадратов начислялось 11 очков, то есть за каждый квадрат до 4 давалось 4 очка, а на последуещее добавление давалось 2,3,4 и.т.д.
  • BARI (24.05.12 14:12) [1]
    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;
  • СтудентИзИнститута (24.05.12 22:36) [2]
    Могу сделать за небольшое вознаграждение и предоставлении полного кода.
  • ADO (24.05.12 23:54) [3]
    А как понимать это?
    которые исчезают при выстраивании шариков одного цвета по пять и более в ряд
    и
    чтобы при уничтожений линий с 4 квадратами
  • ADO (24.05.12 23:56) [4]
    А вообще это игра Lines
    Исходники можно взять здесь
    http://coder.at.ua/load/igry/delphipascal/igra_lines/15-1-0-19
  • Бибоп (25.05.12 01:28) [5]

    > ADO  


    Не лезь, сука!
  • brother © (25.05.12 05:53) [6]
    [5]
    ты не сильно шумишь?
  • BARI (25.05.12 14:55) [7]
    >ADO
    просто в своей версий данной игры у меня квадраты), а не шарики.
    >СтудентИзИнститута
    а за сколько сделаешь?
  • СтудентИзИнститута (26.05.12 15:55) [8]

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


    Кидай сюда свою почту, там все и опишу, недорого.
  • Бибоп (26.05.12 15:56) [9]

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


    СИЛЬНО!!!
  • BARI © (26.05.12 18:39) [10]
    malevich.bari@gmail.com
  • СтудентИзИнститута (27.05.12 11:40) [11]
    Отправил.
  • СтудентИзИнститута (29.05.12 05:29) [12]
    Отправил 2-е письмо. Предлагайте свою цену, пожалуйста.
  • СтудентИзИнститута (29.05.12 05:34) [13]
    Отправил 2-е письмо. Предлагайте свою цену, пожалуйста.
  • BARI © (01.06.12 19:59) [14]
    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;
    ВОТ ТАКОЕ РЕШЕНИЕ МОЕЙ ПРОБЛЕМЫ)))
  • brother © (04.06.12 05:42) [15]
    хрень!
 
Конференция "Игры" » Подсчет очков в игре [Delphi, Windows]
Есть новые Нет новых   [118232   +38][b:0][p:0.001]