Останавливать программу при соприкосновении двух Image

@PolKulo · Регистрация: 18.05.2015

Author24 — интернет-сервис помощи студентам

Как сделать так что бы Image когда дотронится с другой Image программа останавливалось (Flappy bird) птичка с трубой.

quwy · 21.05.2015, 12:09

Не по теме:

Говорить еще не научились, а свой flappy bird уже пишем :)

@Joey · 21.05.2015, 17:27

Если второй Image не двигается с места, то:

Delphi

1
2
3

If ((Image1.Left+Image1.Width) {вычисляем левую границу картинки}>=Image2.Left) and
     ((Image1.Top+Image1.Height) >= Image2.Top) then //мы проверили, что картинка столкнулась со второй
Form1.Enabled:=false;

Добавлено через 1 минуту
Но этот код придется расширить, если у вас картинки еще и вверх/вниз передвигаются, Потому что, если картинка 1 перелетит картинку 2 сверху и опустится вниз, это будет засчитано как столкновение двух картинок. Надо тогда дописать измерение размеров и позиции Image2. Отпишитесь, если понадобится помощь

@PolKulo · 21.05.2015, 18:59 **[ТС]**

Joey, Привет помоги с Flappy Bird

@Joey · 21.05.2015, 19:00

PolKulo, Сложно понять, в чем проблема, увидеть бы побольше кода, или что Вам нужно. Скрины тоже подойдут (для прикрепления скринов к посту воспользуйтесь кнопкой со скрепкой в расширенном режиме ответа)

@PolKulo · 21.05.2015, 19:05 **[ТС]**

Вот

@PolKulo · 21.05.2015, 19:06 **[ТС]**

Joey, Вот набросок. Можешь посмотреть и если что подправить.

@PolKulo · 21.05.2015, 19:08 **[ТС]**

Joey,Вот

@PolKulo · 21.05.2015, 19:15 **[ТС]**

Joey, Вот скрин прост не знню скинул я файл или нет

@NIKOLAYY · 21.05.2015, 19:18

Сообщение от PolKulo

что бы Image когда дотронится с другой Image программа останавливалось

Пересечение двух прямоугольников IntersectRect проверяй его.

@PolKulo · 21.05.2015, 19:19 **[ТС]**

Joey, если что то напишите мне http://vk.com/aleksey.shabalinskiy

@Joey · 21.05.2015, 19:25

PolKulo, Так, пока я разбираюсь в твоем проекте, для начала дам один совет: у тебя при щелчках мышью птичка уходит бесконечно ввысь, не останавливаясь при достижении вершины окна (и бесконечно вниз тоже). Если это так и задумано, тогда ладно. А если надо исправить - то эту процедуру

Delphi

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Image1.Top:=Image1.Top-25;
end;

измени вот так

Delphi

1	if Image1.Top>10 then Image1.Top:=Image1.Top-25;//вместо 10 ставь по своему вкусу

Если птичка будет вверху, то процедура просто не сработает, и птичка не уйдет вверх

Для того, чтобы не уходила вниз, поменяй процедуру

Delphi

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Image1.Top:=Image1.Top+1;
end;

на

Delphi

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if Image1.Top<Form1.Height-50//здесь тоже выбираешь число по вкусу
then Image1.Top:=Image1.Top+1;
end;

Тогда птичка уйдет вниз наполовину, но все еще будет видна. Если не сделаешь так, то пользователю ничего не надо будет делать для победы, он просто опустит свою птичку вниз и она будет спокойно лететь, не врезаясь в трубу

Сейчас посмотрю дальше и отвечу

@NIKOLAYY · 21.05.2015, 19:38

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

@Joey · 21.05.2015, 20:17

PolKulo, Дальше для выяснения столкновения двух изображений применяй API функцию, которую предложил NIKOLAYY - IntersectRect. Вот так:
в обработчике Timer1Timer добавь переменную rec:TRect и допиши такой код:

Delphi

if IntersectRect(rec,Image1.BoundsRect,Image2.BoundsRect) then
  begin
        Image1.Visible:=false;
        Timer1.Enabled:=false;
        Timer2.Enabled:=false;
  end;

Если не осилил, вот тебе видоизмененная твоя процедура, как она должна выглядеть в итоге

Delphi

procedure TForm1.Timer1Timer(Sender: TObject);
var
rec:TRect;
begin
  if Image1.Top<Form1.Height-50//здесь тоже выбираешь число по вкусу
  then
  Image1.Top:=Image1.Top+1;
  if IntersectRect(rec,Image1.BoundsRect,Image2.BoundsRect) then
  begin
        Image1.Visible:=false;
        Timer1.Enabled:=false;
        Timer2.Enabled:=false;
  end;
