моделирование движения шаров с массой и диаметромт по прямой в двумерном пространстве

[belomorinka]

Шарик представляет собой сферическое тело массой m и диаметром d. Движется равноускоренно (равномерно, как частный случай равноускоренного движения).
Есть несколько проблем:
1)Каждый шарик должен иметь свою массу и диаметр ( у меня все шарики одинаковые)
2)Задать область движения шариков (ширина и высота формы)
3)Масса,диаметр и ускорение должно генерироваться датчиком случайных чисел

Вот что у у меня получилось: shariki.rar

[belomorinka]

Вот исходник:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

const
// MaxBalls=10;

Colors: array[0..4] of TColor = (clRed, clBlue, clLime, clYellow, clFuchsia);

type
TDirection=(dLeft,dUpleft,dupright, dright,
ddownright,ddownleft,ddown,dup);
TCollisionType = (ctWall, ctBall);

TBall=record
Button1: TButton;
id:byte;
x,y,x1,y1:integer;
lx, ly: integer;
size:byte;
Direction:TDirection;
Speed:byte;
Color:TColor;
BorderColor:TColor;

end;

TForm1 = class(TForm)
Paint: TButton;
Timer1: TTimer;
PaintBox1: TPaintBox;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;

procedure Timer1Timer(Sender: TObject);
procedure PaintClick(Sender: TObject);
procedure FormCreate(Sender: TObject);

private
procedure DrawBalls;
function GetData: boolean;
{ Private declarations }
public
{ Public declarations }

balls:array[1..100] of TBall;
end;

var
Form1: TForm1;
MyBMP:TBitmap;
ball:TBall;
map_width, map_height: word;
//j,i:integer;
MaxBalls:integer;
data_size, data_speed: integer;
//balls:array[1..MaxBalls] of TBall;

[belomorinka]

implementation
{$R *.dfm}
function TForm1.GetData: boolean;
begin
  MaxBalls:=StrToIntDef(Edit1.Text, MaxInt);
  data_size:=StrToIntDef(Edit2.Text, MaxInt);
  data_speed:=StrToIntDef(Edit3.Text, MaxInt);
  result:=(MaxBalls<>MaxInt)and(data_size<>MaxInt)and(data_speed<>MaxInt);
end;

procedure TForm1.DrawBalls;
var
  i: integer;
begin
  with MyBMP.Canvas do
  begin
    Brush.Color:=clWhite;
    FillRect(ClipRect);
  end;
  for I := 1 to MaxBalls do
    with balls[i] do
    begin
      MyBMP.Canvas.Pen.Color:=BorderColor;
      MyBMP.Canvas.Brush.Color:=Color;
      MyBMP.Canvas.ellipse(x-size,y-size,x+size,y+size);
    end;
  PaintBox1.Canvas.Draw(0,0,MyBMP);
end;

procedure TForm1.PaintClick(Sender: TObject);
var
  i,j: integer;
  f: boolean;
//создаем шары
begin
    if not GetData then
    begin
      ShowMessage('Неправильно введены данные! Данные должны быть целым числом.');
      Exit;
    end;
    randomize;
    for I := 1 to MaxBalls do
    with balls[i] do begin
      id:=i;
      size:=data_size;
      direction:=TDirection (random(8) );
      speed:=data_speed;
      color:=colors[Random(5)];
      BorderColor:=clBlack;
      repeat //ставим каждый шар отдельно от других
        f:=true;
        x:=random(471)+data_size;
        y:=random(471)+data_size;
        for j:=1 to i do
          begin
          if i=j then continue;
          if (abs(balls[j].x-balls[i].x)<(data_size*2))and
            (abs(balls[j].y-balls[i].y)<(data_size*2)) then
            begin
              f:=false;
              break;
            end;
          end
      until f;
      x1:=x+40;
      y1:=y+40;
    end;
    Timer1.Enabled:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i,j: integer;
