IPB
ЛогинПароль:

> Игра - Шарики с пластинами
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 11

Репутация: -  0  +


Здравствуйте!
Помогите пожалуйста написать игру или найти исходник для нее!
Я не знаю как она действительно называется, но суть такова : пользователь управляет шариком(вправо-влво),небольшие пластины движутся вверх; шарик должен перемещаться по этим пластинам так, чтобы не упасть в "бездну" и не дойти до верней точки игрового поля.

Спасибо за внимание!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Профи
****

Группа: Пользователи
Сообщений: 775
Пол: Мужской

Репутация: -  0  +


Что-то меня зацепило... ;) Взялся без особого интереса, но...
Сделано все плохо, но стандартными паскалевскими средствами! Никакого асма. + до кучи подсчет дырок.
Только без пинков по поводу шлейфа около круга, это не от кривых рук, а для красотищи.. smile.gif

И еще, товарищи, давайте обойдемся без тупых вопросов, графика не инициализируется и все такое... <_<

Код

Uses
   Graph,Crt;
Const
    LineCount = 10;
    HoleSize  = 30;
    Step      = 01;
    LineC     = White;
    R         = 10;
    Pause     = 4500;
Var
  i,j:Word;
  Gd,Gm:Integer;
  S:String;
  LineH:Word;
  A:array[1..LineCount,1..3] of Word;
  Process,MustMove:Boolean;
  X,Y:Word;  {Љ®®а¤Ё­ вл и аЁЄ }
  C:Char;
  HC:LongInt;

Procedure OutLine(N:Word);
begin
    If (A[N,1]>0) and (A[N,1]<641) then
    begin
         Line(1,A[N,1],A[N,2],A[N,1]);
         Line(A[N,2]+HoleSize,A[N,1],A[N,3],A[N,1]);
         Line(A[N,3]+HoleSize,A[N,1],640,A[N,1]);
    end;
end;

