Форум программистов, компьютерный форум, киберфорум
Lazarus
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.82/11: Рейтинг темы: голосов - 11, средняя оценка - 4.82
0 / 0 / 0
Регистрация: 12.01.2019
Сообщений: 29
1

Анимация: при соприкосновении двух объектов они должны образовать единое целое

28.01.2019, 18:14. Просмотров 1999. Ответов 18
Метки нет (Все метки)


Здравствуйте! Разбираюсь в анимациях Lazarus. Сделал так, чтобы два шарика (TShape) летали по форме и отталкивались от её стенок. Теперь интересно: как сделать так, чтобы при столкновении они слиплись и продолжили движение как одно тело? Подскажите, пожалуйста, как это можно сделать. Вот код:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
var
  Form1: TForm1;
PosX1: integer=5;
PosY1: integer=5;
PosX2: integer=7;
PosY2: integer=5;
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.a1(Sender: TObject); // Это TTimer
begin
  Shape1.Left :=  Shape1.Left + PosX1;
 Shape1.Top  :=  Shape1.Top + PosY1;
 if (Shape1.Left + Shape1.Width >= Form1.ClientWidth) or (Shape1.Left <= 1)
  then PosX1 := -PosX1;
 if (Shape1.Top + Shape1.Height >= Form1.ClientHeight) or (Shape1.Top <= 1)
  then PosY1 := -PosY1;
 
 Shape2.Left :=  Shape2.Left + PosX2;
 Shape2.Top  :=  Shape2.Top + PosY2;
 if (Shape2.Left + Shape2.Width >= Form1.ClientWidth) or (Shape2.Left <= 1)
  then PosX2 := -PosX2;
 if (Shape2.Top + Shape2.Height >= Form1.ClientHeight) or (Shape2.Top <= 1)
  then PosY2 := -PosY2;
 
end;
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
28.01.2019, 18:14
Ответы с готовыми решениями:

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

Перекрестные ссылки двух документов как единое целое;
Добрый день. Столкнулся с следующей проблемой: У меня есть два документа (Z и Y) со своими...

Удалить один из объектов и увеличить другой при соприкосновении объектов.
Как сделать так чтобы (Когда Sprite1 дотронулся до Sprite2 тогда sprite2 destroy и Sprite1 + size)...

Уничтожение объектов при соприкосновении
Может кто поможет. Начал делать простую игру. Пули летят и при попадании в движущийся объект...

18
Модератор
62861 / 46907 / 32328
Регистрация: 18.05.2008
Сообщений: 113,658
28.01.2019, 19:38 2
Лучший ответ Сообщение было отмечено Евгений234 как решение

Решение

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
procedure TForm1.Timer1Timer(Sender: TObject);
var r1,r2,r3:TRect;
    bf:integer;
begin
r1:=Shape1.BoundsRect;
r2:=Shape2.BoundsRect;
Shape1.Left :=  Shape1.Left + PosX1;
Shape1.Top  :=  Shape1.Top + PosY1;
if (Shape1.Left + Shape1.Width >= Form1.ClientWidth) or (Shape1.Left <= 1)
then PosX1 := -PosX1;
if (Shape1.Top + Shape1.Height >= Form1.ClientHeight) or (Shape1.Top <= 1)
then PosY1 := -PosY1;
Shape2.Left :=  Shape2.Left + PosX2;
Shape2.Top  :=  Shape2.Top + PosY2;
if (Shape2.Left + Shape2.Width >= Form1.ClientWidth) or (Shape2.Left <= 1)
then PosX2 := -PosX2;
if (Shape2.Top + Shape2.Height >= Form1.ClientHeight) or (Shape2.Top <= 1)
then PosY2 := -PosY2;
if intersectrect(r3,r1,r2) then
  begin
   PosX2:=PosX1;
   PosY2:=PosY1;
   if Shape1.Left<Shape2.Left then
     begin
      bf:=Shape1.Left;
      Shape1.Left:=Shape2.Left;
      Shape2.Left:=bf;
     end;
    if Shape1.Top<Shape2.Top then
     begin
      bf:=Shape1.Top;
      Shape1.Top:=Shape2.Top;
      Shape2.Top:=bf;
     end;
  end;
