Движение качающихся n шариков на нитях разной длины

@filosofiyachuda · Регистрация: 24.12.2009

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

Движение качающихся n шариков на нитях разной длины. (n<10)
Может было у кого нибудь что то подобное?

@filosofiyachuda · 08.06.2010, 00:16 **[ТС]**

А может кто нибудь к этой задаче комментарии написать?
очень туго именно с динамикой

благодарна заранее

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Program Shar;
Uses Graph, Crt;
Type tSharik=record
          radius: integer;
          cvet: byte;
          dlina: integer;
          koord_x: integer;
          ugol: real;
          naprav: integer;
          x,y: integer;
end;
Const Skorost=4;
Var N: integer;
       shariki: array[1..100] of tSharik;
 
 
Procedure Narisovat(sharik:tSharik; vidim:boolean);
Var c,c2:byte;
Begin
     if vidim then c:=sharik.cvet else c:=getbkcolor;
     if vidim then c2:=8 else c2:=getbkcolor;
     setcolor(c2);
     line(sharik.koord_x, 0, sharik.x, sharik.y);
     setcolor(c);
     setfillstyle(1,c);
     pieslice(sharik.x, sharik.y, 0, 360, sharik.radius);
     setcolor(c2);
     circle(sharik.x, sharik.y, sharik.radius);
End;
 
 
Procedure Dvigat(var sharik:tSharik);
var rasst: real;
       j: integer;
Begin
     with sharik do
     begin
          ugol:= ugol+naprav*skorost/dlina;
          x:= round( koord_x + (dlina+radius) * sin(ugol) );
          y:= round( (dlina+radius) * cos(ugol) );
          if y<=radius then naprav:=-naprav;
          for j:=1 to N do
          begin
               rasst:= sqrt( sqr(longint(shariki[j].x)-longint(x))
                              + sqr(longint(shariki[j].y)-longint(y)) );
               if (rasst<= radius+shariki[j].radius) and (rasst>radius/2) then
               begin
                    if x<shariki[j].x then naprav:=-1 else naprav:=+1;
                    shariki[j].naprav:= -naprav;
               end;
          end;
     end;
End;
 
 
Var d,m: integer;
        i: integer;
       sharik: tSharik;
Begin
     writeln('Введите количество шариков:');
     readln(N); 
     d:=0; m:=2;
     initgraph(d,m,'');
     setbkcolor(7);
     randomize;
     for i:=1 to N do
     begin
          with shariki[i] do begin
               radius:= 10+random(25);
               dlina:= 50+random(150);
               koord_x:= (640 div (N+1)) * i;
               cvet:= 1+random(15);
               ugol:=0;
               naprav:=+1;
               if cvet=getbkcolor then cvet:=15;
          end;
     end;
 
     repeat
          for i:=1 to N do
          begin
               sharik:=shariki[i];
               Narisovat(sharik,false);
               Dvigat(sharik);
               Narisovat(sharik,true);
               shariki[i]:=sharik;
          end;
          delay(8000);
     until keypressed;
     readkey;
End.

@Puporev · 08.06.2010, 08:38

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
Program Shar;
Uses Graph, Crt;
Type tSharik=record {объявим тип запись - шарик, с полями}
             radius: integer;{радиус шара}
             cvet: byte;{цвет}
             dlina: integer;{длина шнура}
             koord_x: integer;{координата х точки подвеса}
             ugol: real;{угол от вертикальной оси}
             naprav: integer;{}
             x,y: integer;{текущие координаты центра шарика}
            end;
Const Skorost=4;{константа, регулирующая скорость колебаний, можно поменять, 
                 или вообще задавать самому}
Var N: integer;{кол. шариков}
    shariki: array[1..100] of tSharik;{массив шариков}
 
{процедура прорисовки шарика с нитью, 
входные параметры - данные о шарике и что делать(рисовать, стирать)} 
Procedure Narisovat(sharik:tSharik; vidim:boolean);
Var c,c2:byte;
Begin
if vidim then c:=sharik.cvet else c:=getbkcolor;{если рисовать, то цвет шарика, 
                                                 если стирать, то цвет фона}