end;

Добавлено через 4 минуты
Form1.Enabled:=false не делай, потому что не сможешь закрыть приложение и придется лезть в диспетчер задач. А если не отключишь таймеры и Image1, то даже при проигранной игре пользователь сможет щелчками мыши поднимать птичку вверх, а трубы так и будут идти налево

Добавлено через 26 минут
PolKulo, У вас Image2 занимает весь экран, поэтому вычислять, пролетает ли птичка через проход или врезается в трубу, будет сложно. Придется после проверки IntersectRect надо еще проверять, где находится птичка. Может тебе стоит разделить изображение на две трубы, так будет легче, тебе надо будет только

Delphi

1	if (IntersectRect(rec,Image1.BoundsRect, Image2.BoundsRect)) or (IntersectRect(rec,Image1.BoundsRect, Image2.BoundsRect))

Справишься?

@NIKOLAYY · 21.05.2015, 20:33

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

Полет птицы- КНОПКА ПРОБЕЛ.

Delphi

const
  zazor = 120; //зазор между трубами
  nzaz = 180; //начало зазора (по нижней трубе)
var
  Form1: TForm1;
  DestRect: TRect;
  i, j, n: Integer;
  Ptiniz: Boolean;
  Ptiinc: Integer;
  Ptish: Integer;
  ball: Integer; //подсчет очков
  zast: Integer; //инкримент для заставки
 
  sdvig: Integer; //сдвиг по координате X
  kadr: Integer; //номер кадра
  Btmpt, Btmpt2: TBitmap; //битмап птицы
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label2.Caption := IntToStr(Ptiinc);
 
  if bord.Left * -1 = Form1.ClientWidth then
  begin
    //кончился бордюр, запустим его сначала
    bord.Left := 0;
  end;
 
  if Trniz1.Left + Trniz1.Width = 0 then
  begin
    Trniz1.Left := Form1.ClientWidth;
    Trniz1.Top := nzaz + Random(200); //150 это от верха начало
 
    Trverh1.Left := Form1.ClientWidth;
    Trverh1.Top := Trniz1.Top - 300 - zazor;
  end;
 
  if Trniz2.Left + Trniz2.Width = 0 then
  begin
    Trniz2.Left := Form1.ClientWidth;
    Trniz2.Top := nzaz + Random(200); //100 это от верха начало
 
    Trverh2.Left := Form1.ClientWidth;
    Trverh2.Top := Trniz2.Top - 300 - zazor;
  end;
 
  if Trniz3.Left + Trniz3.Width = 0 then
  begin
    Trniz3.Left := Form1.ClientWidth;
    Trniz3.Top := nzaz + Random(200); //100 это от верха начало
 
    Trverh3.Left := Form1.ClientWidth;
    Trverh3.Top := Trniz3.Top - 300 - zazor;
  end;
 
  if Trniz4.Left + Trniz4.Width = 0 then
  begin
    Trniz4.Left := Form1.ClientWidth;
    Trniz4.Top := nzaz + Random(200); //100 это от верха начало
 
    Trverh4.Left := Form1.ClientWidth;
    Trverh4.Top := Trniz4.Top - 300 - zazor;
  end;
 
  for i := 1 to ComponentCount - 1 do
    if Components[i] is TImage then
    begin
      //если это не фон и это не птица- то появляем трубы слева
     //двигаем трубы
      if (Components[i] as TImage).Name <> 'knopka' then
        if (Components[i] as TImage).Name <> 'Ptisa' then
          if (Components[i] as TImage).Name <> 'Fon' then
            (Components[i] as TImage).Left := (Components[i] as TImage).Left -
              2;
 
      ////////////////////////////////////////////
 
      if (Components[i] as TImage).Name <> 'Ptisa' then
        if IntersectRect(DestRect, Ptisa.BoundsRect, (Components[i] as
          TImage).BoundsRect) then
        begin
          Ptisa.Picture := nil;
          Ptisa.Width := 24;
          Ptisa.Height := 34;
          Ptisa.Left := Ptisa.Left + 10;
 
          Ptisa.Canvas.Draw(0, 0, Btmpt2); //красная птица
          sndPlaySound('sounds/sfx_hit.wav', SND_NODEFAULT or SND_ASYNC);
 
          Caption := 'Конец игры';
          Ptisa.Top := bord.Top - 20; //птица врезалась падает
 
          Label4.Visible := True;
          Timer1.Enabled := False;
 
          Timer2.Enabled := False;
        end;
    end;
 