end;
1
0 / 0 / 0
Регистрация: 12.01.2019
Сообщений: 29
29.01.2019, 12:34  [ТС] 3
Puporev, а вот почему при объявлении PosX и PosY внутри таймера, шарики начинают уходить за экран, а когда объявляешь вне его, всё работает?
0
Модератор
62861 / 46907 / 32328
Регистрация: 18.05.2008
Сообщений: 113,658
29.01.2019, 12:45 4
Потому что они должны быть глобальными переменными, значения которых изменяются по таймеру, иначе при каждом тике таймера их значения будут как начальные.
0
0 / 0 / 0
Регистрация: 12.01.2019
Сообщений: 29
29.01.2019, 13:07  [ТС] 5
Puporev, можете объяснить вот эту часть?
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
if Shape1.Left<Shape2.Left then
     begin
      bf:=Shape1.Left;
      Shape1.Left:=Shape2.Left;
      Shape2.Left:=bf;
     end;
    if Shape1.Top<Shape2.Top then
     begin
      bf:=Shape1.Top;
      Shape1.Top:=Shape2.Top;
      Shape2.Top:=bf;
     end;
  end;
Зачем нужна переменная bf?
0
Модератор
62861 / 46907 / 32328
Регистрация: 18.05.2008
Сообщений: 113,658
29.01.2019, 13:15 6
Что-то я тут неправильно сделал, только сейчас заметил.
Хотел сделать чтобы после слипания отталкивание было первым кругом который коснулся стенки, но написал неверно, нужно исправлять.
0
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
30856 / 20179 / 7873
Регистрация: 22.10.2011
Сообщений: 35,034
Записей в блоге: 6
29.01.2019, 13:17 7
Уточню вопрос: зачем вообще весь код с 23 по 34-ю строки?

Вот так все прекрасно работает:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
procedure TForm1.Timer1Timer(Sender: TObject);
var
  r : TRect;
begin
  Shape1.Left := Shape1.Left + PosX1;
  Shape1.Top := Shape1.Top + PosY1;
  if (Shape1.Left + Shape1.Width >= Form1.ClientWidth) or (Shape1.Left <= 1) then
    PosX1 := -PosX1;
  if (Shape1.Top + Shape1.Height >= Form1.ClientHeight) or (Shape1.Top <= 1) then
    PosY1 := -PosY1;
 
  Shape2.Left := Shape2.Left + PosX2;
  Shape2.Top := Shape2.Top + PosY2;
 
  if (Shape2.Left + Shape2.Width >= Form1.ClientWidth) or (Shape2.Left <= 1) then
    PosX2 := -PosX2;
  if (Shape2.Top + Shape2.Height >= Form1.ClientHeight) or (Shape2.Top <= 1) then
    PosY2 := -PosY2;
 
  if IntersectRect(r, Shape1.BoundsRect, Shape2.BoundsRect) then
  begin
    PosX2 := PosX1;
    PosY2 := PosY1;
  end;
end;
1
Модератор
62861 / 46907 / 32328
Регистрация: 18.05.2008
Сообщений: 113,658
29.01.2019, 13:32 8
Так отталкивается от стенок не всегда первым шариком, а вторым. Хотелось сделать что бы всегда первым, независимо от того какая стенка и как расположены шарики.

Добавлено через 9 минут
Наверное нужно 8 условий писать, по 2 для каждой стенки, но лень. Может Евгений234 сам напишет?
0
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
30856 / 20179 / 7873
Регистрация: 22.10.2011
Сообщений: 35,034
Записей в блоге: 6
29.01.2019, 13:39 9
Не надо тут никаких 8 условий:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
var
  b : boolean = False;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  r : TRect;
  uni : TRect;
