Zusammenstoß von 2 Bällen - wo ist der Fehler?

[jfheins]

Also ich hab jetzt mal ein bisschen am Code geändert, und es funktioniert - glaube ich

u solltest allerdings beachten, dass diese art der Simulation nicht sehr realistisch ist - deine Formel für die Geschwindigkeitsäderung gillt nur, wenn die beiden Bälle sich direkt treffen ... wenn sie sich streifen, also gerade berühren, dann wirkt das doch etwas komisch ...

Der neue Code ist:

Delphi-Quellcode:

unit UStoss2; //Stoss zwischen zwei Bällen

interface

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

type
  TSpielfeld = class(TForm)
    Bild: TImage;
    Timer1: TTimer;
    Panel1: TPanel;
    BtEnde: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BtEndeClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
 
  private
    procedure Clear; end;

  TBall = class
  public
    x, y, vx, vy, radius: Single;
    FFarbe: TColor;
    procedure init(fneu: TColor; xneu, yneu, vxneu, vyneu, rneu: Single);
    procedure ZeigeDich;
    procedure BewegeDich;
  end;

const
  Radius = 15;
  Ballcount = 2;

var
  Spielfeld: TSpielfeld;
  BallArray: array[1..Ballcount] of TBall;

implementation

{$R *.DFM}

procedure TBall.Init(fneu: TColor; xneu, yneu, vxneu, vyneu, rneu: Single);
begin
  FFarbe := fNeu;
  x := xneu;
  y := yneu;
  vx := vxneu;
  vy := vyneu;
  radius := rneu;
end;

procedure TBall.ZeigeDich;
begin
  with Spielfeld.Bild.Canvas do
  begin
    brush.Color := FFarbe;
    Ellipse(Round(x - radius), Round(y - radius), Round(x + radius), Round(y + radius));
  end;
end;

procedure TBall.BewegeDich;
begin
  x := x + vx;
  y := y + vy;
  with Spielfeld.Bild do
  begin
    if x > Width - radius - 1 then
    begin
      x := Width - radius - 1;
      vx := -vx;
    end;
    if x < radius + 1 then
    begin
      x := radius + 1;
      vx := -vx;
    end;
    if y > Height - radius - 1 then
    begin
      y := Height - radius - 1;
      vy := -vy;
    end;
    if y < radius + 1 then
    begin
      y := radius + 1;
      vy := -vy;
    end;
  end;
end;

procedure TSpielfeld.FormCreate(Sender: TObject);
var
  i: integer;
begin

  Randomize;

  for i := 1 to Ballcount do
    BallArray[i] := TBall.Create;

  Clear;

  for i := 1 to Ballcount do
  begin
    BallArray[i].Init(clRed, Random(Spielfeld.Bild.Width - 2 * Radius) + Radius,
      Random(Spielfeld.Bild.Height - 2 * Radius) + Radius, random(6) - 3,
      random(6) - 3, Radius);
    BallArray[i].ZeigeDich;
  end;
  { repeat              //Ort von Ball2 wird gewählt: keine Überlappung mit Ball1
     x:=random(Spielfeld.Bild.Width-2*Radius)+Radius;
     y:=random(Spielfeld.Bild.Height-2*Radius)+Radius;
   until sqrt(sqr(x-Ball1.x)+sqr(y-Ball1.y))>2*Radius;
   vx:=random(9)-4;
   vy:=random(9)-4;
   Ball2.init(clGreen,x,y,vx,vy,Radius);
   Ball2.ZeigeDich;  }
end;

procedure TSpielfeld.FormDestroy(Sender: TObject);
var
  i: integer;
begin
  for i := 1 to Ballcount do
    BallArray[i].Free;
end;

function GetDistance(x1, y1, x2, y2: Single) : Double;
begin
  Result := sqrt(sqr(x1 - x2) + sqr(y1 - y2));
end;

function Collide(Ball1, Ball2: TBall) : Boolean;
begin
  Result := GetDistance(Ball1.x, Ball1.y, Ball2.x, Ball2.y) <= (2 * Radius);
end;

procedure CheckCollisions;
var
  h: single;
  i, j: integer;
begin
  for i := 1 to Ballcount - 1 do
  begin
    for j := i + 1 to Ballcount do
    begin
      if Collide(BallArray[i], BallArray[j]) then
      begin
        h := BallArray[i].vx; //vx-Komponenten werden ausgetauscht
        BallArray[i].vx := BallArray[j].vx;
        BallArray[j].vx := h;
        h := BallArray[i].vy; //vy-Komponenten werden ausgetauscht
        BallArray[i].vy := BallArray[j].vy;
        BallArray[j].vy := h;
      end;
    end;
  end;
end;

procedure TSpielfeld.Timer1Timer(Sender: TObject);
var
  i: integer;
begin
  CheckCollisions;

  Clear;
  for i := 1 to Ballcount do
  begin
    BallArray[i].BewegeDich;
    BallArray[i].ZeigeDich;
  end;

end;

procedure TSpielfeld.BtEndeClick(Sender: TObject);
begin
  Close;
end;

procedure TSpielfeld.Clear;
begin
  with Bild.Canvas do
  begin
    Pen.Width := 5;
    Brush.Color := clWhite;
    Rectangle(0, 0, Bild.Width, Bild.Height);
    Pen.width := 2;
    Brush.Style := bsSolid;
  end;
end;

end.