end;
 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  //вверхняя стрелка
  if (key = VK_UP) or (key = VK_SPACE) then
  begin
    Ptiniz := False; //нажали вверх летим
    Ptish := 0; //счетчик низ на ноль
    sndPlaySound('sounds/sfx_wing.wav', SND_NODEFAULT or SND_ASYNC);
  end;
 
  //нижняя стрелка
  if (key = VK_DOWN) then
    Ptisa.Top := Ptisa.Top + 16;
end;
 
procedure TForm1.Timer2Timer(Sender: TObject);
begin
  //анимация птицы
  kadr := kadr + 1;
  Ptisa.Canvas.Draw(sdvig, 0, Btmpt);
  sdvig := sdvig - 34;
 
  //координата сдвига в начало
  if kadr = 3 then
  begin
    sdvig := 0;
    kadr := 0;
  end;
 
  //вниз летит
  if Ptiniz = True then
  begin
    Timer2.Interval := 30; //быстрее скорость
    Inc(Ptish);
    Ptisa.Top := Ptisa.Top + Ptish;
    Label3.Caption := IntToStr(Ptish);
  end;
 
  //вверх летит
  if Ptiniz = False then
  begin
    Timer2.Interval := 10;
    Inc(Ptiinc);
    Ptisa.Top := Ptisa.Top - 4;
 
    if Ptiinc = 10 then
    begin
      Ptisa.Canvas.Draw(-34, 0, Btmpt); //первая картинка
      Ptiniz := True;
      Ptiinc := 0;
    end;
 
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
  Ptiniz := True;
 
  //грузим птицу
  Btmpt := TBitmap.Create;
  Btmpt.LoadFromFile('image/ptiz.bmp');
 
  Btmpt2 := TBitmap.Create;
  Btmpt2.LoadFromFile('image/pt4.bmp');
end;
 
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Ptiinc := 0;
  Ptish := 0; //счетчик низ на ноль
end;
 
procedure TForm1.Label4Click(Sender: TObject);
begin
  Timer3.Enabled := False; //стоп заставка
  Timer1.Enabled := True;
  Timer2.Enabled := True;
  Label4.Visible := False;
 
  Trniz1.Left := 484;
  Trniz2.Left := 634;
  Trniz3.Left := 784;
  Trniz4.Left := 934;
 
  Trverh1.Left := 484;
  Trverh2.Left := 634;
  Trverh3.Left := 784;
  Trverh4.Left := 934;
 
  Ptisa.Left := 184;
  Ptisa.Top := 154;
 
  Ptisa.Picture := nil;
  Ptisa.Width := 34; //ширина
  Ptisa.Height := 24;
 
  bord.Left := 0;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Btmpt.Free;
  Btmpt2.Free;
end;
 
procedure TForm1.Timer3Timer(Sender: TObject);
begin
  //анимация птицы заставка
  kadr := kadr + 1;
  Ptisa.Canvas.Draw(sdvig, 0, Btmpt);
  sdvig := sdvig - 34;
 
  //координата сдвига в начало
  if kadr = 3 then
  begin
    sdvig := 0;
    kadr := 0;
  end;
 
end;
 
end.

@Joey · 21.05.2015, 20:39

Не по теме:

Ого, NIKOLAYY постарался)) даже поиграть интересно))

@PolKulo · 21.05.2015, 21:03 **[ТС]**

NIKOLAYY, Joey, Спасибо вам огромное))

@PolKulo · 28.05.2015, 19:13 **[ТС]**

Joey, Здравствуйте. Вы помогали мне с игрой Флаппи бёрд. Исходник который скинул Николай. Я в нём разобрался. Переделал немного, убрал всё лишнее для меня. Но столкнулся с проблемой. При нажатии в меню На (new game) птица пропадает. Не могу исправить. Я думою дело в анимации которую делал Николай. Но в переделенном исходнике нет анимации. Можете помочь. Вот архив посмотрите пожалуйста. Заранее спасибо.

@Joey · 28.05.2015, 20:37

Так у тебя же по клику на New game стоит код

Delphi

1	Ptisa.Picture := nil;

Удали эту строчку

И в процедуре Timer1Timer у тебя есть такое место:

Delphi

if (Components[i] as TImage).Name <> 'Ptisa' then
        if IntersectRect(DestRect, Ptisa.BoundsRect, (Components[i] as
          TImage).BoundsRect) then
        begin
          Ptisa.Picture := nil;
          Ptisa.Width := 24;
          Ptisa.Height := 34;
          Ptisa.Left := Ptisa.Left + 10;
 
          Timer1.Enabled := False;
          Timer2.Enabled := False;
        end;

Здесь тоже убери Ptisa.Picture := nil;