if vidim then c2:=8 else c2:=getbkcolor;{тоже для нити, или темно-серый, или цвет фона}
setcolor(c2);{цвет нити}
line(sharik.koord_x, 0, sharik.x, sharik.y);{нить - линия}
setcolor(c);{цвет шарика}
setfillstyle(1,c);{стиль - сплошное заполнение этим цветом}
pieslice(sharik.x, sharik.y, 0, 360, sharik.radius);{закрашенный полный сектор(круг)}
setcolor(c2);{цвет нити}
circle(sharik.x, sharik.y, sharik.radius);{окружность - граница шарика}
End;
 
{процедура смещения - колебания шарика} 
Procedure Dvigat(var sharik:tSharik);
var rasst: real;
       j: integer;
Begin
with sharik do{пока 1 шарик}
 begin
  ugol:= ugol+naprav*skorost/dlina;{вычисляем угол}
  {вычисляем текущие координаты центра}
  x:= round( koord_x + (dlina+radius) * sin(ugol) );
  y:= round( (dlina+radius) * cos(ugol) );
  {определяем положение шарика по вертикали}
  if y<=radius then naprav:=-naprav;{если коснулись верхней границы экрана(она одна для всех 
                                     шариков), меняем направление на обратное}
  for j:=1 to N do{перебираем все шарики}
   begin
   {определяем расстояние шарика до всех других, переменные типа integer приводим к типу Longint, 
     иначе квадраты координат выйдут за объявленный тип}
    rasst:=sqrt(sqr(longint(shariki[j].x)-longint(x))+sqr(longint(shariki[j].y)-longint(y)) );
    if (rasst<= radius+shariki[j].radius) and (rasst>radius/2) then{если коснулись}
     begin
      if x<shariki[j].x then naprav:=-1 else naprav:=+1;{шарик слева, направление -1, справа +1}
      shariki[j].naprav:= -naprav;{меняем направление после соприкосновения}
     end;
   end;
 end;
End;
 
 
Var d,m: integer;
    i: integer;
    sharik: tSharik;
Begin
writeln('Kolichestvo sharikov:  ');
readln(N);
d:=0; m:=2;{выбираем графический режим, m можно не указывать}
initgraph(d,m,'');{инициализируем его}
setbkcolor(7);{устанавливаем светло-серый цвет фона}
randomize;{генератор случайных чисел}
for i:=1 to N do{по количеству шаров}
 begin
  with shariki[i] do{задаем параметры очередного шарика}
   begin
    radius:= 10+random(25);{радиус}
    dlina:= 50+random(150);{длина нити}
    koord_x:= (640 div (N+1)) * i;{точка крепления нити у верхней шраницы экрана}
    cvet:= 1+random(15);{цвет от 1 до 15}
    ugol:=0;{начальный угол с вертикальной осью}
    naprav:=+1;{напрвление вправо}
    if cvet=getbkcolor then cvet:=15;{если выпал цвет фона, меняем его на белый}
   end;
 end;
repeat{собственно цикл рисования колеблющихся шариков}
 for i:=1 to N do{все шарики}
  begin
   sharik:=shariki[i];{запоминаем в переменную - буфер параметры очередного шарика}
   Narisovat(sharik,false);{рисуем цветом фона - стираем}
   Dvigat(sharik);{меняем положение}
   Narisovat(sharik,true);{рисуем своим цветом}
   shariki[i]:=sharik;{берем значение из буфера обратно}
  end;
 delay(10);{задержка 10 млс для нормальных модулей .tpl, в оригинале кривые модули, поэтому 80000}
until keypressed;{нажатие любой клавиши - выход из программы}
End.

@filosofiyachuda · 08.06.2010, 14:15 **[ТС]**

А еще...