begin
for i:=1 to MaxBalls do
begin
  ball := balls[i];
  ball.lx:=ball.x;
  ball.ly:=ball.y; //предыдущие координаты (для отката, чтобы не сцепились)
  case  Ball.Direction  of
    dLeft: with ball do x:=x-Speed;

    dUpleft: with ball do begin
     x:=x-Speed;
     y:=y-Speed;
    end;

    dupright: with ball do begin
    x:=x+Speed;
    y:=y-Speed;
    end;

    dright: with ball do x:=x+Speed;

    ddownright: with ball do begin
      x:=x+Speed;
      y:=y+Speed;
      end;

    ddownleft: with ball do begin
      x:=x-Speed;
      y:=y+Speed;
      end;

    ddown: with ball do y:=y+Speed;
    dup: with ball do y:=y-Speed;
  end;

    if ball.x<=10 then
    begin
      if( Ball.Direction = dLeft ) Then Ball.Direction:= dright;
      if( Ball.Direction = dUpleft  ) Then Ball.Direction:= dupright;
      if( Ball.Direction = ddownleft  ) Then  Ball.Direction:= ddownright;
    end;

    if ball.y<=10 then
    begin
      if( Ball.Direction = dUpleft ) Then Ball.Direction:= ddownleft;
     if( Ball.Direction = dup ) Then  Ball.Direction:= ddown;
     if( Ball.Direction =  dupright ) Then  Ball.Direction:= ddownright;
    end;

    if ball.x >= (PaintBox1.Width-13) then
    begin
     if( Ball.Direction = dright ) Then  Ball.Direction:= dLeft;
     if( Ball.Direction = ddownright ) Then Ball.Direction:= ddownleft;
     if( Ball.Direction = dupright   ) Then  Ball.Direction:=dUpleft;
     end;

    if ball.y >= (PaintBox1.Height-12) then
    begin
     if( Ball.Direction = ddown ) Then  Ball.Direction:= dup;
     if( Ball.Direction = ddownleft ) Then Ball.Direction:= dUpleft;
     if( Ball.Direction = ddownright ) Then  Ball.Direction:= dupright;
    end;

  //столкновение шаров

    for j:=1 to Maxballs do begin
    if i=j then continue;
    if sqrt(sqr(ball.x-balls[j].x)+sqr(ball.y-balls[j].y))<=2*balls[j].size//+ball.speed
    then
    begin
    ball.x:=ball.lx; //откат шара на шаг назад
    ball.y:=ball.ly;
     case Ball.Direction of
       dLeft: Ball.Direction:= dright;
       dright: Ball.Direction:= dLeft;
       dUpleft: Ball.Direction:= ddownright;
       ddownright: Ball.Direction:= dUpleft;
       dupright: Ball.Direction:= ddownleft;
       ddownleft: Ball.Direction:=  dupright;
       ddown: Ball.Direction:= dup;
       dup: Ball.Direction:= ddown;
     end;
     case Balls[j].Direction of
       dLeft: Balls[j].Direction:= dright;
       dright: Balls[j].Direction:= dLeft;
       dUpleft: Balls[j].Direction:= ddownright;
       ddownright: Balls[j].Direction:= dUpleft;
       dupright: Balls[j].Direction:= ddownleft;
       ddownleft: Balls[j].Direction:=  dupright;
       ddown: Balls[j].Direction:= dup;
       dup: Balls[j].Direction:= ddown;
     end;
    end;
    end;
  ball.lx:=ball.x;
  ball.ly:=ball.y;
  balls[i]:=ball;
end;
DrawBalls;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyBMP:=TBitmap.Create;
  MyBMP.Width:=500;
  MyBMP.Height:=500;
  map_width:=500;
  map_height:=500;
  PaintBox1.Width:=map_width;
  PaintBox1.Height:=map_height;
end;

end.

[belomorinka]

исходники выложил, пока ничего решить с поставленными вопросами не получилось(

[Naive]

1)Каждый шарик должен иметь свою массу и диаметр ( у меня все шарики одинаковые)

procedure TForm1.PaintClick(Sender: TObject);
var
i,j: integer;
f: boolean;
//создаем шары
begin
if not GetData then
begin
ShowMessage('Неправильно введены данные! Данные должны быть целым числом.');
Exit;
end;
randomize;
for I := 1 to MaxBalls do
with balls[i] do begin
id:=i;
size:=data_size;// - если это диметр, то ему присваивается фиксированная величина, как я понял..

поэтому у тебя они одинаковые, где масса, я не понял.. в 6 утра тяжко соображается..
2)Задать область движения шариков (ширина и высота формы)
в таймере у тебя идет проверка на столкновение с границами пэйнтбокза, сделай то же самое с формой, если в этом проблема
или можеш растянуть пэйнтбокз на всю форму
3)Масса,диаметр и ускорение должно генерироваться датчиком случайных чисел
ну это немногим отличается от первого вопроса...
п.с. если что написал не в тему или неправильно понял, сильно не ругайте=)

[belomorinka]