begin
  if not b then
  begin
    if (Shape1.Left + Shape1.Width >= Form1.ClientWidth) or (Shape1.Left <= 1) then PosX1 := -PosX1;
    if (Shape1.Top + Shape1.Height >= Form1.ClientHeight) or (Shape1.Top <= 1) then PosY1 := -PosY1;
 
    if (Shape2.Left + Shape2.Width >= Form1.ClientWidth) or (Shape2.Left <= 1) then PosX2 := -PosX2;
    if (Shape2.Top + Shape2.Height >= Form1.ClientHeight) or (Shape2.Top <= 1) then PosY2 := -PosY2;
 
    if IntersectRect(r, Shape1.BoundsRect, Shape2.BoundsRect) then
    begin
      b := True;
      PosX2 := PosX1;
      PosY2 := PosY1;
    end
  end
  else
  begin
    UnionRect(uni, Shape1.BoundsRect, Shape2.BoundsRect);
    if (uni.Left + uni.Width >= Form1.ClientWidth) or (uni.Left <= 1) then
      PosX1 := -PosX1;
    if (uni.Top + uni.Height >= Form1.ClientHeight) or (uni.Top <= 1) then
      PosY1 := -PosY1;
 
    PosX2 := PosX1;
    PosY2 := PosY1;
  end;
 
  Shape1.Left := Shape1.Left + PosX1;
  Shape1.Top := Shape1.Top + PosY1;
 
  Shape2.Left := Shape2.Left + PosX2;
  Shape2.Top := Shape2.Top + PosY2;
end;
0
0 / 0 / 0
Регистрация: 12.01.2019
Сообщений: 29
29.01.2019, 13:42  [ТС] 10
Конечно, доделаю уже дальше сам. Просто не понимаю, если
Delphi
1
bf:=Shape1.Left;
То почему
Delphi
1
Shape2.Left:=bf
Почему сразу не написать
Delphi
1
Shape2.Left:=Shape1.Left
0
Модератор
62861 / 46907 / 32328
Регистрация: 18.05.2008
Сообщений: 113,658
29.01.2019, 13:49 11
У volvo красиво написано, только шарики после UnionRect немного разъезжаются, что естественно, но не красиво.
0
0 / 0 / 0
Регистрация: 12.01.2019
Сообщений: 29
29.01.2019, 14:00  [ТС] 12
Puporev, volvo, большое спасибо за помощь!
0
Модератор
62861 / 46907 / 32328
Регистрация: 18.05.2008
Сообщений: 113,658
29.01.2019, 14:05 13
Все-таки напишу я с условиями, так не разлипаются.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
if intersectrect(r3,r1,r2) then
  begin
   PosX2:=PosX1;
   PosY2:=PosY1;
   if((Shape1.Left>Shape2.Left)and(Shape1.Left+Shape1.Width>=Form1.ClientWidth))
   or((Shape2.Left>Shape1.Left)and(Shape2.Left+Shape2.Width>=Form1.ClientWidth))
   or((Shape1.Top>Shape2.Top)and(Shape1.Top+Shape1.Height>=Form1.ClientHeight))
   or((Shape2.Top>Shape1.Top)and(Shape2.Top+Shape2.Height>=Form1.ClientHeight))
   then
     begin
      PosX1:=-PosX1;
      PosX2:=-PosX2;
     end;
  end;
0
0 / 0 / 0
Регистрация: 12.01.2019
Сообщений: 29
30.01.2019, 11:37  [ТС] 14
Puporev, можно ещё вопрос?(Не хочется создавать отдельную тему для этого) Есть ли в Delphi аналог FloodFill для пикселей? То есть например, ставим пиксель, и программа закрашивает всё пикселями до определённых границ(как fsBorder)?
0
Модератор
62861 / 46907 / 32328
Регистрация: 18.05.2008
Сообщений: 113,658
30.01.2019, 11:43 15
В Делфи, как и в Lazarus есть не аналог, а собственно процедура
Delphi
1
procedure FloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle);
0
0 / 0 / 0
Регистрация: 12.01.2019
Сообщений: 29
30.01.2019, 11:58  [ТС] 16
А вот если форма разделена линиями на 4 части (разделяется рандомно), и нужно сделать так, чтобы если пиксель, выбираемый также рандомно, попадает в одну из частей, то закрашивается в один цвет, а если попадает в другую-то другой цвет. Есть ли какие-нибудь встроенные процедуры, которые могут помочь здесь?
0
Модератор
62861 / 46907 / 32328
Регистрация: 18.05.2008
Сообщений: 113,658
30.01.2019, 12:30 17
Цитата Сообщение от Евгений234 Посмотреть сообщение
Есть ли какие-нибудь встроенные процедуры
Да нет, а зачем они?
Делается это так.
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
procedure TForm1.Button1Click(Sender: TObject);
var xc,yc,x,y:integer;
    cl:TColor;
