Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 01.05.2016, 17:30   #1
Reklid
Новичок
Джуниор
 
Регистрация: 01.05.2016
Сообщений: 2
По умолчанию Задача на лопанье шариков

На надвигающейся платформе находится ряд разноцветных шаров. Имеется пушка стреляющая такими шарами. Если есть попадание шарика из пушки в скопление шаров такого же цвета, то скопление лопается(за скопление я взял 3 шара по горизонтали).

Проблемы:
Проблема у меня одна: как сделать так, чтобы проверялась одинаковость цвета у шара из пушки и шара в "стене" при попадании?

Код:
uses GraphABC;
const n = 10;
      r = 30;
      n1 = 5;
type mas = array [1..n] of integer;
     mas1 = array [1..n1] of mas;
var y,a:mas1;
    x:mas;
    q,k,i,j,j1,state:byte;
    v:shortint;
    x1,y1,x2,y2,y3,x3:integer;
    c:array [1..n1,1..n] of color;
    cl:array [1..n1,1..n] of color;
    c3:array [1..3] of color;
    b:boolean;
    s:string;
procedure handleKeyDown(vk:integer);
begin
  if vk = VK_Right then begin x1 := x1 + 5; x2 := x2 + 5; if state = 1 then x3 := x3 + 5; end;
  if vk = VK_Left then begin x1 := x1 - 5; x2 := x2 - 5; if state = 1 then x3 := x3 - 5; end;
  if vk = VK_Space then begin state := 2; b := true; end;
end;

{-------------------------------Пушка----------------------------------------}
procedure DrawGame(state:byte; var b:boolean; j,j1:byte; var x1,y1,x2,y2,y3,x3:integer);
begin
  SetBrushColor(clDarkGray);
  Rectangle(x1,y1,x2,y2);
  if state = 2 then
  begin
    if j = 1 then
      begin
        j := n;
        j1 := j1 - 1;
        SetBrushColor(cl[j1,j]);
        FillCircle(x3,y3,r);
      end
      else
      begin
        SetBrushColor(cl[j1,j-1]);
        FillCircle(x3,y3,r);
      end
  end
  else
  if j <= n then
    begin
      SetBrushColor(cl[j1,j]);
      FillCircle(x1 + 80,y3,r);
    end;
  b := false;
end;
{----------------------------------------------------------------------------}


procedure Window;
begin
  SetWindowSize(30*20, 25*20);   
  SetWindowTitle('Шарики');
  SetWindowIsFixedSize(true);
end;

{--------------Инициализация переменных, координат и цветов------------------}
begin
  Window;
  LockDrawing;
  OnKeyDown := handleKeyDown;
  k := 0;
  v := -1;
  j := 1;
  j1 := 1;
  c3[1] := clBlue;
  c3[2] := clYellow;
  c3[3] := clRed;
  state := 1;
  x1 := (WindowWidth div 2) - 80;  
  y1 :=  WindowHeight - 25;
  x2 := (WindowWidth div 2) + 80;  
  y2 :=  WindowHeight;
  y3 :=  WindowHeight - 25 - r;
  x3 :=  WindowWidth div 2;
  for i := 1 to n1 do
    begin
      v := v + 2;
      for q := 1 to n do
        begin
          y[i,q] := -r*v;
          c[i,q] := c3[random(1,3)];
          cl[i,q] := c3[random(1,3)];
          a[i,q] := 1;
        end;
    end;
  for i := 1 to n do
  begin
    k := 0;
    for q := 1 to n do 
      begin
        x[q] := r + k*r; 
        k := k + 2;
      end;
  end;  
{----------------------------------------------------------------------------}


  while true do
    begin
      ClearWindow;
      if b then 
        if j = n then 
          begin
            j1 := j1 + 1;
            j := 1;
          end
        else j := j + 1;
      DrawGame(state,b,j,j1,x1,y1,x2,y2,y3,x3);
      
{----------------------Рисование стены с шарами------------------------------}
      for i := 1 to n1 do
      for q := 1 to n do
      if a[i,q] = 1 then
      begin
        SetBrushColor(c[i,q]);
        FillCircle(x[q],y[i,q],r);
      end;      
{----------------------------------------------------------------------------}

{-------------------------Движение шарика из пушки---------------------------}
      if state = 2 then y3 := y3 - 5;
{----------------------------------------------------------------------------}

{-------------------------------Game over------------------------------------}
    if state = 3 then begin
      ClearWindow(clBlack);
      SetBrushColor(clBlack);
      s := 'Game Over';
      SetFontName('Mistral');
      SetFontSize(48);
      SetFontColor(clWhite);
      TextOut((30*20-TextWidth(s)) div 2, (25*20-TextHeight(s)) div 2, s);
    end;
{----------------------------------------------------------------------------}    
        
      Redraw;
      Sleep(50);      
      
{-----------------------Проверка на попадание--------------------------------}
      for i := 1 to n1 do
      for q := 1 to n do
        begin
          if (y[i,q] + r) >= y1 then state := 3;
          if a[i,q] = 1 then
          if ((((x1 + 80) - x[q])*((x1 + 80) - x[q])) + ((y3 - y[i,q])*(y3 - y[i,q]))) <= 4*r*r then 
          begin
          
{----------------------Проверка на попадание одинаковых цветов---------------}
            if cl[i,q] = c[i,q] then
            begin
              a[i,q] := 0;
              if q > 0 then
                if c[i,q+1] = c[i,q] then a[i,q+1] := 0;
              if q > 1 then
                if c[i,q-1] = c[i,q] then a[i,q-1] := 0;
            end;
{----------------------------------------------------------------------------}
            
{---------------------------Возврат шарика в пушку---------------------------}
            y3 := WindowHeight - 25 - r;
            x3 := x1 + 80;
            state := 1;
{----------------------------------------------------------------------------}

          end;

{--------------------Движение стены с шарами---------------------------------}
          if state = 3 then y[i,q] := y[i,q]
          else
          y[i,q] := y[i,q] + 1;    
        end;
{----------------------------------------------------------------------------}

    end;
end.

Последний раз редактировалось BDA; 01.05.2016 в 17:56.
Reklid вне форума Ответить с цитированием
Старый 01.05.2016, 19:10   #2
NetSpace
Участник клуба
 
Аватар для NetSpace
 
Регистрация: 03.06.2009
Сообщений: 1,814
По умолчанию

делаете игру BUBBLE97 ???
Программирование - это единственный способ заставить компьютер делать то, что тебе хочется, а не то, что приходится.
NetSpace вне форума Ответить с цитированием
Старый 01.05.2016, 20:14   #3
Reklid
Новичок
Джуниор
 
Регистрация: 01.05.2016
Сообщений: 2
По умолчанию

Ну что-то вроде того, отличие в том, что шарики идут не в шахматном порядке.
Reklid вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
задача на делфи - движение шариков по клеткам Dinara1992 Помощь студентам 2 24.10.2013 14:35
Зарисовка шариков HeLLiSH Общие вопросы Delphi 6 22.06.2012 10:10
Задача на лопанье шаров TP 7.0 fox_ Паскаль, Turbo Pascal, PascalABC.NET 1 23.04.2012 19:47
массивы шариков nexzis Помощь студентам 4 02.11.2010 17:34
Расчет столкновения шариков. belomorinka Общие вопросы Delphi 3 02.06.2009 18:54