Einzelnen Beitrag anzeigen

Amo

Registriert seit: 26. Okt 2005
82 Beiträge
 
Delphi 7 Enterprise
 
#1

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

  Alt 8. Mai 2007, 19:00
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!
Angehängte Dateien
Dateityp: zip sto__231.zip (119,3 KB, 5x aufgerufen)
  Mit Zitat antworten Zitat