begin
randomize;
xc:=50+random(clientwidth-100);
yc:=50+random(clientheight-100);
//назначим точку чтобы она не попала на линии
repeat
x:=50+random(clientwidth-100);
until x<>xc;
repeat
y:=50+random(clientheight-100);
until y<>yc;
with Canvas do
 begin
  pen.Color:=clBlack;//линии черным цветом
  rectangle(0,0,clientwidth,clientheight); //контур формы
  //линии
  moveto(xc,0);
  lineto(xc,clientheight);
  moveto(0,yc);
  lineto(clientwidth,yc);
  //выбор цвета заливки в зависимости от четверти
  if(x<xc)and(y<yc) then cl:=clRed
  else if(x<xc)and(y<yc) then cl:=clGreen
  else if(x<xc)and(y>yc) then cl:=clBlue
  else cl:=clLime;
  brush.Color:=cl;//выбрали цвет
  floodfill(x,y,clBlack,fsBorder); //закрасим до черного цвета
 end;
end;
Вообще если есть новые вопросы, тем более уже по Делфи, создавайте новую тему, не стесняйтесь и не нарушайте правила форума.
0
0 / 0 / 0
Регистрация: 12.01.2019
Сообщений: 29
30.01.2019, 14:58  [ТС] 18
Puporev, вот, сделал так, как хотел, всё оказалось очень просто:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Var
  x0,y0,x,y:integer;
  a:integer;
begin
  randomize;
  Form1.refresh;
  x0:=50+random(clientwidth-100);
  y0:=50+random(clientheight-100);
  with Canvas do
  begin
  MoveTo(x0,0);
  LineTo(x0,Form1.ClientHeight);
  MoveTo(0,y0);
  LineTo(Form1.ClientWidth,y0);
  a:=0;
  while a<1000000 do
  begin
  x:=Random(Form1.ClientWidth);
  y:=Random(Form1.ClientHeight);
  if (x<x0) and (y<y0) then
  Pixels[x,y]:=clRed
  else if(x>x0) and(y<y0) then
  Pixels[x,y]:=clGreen
  else if (x<x0) and (y>y0) then
  Pixels[x,y]:=clBlue
  else Pixels[x,y]:=clLime;
  inc(a);
  end;
  end;
end;
0
Модератор
62861 / 46907 / 32328
Регистрация: 18.05.2008
Сообщений: 113,658
30.01.2019, 15:56 19
Цитата Сообщение от Евгений234 Посмотреть сообщение
сделал так, как хотел
Вообще Вы писали совсем другое
Цитата Сообщение от Евгений234 Посмотреть сообщение
тобы если пиксель, выбираемый также рандомно,
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
30.01.2019, 15:56

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь или здесь.

Увеличение скорости объектов при их соприкосновении
Здравствуйте. помогите пожалуйста доделать пункты: 1) Добавить возможность выбора скорости...

Анимация (в пикчербоксе летают два шарика и при соприкосновении отталкиваются)
Пытаюсь сделать анимацию, где в пикчербоксе летают два шарика и при соприкосновении отталктваются ...

Остановка Таймера при соприкосновении объектов на форме
Всем привет! ребят столкнулся с такой проблемой Имеется 2 лейбла 4 и 5. 4 Это грубо говоря стена,...

Образовать новую таблицу в которой должны чередоваться слова из двух исходных таблиц
Помогите пожалуйста дописать программу на C++ Это задание ( Имеются две таблицы, содержащие по 5...

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

Из двух восьмибуквенных слов образовать последовательность букв, в которой должны чередоваться буквы первого и второго слова.
Помогите решить плиз!СПАСИБО! Из двух восьмибуквенных слов образовать последовательность букв, в...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
19
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.