В том и проблема, что я не знаю как использовать массу, поэтому и не вставил ее. Ведь при соударении -шары с разными массами будут вести себя по-разному. Диаметр и масса должны быть рандомны, но у всех разные. По какому закону описать столкновения шариков, чтобы учитывалась их масса?

[Anatole]

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

При ударе шары взаимодействуют с учётом закона сохренения энергии и закона сохранения импульса. Т.е. до и после удара общая энэргия и общий импульс системы остаются постоянными:
m1*v1*v1/2+m2*v2*v2/2=m1*v1'*v1'/2+m2*v2'*v2'/2
и m1*v1+m2*v2=m1*v1'+m2*v2'
При чём, всё это в векторной форме.(проектируется на оси координат и решается для каждой координаты, а потом соответствующим образом сумируется) и без учёта потерь

[belomorinka]

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

unit Unit1;
interface

uses
  Windows, Messages, SysUtils, Forms,  Variants, Dialogs,
  Classes ,Graphics, Controls, StdCtrls, ExtCtrls, Menus;

type
      TBall=record
      Button1: TButton;
      id:byte;
      Color:TColor;
      BorderColor:TColor;

    end;

  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);








  private


  protected
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
  end;

const
      grv=-0.08;   //коф. силы тяжести
      kpr=0.6;   //коф прыгучести
      kot=50;
      col=40;     //колличество шаров

      ot=25;
      otd=10;

type
   shar=record
     rad:integer;   //радиус крурга
     x,y:single;    //координаты центра круга
     nx,ny:single;  //измерения вектора направления
     per:boolean;   //столкнулся ли наш круг
                    //с чем-нибуь в тек. кадр
   end;



var
  frmcube: TForm1;

  sh:array [1..col] of shar;
  i:integer;
  MyBMP:TBitmap;
  tempx:string;
  tempy:string;
  intx:integer;
  inty:integer;
  Form1: TForm1;
  map_width, map_height: word;

 procedure nomalzd(var x,y:single);
 function get_dl_line(x1,y1,x2,y2:single):single;
 procedure reset_bolls;



implementation

{$R *.DFM}
 function get_dl_line(x1,y1,x2,y2:single):single;
 var x,y:single;
 begin
   x:=x2-x1;y:=y2-y1;
   get_dl_line:=sqrt((x*x)+(y*y));
 end;

 procedure nomalzd(var x,y:single);
 var d:single;
 begin
   d:=sqrt((x*x)+(y*y));
   x:=x/d;y:=y/d;
 end;

 procedure reset_bolls;
 var i,a:integer;

 label m1;
 begin
   randomize;
   for i:=1 to col do
   begin
     m1:
     sh[i].rad:=random(ot)+otd;
     sh[i].x:=sh[i].rad+random(frmcube.width  - (sh[i].rad*2)); sh[i].nx:=0;
     sh[i].y:=sh[i].rad+random(frmcube.height - (sh[i].rad*2)); sh[i].ny:=0;
     for a:=1 to col do
     if (a<>i)and(get_dl_line(sh[i].x,sh[i].y,sh[a].x,sh[a].y)<
        (sh[i].rad+sh[a].rad)) then goto m1;
   end;
 end;



procedure TForm1.WMPaint(var Msg: TWMPaint);
var
  ps : TPaintStruct;
  a,b:integer;
  bu,zz,x1,y1:single;