Begin
    Randomize;
    Gd:=Detect;
    InitGraph(Gd,Gm,'');
    {‚ᥠЁ§­ з «м­® ®ЇвЁ¬Ё§Ёа®ў ­® Ї®¤ а §аҐиҐ­ЁҐ 640е480}
    LineH:=640 DIV (LineCount+5);
    For i:=1 to LineCount do
    begin
         A[i,1]:=i*LineH;
         A[i,2]:=Random(320)+10;
         A[i,3]:=Random(200)+320;
         OutLine(i);
    end;
    Y:=LineCount;
    X:=((A[i,3]-A[i,2]+HoleSize) DIV 2) + HoleSize + A[i,2];
    Circle(X,A[Y,1]-R,R);
    Process:=True;
    MustMove:=False;
    {j:=1; {‘зҐвзЁЄ ®в­®бЁвҐ«м­®Ј® ᬥ饭Ёп}
    ReadLn;
    HC:=0;
    While Process do
    begin
         If KeyPressed then
         begin
              C:=ReadKey;
              Case C of
              #122:If X<>1 then Dec(X);
              #120:If X<>640 then Inc(X);
              #27:Process:=False;
              end;
              If ((A[Y,2]+HoleSize DIV 2)=X) or
              ((A[Y,3]+HoleSize DIV 2)=X) then
              begin
                   Inc(HC);
                   Inc(Y);
                   If Y=LineCount+1 then Process:=False;
              end;
         end;
         SetColor(Black);
         Circle(X,A[Y,1]-R,R);
         For i:=1 to LineCount do
         begin
              {‘вЁа Ґ¬ бв а®Ґ}
              Line(1,A[i,1],640,A[i,1]);
              Dec(A[i,1],Step);
         end;
         {Џа®и«  ЇҐаў п Ё ўв®а п}
         If (A[1,1]=1) then MustMove:=True; {Check range}
         SetColor(LineC);
         If MustMove then
         {Move array}
         begin
              MustMove:=False;
              For i:=1 to LineCount-1 do
              begin
                   A[i,1]:=A[i+1,1];
                   A[i,2]:=A[i+1,2];
                   A[i,3]:=A[i+1,3];
              end;
              Dec(Y);
              If Y=0 then Process:=False;
              {Last line}
              i:=LineCount;
              A[i,1]:=i*LineH;
              A[i,2]:=Random(320)+10;
              A[i,3]:=Random(200)+320;
         end;
         For i:=1 to LineCount do
         begin
              OutLine(i);
         end;
         Circle(X,A[Y,1]-R,R);
         Delay(Pause);
    end;
    ClearDevice;
    SetTextStyle(TriplexFont,0,7);
    SetColor(Red);
    Str(HC,S);
    OutText('CRASH!!! BABAX!!!');
    If HC=0 then OutTextXY(10,200,'XEPOBO!!!')
    else
        OutTextXY(10,200,S+' HOLES!');
    ReadLn;
    CloseGraph;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Kio   Игра - Шарики с пластинами   31.05.2004 18:28
BlackShadow   Не думаю, что для кого-то кроме тебя это так уж ва…   31.05.2004 19:09
Kio   Спасибо Вам большое! Вы единственный кто откли…   1.06.2004 15:10
BlackShadow   Только я чего-то недопонял. Если пластины движутся…   1.06.2004 15:20
Kio   Так... Сейчас все попробую обьяснить! …   1.06.2004 15:33
BlackShadow   Изящно ты меня тупым назвал :) Посмотрю сегодня, ч…   1.06.2004 16:19
Kio   Ой... Извените пожалуйста, если так со стороны пок…   1.06.2004 20:17
GLuk   Что-то меня зацепило... ;) Взялся без особого инте…   1.06.2004 22:28
Altair   Uses CRT,Graph; Const sShar=100; sPlo=200; KP …   1.06.2004 22:45
Altair   Во-первых работает ТОЛЬКО моя. Во вторых в моей уп…   1.06.2004 22:58
Kio   Да, действительно только вторая работает... Ща си…   1.06.2004 23:17
GLuk   Ща проверю....   1.06.2004 23:20
GLuk   Товарищи у Вас стандартный компилер??!! У …   1.06.2004 23:31
Altair   Гы ... :lol: Я даже знаю почему, но не скажу. С…   1.06.2004 23:38
Kio   Проблема не в этом.... Шарик с пластиночки (када о…   1.06.2004 23:41
Altair   Это у меня??? У меня такого нет! У меня шар в…   1.06.2004 23:49
Kio   2 GLuk- про шарик, который не падает с пластиночек…   1.06.2004 23:53
Altair   Дая не назвал ошибку, а просто указал где она появ…   2.06.2004 0:08
GLuk   АААААААААААА!! Ты имеешь ввиду, то что при…   2.06.2004 3:01
Kio   2Gluk --- да вроде все так, тока шарик не падает..…   2.06.2004 3:10
GLuk   Куда он не падает? На следующую пластину?? У меня …   2.06.2004 10:34
Shadow   неа у GLuk - a все работает я проверил сразу отком…   2.06.2004 15:55
GLuk   Вот и я о том же, тама Ctrl+F9 надо нажимать товар…   2.06.2004 17:51
Altair   Не-а товарищ! Тама Ctrl+F9 нажимаешь и запуска…   3.06.2004 11:23
GLuk   Стандартный - седьмой, по-моему как и у многих, пр…   3.06.2004 23:34
Kio   2 Oleg_Z --- По-моему succ там совсем не нужен…   3.06.2004 23:41
GLuk   А почему у Shadow и меня падает??   3.06.2004 23:43
Kio   а как закрасить шарик и чтоб он шлейф не оставлял …   3.06.2004 23:49
GLuk   Товарищи - потестите мою прогу на предмет ДЫРОЧКИ,…   4.06.2004 0:18
Kio   2Gluk --- только что перегрузила комп и протестила…   4.06.2004 0:26
Zed2000   У Altair офигенная прога! Конечно, с серединой…   12.03.2006 23:15


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 28.04.2024 11:21
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name