function TPluto2SpriteManger.N_Collision(
const ax, ay:Integer;
const aSprite: TPluto2DSprite;
const aEvent: Boolean;
const aPixelcheck: boolean): TPluto2DSprite;
var
i:Integer;
sp:TPluto2DSprite;
p:TPoint;
r1, r2, r3,r4,r5:TRect;
begin
sp:=nil; p:=Point(ax,ay); r1:=Engine.GameFehld;
r2:=Rect(ax, ay, ax+aSprite.Width, ay+aSprite.Height);
r4:=rect(aSprite.Left,aSprite.Top,aSprite.Width,aSprite.Height);
// Schauen ob die Positions Angabe im Spielb Rect Liegt
if (PtInRect(r1,p))
then begin
for i:=0
to fItems.Count-1
do begin
if (aSprite.guid <> items[i].guid)
then begin
if IntersectRect(r3,items[i].GetR,r2)
then begin
if (
not items[i].NoCollision)
and (items[i].visible)
then begin
if not aPixelcheck
then begin
sp:=Items[i];
break;
end
else begin
r5:=rect(items[i].Left,items[i].Top,items[i].Width,items[i].Height);
if kollision(r4,r5,aSprite.SpriteImage,items[i].SpriteImage)
then begin
sp:=Items[i];
break;
end;
// if kollision(..)
end;
// else begin
end;
// if (not NoCollision)
end;
// if IntersectRect(..)
end;
// if asprite.guid <> items[i].guid
end;
// for i
end;
if (sp <>
NIL)
and (aEvent)
and (Assigned(Engine.onCollision))
then begin
Engine.onCollision(
nil, sp);
end;
result:=sp;
end;
// TPluto2SpriteManger.N_Collision
{
Autor: umpani, Michael Springwald
Update:
Freitag den 25.Janur.2008, Freitag, 01.Febura.2008
Diese Funktion stammt von "umpani" und ist hier zu finden:
[url]http://www.delphi-forum.de/viewtopic.php?t=12746&postdays=0&postorder=asc&start=20[/url]
Ich habe sie "nur" Angepasst für mein zweck. Fragen also bitte an
"umpani" richten im delphi-forum.de.
}
function kollision(r1,r2:TRect;B1,b2:TBitMap):boolean;
var
ueberlapp_breite, ueberlapp_hoehe:integer;
ueberlapp_nr1_x, ueberlapp_nr1_y, ueberlapp_nr2_x, ueberlapp_nr2_y:integer;
x,y:integer;
farbenr1,farbenr2:TColor;
z:Boolean;
begin
z:=False;
if r1.left < r2.left
then
ueberlapp_breite := (r1.left + r1.Right) - (r2.left)
else
ueberlapp_breite := (r2.left + r2.Right) - r1.Left;
if r1.Right > r2.Right
then if ueberlapp_breite >= r2.Right
then ueberlapp_breite := r2.Right;
if r1.top < r2.top
then
ueberlapp_hoehe := (r1.Top + r1.Bottom) - (r2.Top)
else
ueberlapp_hoehe := (r2.Top + r2.Bottom) - (r1.Top);
if r1.Bottom > r2.Bottom
then if ueberlapp_hoehe > r2.Bottom
then ueberlapp_hoehe := r2.Bottom;
if (ueberlapp_breite > 0)
and (ueberlapp_hoehe > 0)
then begin
if r1.Right >= r2.Right
then begin
if (r2.Left+r2.Right) >= (r1.Left+r1.Right)
then begin
ueberlapp_nr1_x := r1.Right - ueberlapp_breite;
ueberlapp_nr2_x := 0;
end;
if ((r2.Left+r2.Right) < (r1.Left+r1.Right))
and (r2.left >= r1.left)
then begin
ueberlapp_nr1_x := (r2.Left-r1.Left);
ueberlapp_nr2_x := 0;
end;
if (r2.Left) < (r1.Left)
then begin
ueberlapp_nr1_x := 0;
ueberlapp_nr2_x := r2.Right - ueberlapp_breite;
end;
end;
end;
if r1.Right < r2.Right
then begin
if (r1.Left+r1.Right) >= (r2.Left+r2.Right)
then begin
ueberlapp_nr2_x := r2.Right - ueberlapp_breite;
ueberlapp_nr1_x := 0;
end;
if ((r1.Left+r1.Right) < (r2.Left+r2.Right))
and (r1.Left >= r2.Left)
then begin
ueberlapp_nr2_x := (r1.Left-r2.Left);
ueberlapp_nr1_x := 0;
end;
if (r1.Left < r2.Left)
then begin
ueberlapp_nr2_x := 0;
ueberlapp_nr1_x := r1.Right - ueberlapp_breite;
end;
end;
if r1.Bottom >= r2.Bottom
then begin
if (r2.Top+r2.Bottom) >= (r1.Top+r1.Bottom)
then begin
ueberlapp_nr1_y := r1.Bottom - ueberlapp_hoehe;
ueberlapp_nr2_y := 0;
end;
if ((r2.Top+r2.Bottom) < (r1.top+r1.Bottom))
and (r2.Top >= r1.Top)
then begin
ueberlapp_nr1_y := (r2.top-r1.top);
ueberlapp_nr2_y := 0;
end;
if (r2.top) < (r1.top)
then begin
ueberlapp_nr1_y := 0;
ueberlapp_nr2_y := r2.Bottom - ueberlapp_hoehe;
end;
end;
if r1.Bottom < r2.Bottom
then begin
if (r1.Top+r1.Bottom) >= (r2.Top+r2.Bottom)
then begin
ueberlapp_nr2_y := r2.Bottom - ueberlapp_hoehe;
ueberlapp_nr1_y := 0;
end;
if ((r1.Top+r1.Bottom) < (r2.Top+r2.Bottom))
and (r1.Top >= r2.Top)
then begin
ueberlapp_nr2_y := (r1.top-r2.top);
ueberlapp_nr1_y := 0;
end;
if (r1.top < r2.top)
then begin
ueberlapp_nr2_y := 0;
ueberlapp_nr1_y := r1.Bottom - ueberlapp_hoehe;
end;
end;
for x := 0
to (ueberlapp_breite-1)
div 2
do begin
for y := 0
to (ueberlapp_hoehe -1)
div 2
do begin
farbenr1 :=B1.Canvas.Pixels[ueberlapp_nr1_x+x*2,ueberlapp_nr1_y+y*2];
farbenr2 :=B2.Canvas.Pixels[ueberlapp_nr2_x+x*2,ueberlapp_nr2_y+y*2];
if ( farbenr1 <> b1.TransparentColor)
and (farbenr2 <> b2.TransparentColor)
then begin
result:=True;
exit;
end;
end;
// for y
end;
// for x
result:=False;
end;
// kollision