помогите пожалуйста... есть until keypressed, но не выходит(( серый фон...

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
Uses Graph, Crt;
Const Skorost=3;
Type tSharik=record
     radius: integer;
     cvet: byte;
     dlina: integer;
     koord_x: integer;
     ugol: real;
     naprav: integer;
     x,y: integer;
End;
Var K:integer;
    shariki: array[1..20] of tSharik;
    d,m: integer;
    i: integer;
    sharik: tSharik;
    f:text;
    s:string;
 
Procedure Start;
Procedure Narisovat(sharik:tSharik; vidim:boolean);
Var c,c2:byte;
Begin
     if vidim then c:=sharik.cvet else c:=getbkcolor;
     if vidim then c2:=8 else c2:=getbkcolor;
     setcolor(c2);
     line(sharik.koord_x, 0, sharik.x, sharik.y);
     setcolor(c);
     setfillstyle(1,c);
     pieslice(sharik.x, sharik.y, 0, 360, sharik.radius);
     setcolor(c2);
     circle(sharik.x, sharik.y, sharik.radius);
End;
 
 
Procedure Dvigat(var sharik:tSharik);
var rasst: real;
    j: integer;
Begin
     with sharik do
     begin
          ugol:= ugol+naprav*skorost/dlina;
          x:= round( koord_x + (dlina+radius) * sin(ugol) );
          y:= round( (dlina+radius) * cos(ugol) );
          if y<=radius then naprav:=-naprav;
          for j:=1 to K do
          begin
               rasst:= sqrt( sqr(longint(shariki[j].x)-longint(x))
                              + sqr(longint(shariki[j].y)-longint(y)) );
               if (rasst<= radius+shariki[j].radius) and (rasst>radius/2) then
               begin
                    if x<shariki[j].x then naprav:=-1 else naprav:=+1;
                    shariki[j].naprav:= -naprav;
               end;
          end;
     end;
End;
 
Begin
     writeln('‚ўҐ¤ЁвҐ Є®«ЁзҐбвў® и*аЁЄ®ў:');
     readln(K);
     d:=0; m:=2;
     initgraph(d,m,'');
     setbkcolor(7);
     randomize;
     for i:=1 to K do
     begin
          with shariki[i] do begin
               radius:= 10+random(25);
               dlina:= 50+random(150);
               koord_x:= (640 div (K+1)) * i;
               cvet:= 1+random(15);
               ugol:=0;
               naprav:=+1;
               if cvet=getbkcolor then cvet:=15;
          end;
     end;
 
     repeat
          for i:=1 to K do
          begin
               sharik:=shariki[i];
               Narisovat(sharik,false);
               Dvigat(sharik);
               Narisovat(sharik,true);
               shariki[i]:=sharik;
          end;
          delay(3000);
     until keypressed;
     readkey;
End;
 
 
Procedure Instr;
Begin
  assign(f,'Instruk.txt');
  reset(f);
  while not eof(f) do
    begin
     readln(f,s);
     writeln(s);
    end;
End;
 
 
Procedure ramka(x1,y1,x2,y2:integer);
Var i:byte;
  Begin
    ClrScr;
    GotoXY(x1,y1); write('Й');
    for i:=x1+1 to x2-1 do
      begin
      GotoXY(i,y1); write('Н');
      GotoXY(i,y2); write('Н');
      end;
      GotoXY(x2,y1); write('»');
      GotoXY(x1,y2); write('И');
      GotoXY(x2,y2); write('ј');
       for i:=y1+1 to y2-1 do
        begin
        GotoXY(x1,i); write('є');
        GotoXY(x2,i); write('є');
        end;
    End;
 
Function Menu:byte;
Var i,newmenu,oldmenu,n:integer; ch:char;
Const m: array[1..3] of string=('‘в*ав','?*бвагЄжЁп','‚ле®¤');
  Begin
  ramka(29,9,51,14);
  Window(30,10,50,13); TextBackGround(5); ClrScr;
  for i:=1 to 3 do
    begin
    GotoXY(1,i);
    write(m[i]);
    end;
      GotoXY(1,1);
      TextBackGround(2);
      write(m[1]);
      ClrEol;
        newmenu:=1; oldmenu:=1;
        repeat
        ch:=readkey;
        if ch=#0 then begin
                      ch:=readkey;
                        case ch of
                        #72: if oldmenu=1 then newmenu:=3 else newmenu:=oldmenu-1;
                        #80: if oldmenu=3 then newmenu:=1 else newmenu:=oldmenu+1;
                        end;
                      TextBackGround(5); GotoXY(1,oldmenu); write(m[oldmenu]); ClrEol;
                      TextBackGround(2); GotoXY(1,newmenu); write(m[newmenu]); ClrEol;
                      oldmenu:=newmenu;
                      end;
        Until ch=#13;
        menu:=newmenu;
        end;
var n:byte;
Begin
      repeat
      n:=menu;
      window(1,1,80,25); TextBackGround(0); ClrScr;
      case n of
      1: Start;
      2: Instr;
      end;
      Until n=3;
end.
  End;

@Puporev · 08.06.2010, 15:40

filosofiyachuda, Так Вы хоть гляньте ради приличия тот код который я написал, там не только комментарии, но и исправления есть, типа такого

Pascal
1
2
 until keypressed;
     readkey;

там нет. Зачем 2 раза ждать нажатия клавиши?

@filosofiyachuda · 08.06.2010, 20:41 **[ТС]**

спасибо огромное за помощь.. но я чуть о другом... ну да ладно, не суть...

буду совсем занудой... сижу весь день как блондинка... Кто-нибудь может помочь с блок-схемой? хотела через программу, но она не захотела импортировать файл... с этими процедурами заморочка... и глупо по-моему... графику в блок схемах наверно не указывают...

@Puporev · 08.06.2010, 20:50

Не знаю, у меня редактор нормально рисует.

Новые блоги и статьи Все статьи Все блоги /
http://iceja.net/ математические сервисы iceja 20.01.2026 Обновила свой сайт http:/ / iceja. net/ , приделала Fast Fourier Transform экстраполяцию сигналов. Однако предсказывает далеко не каждый сигнал (см ограничения http:/ / iceja. net/ fourier/ docs ). Также. . .	http://iceja.net/ сервер решения полиномов iceja 18.01.2026 Выкатила http:/ / iceja. net/ сервер решения полиномов (находит действительные корни полиномов методом Штурма). На сайте документация по API, но скажу прямо VPS слабенький и 200 000 полиномов. . .	Расчёт переходных процессов в цепи постоянного тока igorrr37 16.01.2026 / * Дана цепь постоянного тока с R, L, C, k(ключ), U, E, J. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа, решает её и находит переходные токи и напряжения на элементах схемы. . . .	Восстановить юзерскрипты Greasemonkey из бэкапа браузера damix 15.01.2026 Если восстановить из бэкапа профиль Firefox после переустановки винды, то список юзерскриптов в Greasemonkey будет пустым. Но восстановить их можно так. Для этого понадобится консольная утилита. . .
Сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/	WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .	Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .	Почему дизайн решает? Neotwalker 09.01.2026 В современном мире, где конкуренция за внимание потребителя достигла пика, дизайн становится мощным инструментом для успеха бренда. Это не просто красивый внешний вид продукта или сайта — это. . .

@filosofiyachuda 0 / 0 / 0 Регистрация: 24.12.2009 Сообщений: 36

	Движение качающихся n шариков на нитях разной длины 01.06.2010, 20:47. Показов 2496. Ответов 6 Метки нет (Все метки) Движение качающихся n шариков на нитях разной длины. (n<10) Может было у кого нибудь что то подобное? 0

@filosofiyachuda 0 / 0 / 0 Регистрация: 24.12.2009 Сообщений: 36
	08.06.2010, 20:41 [ТС]
	спасибо огромное за помощь.. но я чуть о другом... ну да ладно, не суть... буду совсем занудой... сижу весь день как блондинка... Кто-нибудь может помочь с блок-схемой? хотела через программу, но она не захотела импортировать файл... с этими процедурами заморочка... и глупо по-моему... графику в блок схемах наверно не указывают... 0