begin

  with MyBMP.Canvas do
  begin
    Brush.Color:=clWhite;
    FillRect(ClipRect);
  end;
  for I := 1 to col do
    with sh[i] do
    begin

    
      tempx:=FloatToStr(x);
      tempy:=FloatToStr(y);
      intx:=StrToInt(tempx);
      inty:=StrToInt(tempy);
      MyBMP.Canvas.Pen.Color:=1;
      MyBMP.Canvas.Brush.Color:=Color;
      MyBMP.Canvas.ellipse(intx-rad,inty-rad,intx+rad,inty+rad);
    end;
  PaintBox1.Canvas.Draw(0,0,MyBMP);

     for i:=1 to col do
     begin

       //Самое главное во всей проге!!! - коллизия шаров :)
       for a:=1   to col-1 do
       for b:=a+1 to col   do
       begin
         bu:=get_dl_line(sh[a].x,sh[a].y,sh[b].x,sh[b].y);
         if bu<(sh[a].rad+sh[b].rad) then
         begin
           bu:=(sh[a].rad+sh[b].rad)-bu;

           x1:=sh[a].x-sh[b].x;
           y1:=sh[a].y-sh[b].y;  nomalzd(x1,y1);
           x1:=x1*bu;            y1:=y1*bu;
           sh[a].nx:=sh[a].nx+(x1/kot);
           sh[a].ny:=sh[a].ny+(y1/kot);

           x1:=sh[b].x-sh[a].x;
           y1:=sh[b].y-sh[a].y;  nomalzd(x1,y1);
           x1:=x1*bu;            y1:=y1*bu;
           sh[b].nx:=sh[b].nx+(x1/kot);
           sh[b].ny:=sh[b].ny+(y1/kot);
         end;
       end;

       sh[i].per:=false;

       if (sh[i].y>clientheight-sh[i].rad) then
       begin
         sh[i].ny:=sh[i].ny+((clientheight-sh[i].rad)-sh[i].y)*kpr;
         sh[i].nx:=(sh[i].nx*kpr); sh[i].per:=true;
       end;

       if (sh[i].y<sh[i].rad) then
       begin
         sh[i].nx:=(sh[i].nx*kpr); sh[i].per:=true;
         sh[i].ny:=sh[i].ny+((sh[i].rad-sh[i].y))*kpr;
       end;

       if (sh[i].x>clientwidth -sh[i].rad) then
       begin
         sh[i].ny:=(sh[i].ny*kpr); sh[i].per:=true;
         sh[i].nx:=sh[i].nx+((clientwidth-sh[i].rad)-sh[i].x)*kpr;
       end;

       if (sh[i].x<sh[i].rad) then
       begin
         sh[i].ny:=(sh[i].ny*kpr); sh[i].per:=true;
         sh[i].nx:=sh[i].nx+((sh[i].rad-sh[i].x))*kpr;
       end;

       sh[i].x:=sh[i].x+sh[i].nx;
       sh[i].y:=sh[i].y+sh[i].ny; sh[i].ny:=sh[i].ny+grv; //смещаем круг

 end;
 end;
 procedure TForm1.FormCreate(Sender: TObject);
begin
  MyBMP:=TBitmap.Create;
  MyBMP.Width:=500;
  MyBMP.Height:=500;
  map_width:=500;
  map_height:=500;
  PaintBox1.Width:=map_width;
  PaintBox1.Height:=map_height;
end;
 end.

[belomorinka]

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

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i,j: integer;
  tmp1: single;
  tmp2: single;
begin
for i:=1 to MaxBalls do
begin
  ball := balls[i];
  ball.lx:=ball.x;
  ball.ly:=ball.y; //предыдущие координаты (для отката, чтобы не сцепились)


    if ((ball.x<=ball.size) or (ball.x >= (PaintBox1.Width-ball.size))) then
    begin
      ball.nx := -ball.nx;
      if(ball.x<=ball.size) then
        ball.x := ball.x +5 else
        ball.x := ball.x -5;
      end;

    if ((ball.y<=ball.size) or (ball.y >= (PaintBox1.Height-ball.size))) then
    begin
      ball.ny := -ball.ny;
      if(ball.y<=ball.size) then
        ball.y := ball.y +5 else
        ball.y := ball.y -5;
      end;


  //столкновение шаров
    try begin
    for j:=1 to Maxballs do begin
    if i=j then continue;
    if (abs(balls[j].x-ball.x)<abs(balls[j].size+ball.size))and
            (abs(balls[j].y-ball.y)<abs(balls[j].size+ball.size))
    then
    begin
    ball.x:=ball.lx; //откат шара на шаг назад
    ball.y:=ball.ly;
    begin
         tmp1 := balls[j].size*balls[j].nx/ball.size;
         tmp2 := ball.size*ball.nx/balls[j].size;
         ball.nx := tmp1;
         balls[j].nx := tmp2;

         tmp1 := balls[j].size*balls[j].ny/ball.size;
         tmp2 := ball.size*ball.ny/balls[j].size;
         ball.ny := tmp1;
         balls[j].ny := tmp2;


       ball.x := ball.x + ball.nx;
       ball.y := ball.y + ball.ny;
       balls[j].x := balls[j].x + balls[j].nx;
       balls[j].y := balls[j].y + balls[j].ny;
    end;
    end;
    end;
   ball.x := ball.x + ball.nx;
   ball.y := ball.y + ball.ny;
   ball.ny := ball.ny + ball.ay;
   ball.nx := ball.nx + ball.ax;
   balls[i]:=ball;
end;
except
on EZeroDivide do ;
on EInvalidOp do end;
DrawBalls;
end;
end;