Теперь все работает, и при щелчке на меню New game спокойно запускается новая игра и птичка возвращается на произвольное место. Единственная потеря - птичка не исчезает при столкновении. Если надо, чтобы она исчезала, просто напиши Ptisa.Visible:=false там, где мы удалили Ptisa.Picture:=nil в процедуре Timer1Timer, а в обработчике клика по меню New game вместо удаленной такой же строчки напиши Ptisa.Visible:=true;

Теперь все прекрасно работает, при столкновении птичка пропадает, а при щелчке на New game снова появляется )
Удачи, прикольная игрушка)

Не по теме:

Правда сложная, вот если бы чуть медленнее

Добавлено через 7 минут
На, на всякий случай, если легче, вот весь код

Delphi

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Menus;
 
type
  TForm1 = class(TForm)
    Fon: TImage;
    Trniz1: TImage;
    Trniz2: TImage;
    Trniz3: TImage;
    Trniz4: TImage;
    Trverh1: TImage;
    Trverh2: TImage;
    Trverh3: TImage;
    Trverh4: TImage;
    Ptisa: TImage;
    Timer1: TTimer;
    Timer2: TTimer;
    bord: TImage;
    Label1: TLabel;
    MainMenu1: TMainMenu;
    FlappyBird1: TMenuItem;
    NewGame1: TMenuItem;
    Complexity1: TMenuItem;
    Author1: TMenuItem;
    Howtoplay1: TMenuItem;
    Exit1: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Label1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure NewGame1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
const
  zazor = 120; //зазор между трубами
  nzaz = 180; //начало зазора (по нижней трубе)
var
  Form1: TForm1;
  DestRect: TRect;
  i, j, n: Integer;
  Ptiniz:boolean;
  Ptish:integer;
  Ptiinc:integer;
implementation
 
{$R *.dfm}
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Form1.DoubleBuffered:=true;
 
  if bord.Left * -1 = Form1.ClientWidth then
  begin
    //кончился бордюр, запустим его сначала
    bord.Left := 0;
  end;
if Trniz1.Left + Trniz1.Width = 0 then
  begin
    Trniz1.Left := Form1.ClientWidth;
    Trniz1.Top := nzaz + Random(200); //150 это от верха начало
 
    Trverh1.Left := Form1.ClientWidth;
    Trverh1.Top := Trniz1.Top - 300 - zazor;
  end;
 
  if Trniz2.Left + Trniz2.Width = 0 then
  begin
    Trniz2.Left := Form1.ClientWidth;
    Trniz2.Top := nzaz + Random(200); //100 это от верха начало
 
    Trverh2.Left := Form1.ClientWidth;
    Trverh2.Top := Trniz2.Top - 300 - zazor;
  end;
 
  if Trniz3.Left + Trniz3.Width = 0 then
  begin
    Trniz3.Left := Form1.ClientWidth;
    Trniz3.Top := nzaz + Random(200); //100 это от верха начало
 
    Trverh3.Left := Form1.ClientWidth;
    Trverh3.Top := Trniz3.Top - 300 - zazor;
  end;
 
  if Trniz4.Left + Trniz4.Width = 0 then
  begin
    Trniz4.Left := Form1.ClientWidth;
    Trniz4.Top := nzaz + Random(200); //100 это от верха начало
 
    Trverh4.Left := Form1.ClientWidth;
    Trverh4.Top := Trniz4.Top - 300 - zazor;
  end;
  for i := 1 to ComponentCount - 1 do
    if Components[i] is TImage then
    begin
//двигаем трубы
      if (Components[i] as TImage).Name <> 'knopka' then
        if (Components[i] as TImage).Name <> 'Ptisa' then
          if (Components[i] as TImage).Name <> 'Fon' then
            (Components[i] as TImage).Left := (Components[i] as TImage).Left -
              2;
 
      ////////////////////////////////////////////
 
      if (Components[i] as TImage).Name <> 'Ptisa' then
        if IntersectRect(DestRect, Ptisa.BoundsRect, (Components[i] as
          TImage).BoundsRect) then
        begin
          //Ptisa.Picture := nil;
          Ptisa.Visible:=false;
          Ptisa.Width := 24;
          Ptisa.Height := 34;
          Ptisa.Left := Ptisa.Left + 10;
 
          Timer1.Enabled := False;
          Timer2.Enabled := False;
        end;
 
    end;
end;
 
procedure TForm1.Timer2Timer(Sender: TObject);
begin
//вниз летит
  if Ptiniz = True then
  begin
    Timer2.Interval := 30; //быстрее скорость
    Inc(Ptish);
    Ptisa.Top := Ptisa.Top + Ptish;
