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

> Забавы, Заценяем.
SHnur
сообщение 4.01.2005 22:39
Сообщение #1


Пионер
**

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

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


Это генератор снежка в Граф. режиме .

В исходном варианте является движком со множеством настроек .

Заценяйти smile.gif жду отзывов

Snow

Змейка в граф. режиме
Snake


вот ! Такие работают =]
Всё .. Прошу тестить smile.gif

ВНИМАНИЕ!
в архиве находятся уже скомпилированные программы.
Рекомендую проверить содержимое антивирусом...
админ.


Сообщение отредактировано: SHnur - 7.01.2005 1:51


--------------------
Двадцать пятый час в сутках может появиться всего лишь из-за небольшой ошибки в программе.
Чтобы не воспользоваться сумасшедшими возможностями, нужно быть идиотом.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
SHnur
сообщение 5.01.2005 14:37
Сообщение #2


Пионер
**

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

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


GoodWind , всё писал собственоручно с Нуля !

Выложу алгоритмы :
Код

procedure dxy(key : char);
var res : point;
   f :boolean;
begin
  f := false;
  case key of
     left :
     begin
        if delta.x <> a then begin
           res.x := -a;
           res.y := 0;
           f := true;
        end
        else res := delta;
     end;
     up :
     begin
        if delta.y <> a then begin
           res.x := 0;
           res.y := -a;
            f := true;
        end
        else res := delta;
     end;
     right :
     begin
        if delta.x <> -a then begin
           res.x := a;
           res.y := 0;
           f := true;
        end
        else res := delta;
     end;
     down :
     begin
        if delta.y <> - a then begin
           res.x := 0;
           res.y := a;
           f := true;
        end
        else res := delta;
     end;
  end;

  if not(f) then res := delta;

  Delta := res;
end;

procedure ShrArray;
var i :integer;
begin
  for i := n downto 2 do begin
     snake[i].x := snake[i-1].x;
     snake[i].y := snake[i-1].y;
  end;
end;
{--}
function inarr:boolean;
var res : boolean;
   i :integer;
begin
  res := false;
  for i := 1 to n do begin
     if (lastfood.x = snake[i].x) and (lastfood.y = snake[i].y) then res := true;
  end;
  inarr := res;
end;
{--}
procedure food;
begin
  repeat
     lastfood.x := random((weidht div a)-15)*a + bleftx+a;
     lastfood.y := random((height div a)-15)*a + bupy+a;
  until not(inarr);

  setallcolor(pcol);
  bar(lastfood.x+1,lastfood.y+1,lastfood.x+a-2,lastfood.y+a-2);
end;
{--}
function MainSnake:boolean; {True - ziv , false - mertv}
var i , dx , dy : integer;
   res : boolean;
begin
  res := true;
  dx := delta.x;
  dy := delta.y;

  setallcolor(bgcol);
  bar(snake[n].x,snake[n].y,snake[n].x+a-1,snake[n].y+a-1);


  if (getpixel(snake[1].x+dx,snake[1].y+dy) <> MainCol) then begin
     if (getpixel(snake[1].x+dx+a-1,snake[1].y+dy+a-1) <> MainCol) then begin

        ShrArray;

        snake[1].x := snake[1].x + dx;
        snake[1].y := snake[1].y + dy;

        setallcolor(Maincol);
        bar(snake[1].x,snake[1].y,snake[1].x+a-1,snake[1].y+a-1);
     end
     else begin
        res := false;
     end;
  end
  else begin
     res := false;
  end;
  if (snake[1].x = lastfood.x) and (snake[1].y = lastfood.y) then begin
        score := score + speed*10;
        inc(n);
        sound(800);
        delay(2);
        sound(400);
        delay(2);
        nosound;
        food;
  end;

 MainSnake :=  res;
end;
{--}
procedure dxy(key : char);
var res : point;
   f :boolean;
begin
  f := false;
  case key of
     left :
     begin
        if delta.x <> a then begin
           res.x := -a;
           res.y := 0;
           f := true;
        end
        else res := delta;
     end;
     up :
     begin
        if delta.y <> a then begin
           res.x := 0;
           res.y := -a;
            f := true;
        end
        else res := delta;
     end;
     right :
     begin
        if delta.x <> -a then begin
           res.x := a;
           res.y := 0;
           f := true;
        end
        else res := delta;
     end;
     down :
     begin
        if delta.y <> - a then begin
           res.x := 0;
           res.y := a;
           f := true;
        end
        else res := delta;
     end;
  end;

  if not(f) then res := delta;

  Delta := res;
end;

repeat
        if keypressed then begin
           key := readkey;
           if (key = #0) then key := readkey;
        end;
        if key <> pause then begin
           dXY(key);

           ts := score;

           nekonec := MainSnake;

           if ts <> score then dumpscore;

           delay((11-speed)*10{00});
        end;

        until (key = esc) or not(nekonec);



Это не весь код , но тут всё ясно !

winter выложу вечером .
Выкладывай полный код!!!!!!
админ.


Сообщение отредактировано: Oleg_Z - 6.01.2005 15:03


--------------------
Двадцать пятый час в сутках может появиться всего лишь из-за небольшой ошибки в программе.
Чтобы не воспользоваться сумасшедшими возможностями, нужно быть идиотом.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 



- Текстовая версия 15.07.2025 21:06
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"