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

[Amo]

Hier das nächste finde-den-fehler spielchen ;)

Also ich sollte für meinen unterricht das angehängte Programm machen (Delphi3). Das eigentliche ziel war einfach nur das zusammenstoßen der bälle zu realisieren, doch (obwohl es von den formeln und von den schleifen her alles richtig sein müsste) stoßen sich nicht alle bälle ab. Einige gehen ab und zu noch durch andere durch!

Hier nochmal die unit zur schnellen übersicht:

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);
               end;

  tBall=class x,y,vx,vy,r:Single;
          farbe      :tColor;
          procedure init(fneu:tColor;xneu,yneu,vxneu,vyneu,rneu:Single);
          procedure ZeigeDich;
          procedure BewegeDich;
        end;
const Radius=15;
const max = 10;
var
  Spielfeld: TSpielfeld;
  Ball : array[1..max] of TBall;
  i : integer;

implementation

{$R *.DFM}

procedure tBall.Init(fneu:tColor;xneu,yneu,vxneu,vyneu,rneu:Single);
begin
  farbe:=fNeu;x:=xneu;y:=yneu;vx:=vxneu;vy:=vyneu;r:=rneu;
end;

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

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

procedure TSpielfeld.FormCreate(Sender: TObject);
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;
    Pen.Mode:=pmNOTXOR;
  end;
  for i := 1 to max do
  begin
    Ball[i].Init(clRed,Random(Spielfeld.Bild.Width-2*Radius)+Radius,
                Random(Spielfeld.Bild.Height-2*Radius)+Radius,random(6)-3,
                random(6)-3,Radius);
    Ball[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 Stoss;
var h:single; i,j:integer;
begin
  for i := 1 to max do
  begin
  for j := i+1 to max do
  begin
  if sqrt(sqr(Ball[i].x-Ball[j].x)+sqr(Ball[i].y-Ball[j].y))<=2*Radius then
  begin
    h:=Ball[i].vx;         //vx-Komponenten werden ausgetauscht
    Ball[i].vx:=Ball[j].vx;
    Ball[j].vx:=h;
    h:=Ball[i].vy;         //vy-Komponenten werden ausgetauscht
    Ball[i].vy:=Ball[j].vy;
    Ball[j].vy:=h;
  end;
  end;
  end;
end;

procedure TSpielfeld.Timer1Timer(Sender: TObject);
begin
  {Ball1.ZeigeDich;           //beide Bälle werden an altem Ort gelöscht
  Ball2.ZeigeDich;
  Bild.Canvas.Pixels[Round(Ball1.x),Round(Ball1.y)]:=clBlack;
  Bild.Canvas.Pixels[Round(Ball2.x),Round(Ball2.y)]:=clBlack;
  Ball1.BewegeDich;         //beide Bälle bewegen sich
  Ball2.BewegeDich;
  Stoss;                    //falls sie sich berühren, Geschw.-Austausch
  Ball1.ZeigeDich;          //Bälle werden an neuem Ort gezeichnet
  Ball2.ZeigeDich;}
  for i := 1 to max do
  begin
    Ball[i].ZeigeDich;
    Stoss;
    Ball[i].BewegeDich;
    Ball[i].ZeigeDich;
  end;

end;

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

initialization
  Randomize;
  for i := 1 to max do Ball[i] := TBall.create;

finalization
  for i := 1 to max do Ball[i].destroy;

end.

Ich hoffe ihr könnt mir weiterhelfen!

[jfheins]

Kannst du das Problem noch irgendwie einschränken?

Also z.B. ob der Bug/das Problem in der Kollisionserkennung, oder in der Handhabung liegt ...

Ausserdem: wenn mich nicht alles täuscht, prüfst du sogar ein bisschen zuviel - du brauchst pro Zyklus nur 0.5n*(n+1) oder so ... Überprüfungen (mit sqrt(sqr+sqr)) nicht n² oder mehr, wie du es machst ...

[Gandalfus]

Zitat:

initialization
Randomize;
for i := 1 to max do Ball[i] := TBall.create;

finalization
for i := 1 to max do Ball[i].destroy;

end.

dafür gibt es create und destroy event von deinem Formular.

[Amo]

hm, also das Problem liegt auf jeden fall in der procedure Stoß denk ich.

@jfheins: diese formel haben wir so von dem lehrer bekommen, also behalte ich sie lieber so im code. Aber wenn du sicher bist dass es daran liegt, ändere ich sie aber. könntest du mir dann bitte den code für die zeile 98 zeigen wie du das meinst? ich verstehe deinen denkansatz nicht so wirklich :oops:

@ gandalfus: wie für jfheins, das behalte ich auch lieber so. also ich habe die ganze grundstruktur vom lehrer so bekommen und musste eigentlich nur änderungen im code vornehmen und hier und da nur ein paar schleifen einfügen. (vorher gab es nur 2 bälle und keine array)


ps: in zeile 96 muss es i+1 und nicht i-1 heißen. (habe ich wieder richtig gemacht)

[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 ... :stupid:

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.

[Amo]

Das mit dem unrealistisch abstoßen ist okay. Der lehrer meinte auch die formel wäre sonst viel zu kompliziert und so, also das ist schon okay so!
Aber du hast mir da zu viel geändert, also so könnte ich das niemals im unterricht vortragen ;)

Also im großen und ganzen hast du folgendes an wichtigen änderungen vorgenommen:
-Bewegungs-procedure neu gemacht (wozu eigentlich? die bewegung hat doch wunderbar geklappt?)
-Namen geändert, aber das ist ja eigentlich irrelevant bei dem stoßen^^
-mehr einzelne procedures eingebaut (ist das nicht falsch bei Collide? Result soll boolean sein und du speicherst einen - double-wert<=integer - rein?)
-und wieso hast du einen "Clear" eingeführt und den timer geändert? also ich finds ja so aufwendiger und komplizierter.. :gruebel:

[jfheins]

Könnte es sein, dass ich den Bug entfernt habe, indem ich die Kollisionserkennung aus der Schleife rausgenommen habe?

Also so nach dem Motto dass vorher die Kollision zweimal erkannt wurde und folglich die Geschwindigkeitsvektoren doppelt vertauscht wurden - also im Endeffekt gleich blieben, womit es so aussah, als wenn keine Kollision stattgefunden hätte?

[Amo]

WOOOOOOOOOOW :shock: you got it! :spin2: du hast absolut recht!!! die kollision wurde aus versehen an manchen stellen doppelt durchgeführt und somit schien es so als gäbe es keine!

Also für die Schlussfolgerung:

Ich hätte in der unit im ersten posting die zeile "stoss;" nicht in die for-schleife schreiben dürfen. So muss es also sein:

Delphi-Quellcode:

procedure TSpielfeld.Timer1Timer(Sender: TObject);
begin
  Stoss;
  for i := 1 to max do
  begin
    Ball[i].ZeigeDich;
    Ball[i].BewegeDich;
    Ball[i].ZeigeDich;
  end;
end;

Der ganze rest kann im prinzip so bleiben.


@jfheins: viiiiiielen dank!!! jetzt werd ichs erstmal dem lehrer erklären können, muhahaha.... ;)