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

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Задача про упругие соударения шаров
Юзер
сообщение 23.03.2010 17:00
Сообщение #1





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

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


Подскажите алгоритм или исходник для задачи.Задача про упругие столкновения N-того количества шаров о друг друга и отенки сосудов.Или направте где эта тема уже рассматривалась.

Сообщение отредактировано: Юзер - 24.03.2010 14:39
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
volvo
сообщение 30.03.2010 15:44
Сообщение #2


Гость






Цитата
Я пробывал как volvo написал сделать но увы не выходит,не получается одними только изменениями в InitBalls даже добится чтобы шары появлялись в разных часях экрана
Ну как же не получается? Все получается. Вот так, например, у тебя будут только красные шары и только в левой части экрана (скорости Vx и Vy сброшены в 0, чтобы ты увидел, что это именно так)

procedure InitBalls;
var
i, j: integer;
isIntersect: boolean;
TX, TY: TData;
Begin
Randomize;

n := Nn div 2;
for i := 1 to n do
with Balls[ i ] do
begin
repeat
TX := random((GetMaxX div 2) - D) + r;
TY := random(GetMaxY - D + r);

isIntersect := False;
for j := 1 to i - 1 do
if sqrt(sqr(TX - Balls[j].X) + sqr(TY - Balls[j].Y)) < D then
begin
isIntersect := True; break;
end;
until not isIntersect;

XOld := TX; YOld := TY;

Color := Red;
Vx := 0; { -Vmax+Random*2*Vmax; }
Vy := 0; { -Vmax+Random*2*Vmax; }
dVx := 0;
dVy := 0;
end;
End; { InitBalls }


Добавь сюда же еще один такой же цикл, в котором координаты X генерируются в правой части (TX := random((GetMaxX div 2) - D) + r + (GetMaxX div 2)), и замени цвет шаров на синий - вот и будут у тебя слева - все красные, а справа - все синие шары.

А ты говоришь "не получается".
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Юзер   Задача про упругие соударения шаров   23.03.2010 17:00
Lapp   Тема нарушает Правила Форума (п.4) и правила разде...   23.03.2010 18:49
Lapp   Спасибо. Опиши задачу немного подробнее, плз. Ка...   24.03.2010 21:30
Юзер   Сосуд это весь экран.Задача 2-ух мерная.Сначала ша...   25.03.2010 4:11
Lapp   Из задачи Billiard,я беру процедуры,но чёта толком...   25.03.2010 4:43
Lapp   P.S. Что-то там не в порядке в отражением от стено...   25.03.2010 5:20
Юзер   Да знаю я что разницы особо нет,но всё же возведен...   25.03.2010 14:21
volvo   Что значит "сразу"? Сразу ничего не быва...   25.03.2010 15:37
Юзер   Разница BP и TP в различном компиляторе вроде.Мне ...   25.03.2010 15:52
volvo   Ошибка 116 - это "Должен быть в режиме 8087...   25.03.2010 16:57
Юзер   Стоит галочка на Emulation в Numeric Processing.Ст...   25.03.2010 17:17
volvo   Запускаешь - вылетает, или компилируешь - Не компи...   25.03.2010 19:26
Юзер   Ctrl+9 запускаю и вылетает из паскаля сразу.До тог...   26.03.2010 4:06
Lapp   Номера версий представляют интерес только для исто...   26.03.2010 6:01
Юзер   Error 207: Invalid floating point operation в прог...   29.03.2010 15:59
Lapp   Подскажите из-зи чего ошибка???Это было бы намного...   30.03.2010 5:53
Юзер   Всё нашел сам,теперь всё пашет.Lapp или volvo подс...   30.03.2010 8:58
volvo   Ну как же не получается? Все получается. Вот так, ...   30.03.2010 15:44


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

 



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