end;
 
//вверх летит
  if Ptiniz = False then
  begin
    Timer2.Interval := 10;
    Inc(Ptiinc);
    Ptisa.Top := Ptisa.Top - 4;
 
    if Ptiinc = 10 then
    begin
      Ptiniz := True;
      Ptiinc := 0;
    end;
 
  end;
 
end;
 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 
//вверхняя стрелка
  if (key = VK_UP) or (key = VK_SPACE) then
  begin
    Ptiniz := False; //нажали вверх летим
    Ptish := 0; //счетчик низ на ноль
 
    //нижняя стрелка
  if (key = VK_DOWN) then
    Ptisa.Top := Ptisa.Top + 16;
 
    end;
 
end;
procedure TForm1.Label1Click(Sender: TObject);
begin
Timer1.Enabled := True;
Timer2.Enabled := True;
Label1.visible := False;
end;
 
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
 
procedure TForm1.NewGame1Click(Sender: TObject);
begin
 
  Timer1.Enabled := True;
  Timer2.Enabled := True;
  Label1.Visible := False;
 
  Trniz1.Left := 484;
  Trniz2.Left := 634;
  Trniz3.Left := 784;
  Trniz4.Left := 934;
 
  Trverh1.Left := 484;
  Trverh2.Left := 634;
  Trverh3.Left := 784;
  Trverh4.Left := 934;
 
  Ptisa.Left := 184;
  Ptisa.Top := 154;
 
  //Ptisa.Picture := nil;
  Ptisa.Visible:=true;
  Ptisa.Width := 34; //ширина
  Ptisa.Height := 24;
 
  bord.Left := 0;
end;
 
end.

@PolKulo · 28.05.2015, 20:43 **[ТС]**

Joey, Спасибо большое! обратно вы выручили)

@PolKulo 1 / 1 / 2 Регистрация: 18.05.2015 Сообщений: 78
	21.05.2015, 19:19 [ТС]	11
	Joey, если что то напишите мне http://vk.com/aleksey.shabalinskiy 0

quwy
	21.05.2015, 12:09 #2
	Не по теме: Говорить еще не научились, а свой flappy bird уже пишем :) 0

@PolKulo 1 / 1 / 2 Регистрация: 18.05.2015 Сообщений: 78
	21.05.2015, 18:59 [ТС]	4
	Joey, Привет помоги с Flappy Bird 0

@Joey Джоуи 1081 / 643 / 240 Регистрация: 05.05.2015 Сообщений: 3,559 Записей в блоге: 2
	21.05.2015, 19:00	5
	PolKulo, Сложно понять, в чем проблема, увидеть бы побольше кода, или что Вам нужно. Скрины тоже подойдут (для прикрепления скринов к посту воспользуйтесь кнопкой со скрепкой в расширенном режиме ответа) 1

@PolKulo 1 / 1 / 2 Регистрация: 18.05.2015 Сообщений: 78
	21.05.2015, 19:06 [ТС]	7
	Joey, Вот набросок. Можешь посмотреть и если что подправить. 0

@PolKulo 1 / 1 / 2 Регистрация: 18.05.2015 Сообщений: 78
	21.05.2015, 19:15 [ТС]	9
	Joey, Вот скрин прост не знню скинул я файл или нет Миниатюры 0

@NIKOLAYY 843 / 738 / 342 Регистрация: 22.09.2012 Сообщений: 5,034
	21.05.2015, 19:18	10
	Сообщение от PolKulo что бы Image когда дотронится с другой Image программа останавливалось Пересечение двух прямоугольников IntersectRect проверяй его. 1

@NIKOLAYY 843 / 738 / 342 Регистрация: 22.09.2012 Сообщений: 5,034
	21.05.2015, 19:38	13
	PolKulo, Посмотрел твой исходник, но как оказалось у тебя и птица не летает и нету ни чего кроме движения одной трубы. Как проверять пересечения имаг и закончить игру я тебе написал выше. Пример организации игры накидал тебе на форме. Миниатюры 1

@Joey
	21.05.2015, 20:39 #16
	Не по теме: Ого, NIKOLAYY постарался)) даже поиграть интересно)) 0

@PolKulo 1 / 1 / 2 Регистрация: 18.05.2015 Сообщений: 78
	21.05.2015, 21:03 [ТС]	17
	NIKOLAYY, Joey, Спасибо вам огромное)) 0

@PolKulo 1 / 1 / 2 Регистрация: 18.05.2015 Сообщений: 78
	28.05.2015, 20:43 [ТС]	20
	Joey, Спасибо большое! обратно вы выручили) 0