Registriert seit: 1. Dez 2002
Ort: Oldenburg(Oldenburg)
2.008 Beiträge
FreePascal / Lazarus
|
Re: [DelphiX] Kollision
12. Sep 2004, 13:04
ich habe eine collisions funktion vom delphiForum bekommen, evtl. hilft sie dir ja weiter:
Delphi-Quellcode:
function TDX.kollision(nr1,nr2,nr1x,nr1y,nr2x,nr2y, pat1,pat2:integer):boolean;
var
ueberlapp_breite, ueberlapp_hoehe:integer;
ueberlapp_nr1_x, ueberlapp_nr1_y, ueberlapp_nr2_x,ueberlapp_nr2_y:integer;
x,y:integer;
nr1_breite, nr2_breite, nr1_hoehe, nr2_hoehe:integer;
farbenr1,farbenr2:tcolor;
begin
farbenr1:=clBlack;
farbenr2:=clBlack;
ueberlapp_nr1_x:=-1;
ueberlapp_nr1_Y:=-1;
ueberlapp_nr2_x:=-1;
ueberlapp_nr2_Y:=-1;
if (DXImageList1.Items[nr1].PatternWidth = 0 ) then
begin
nr1_breite := DXImageList1.Items[nr1].Width;
nr1_hoehe := DXImageList1.Items[nr1].Height;
end
else
begin
nr1_breite := DXImageList1.Items[nr1].PatternWidth;
nr1_hoehe := DXImageList1.Items[nr1].PatternHeight;
end;
if (DXImageList1.Items[nr2].PatternWidth = 0 ) then
begin
nr2_breite := DXImageList1.Items[nr2].Width;
nr2_hoehe := DXImageList1.Items[nr2].Height;
end
else
begin
nr2_breite := DXImageList1.Items[nr2].PatternWidth;
nr2_hoehe := DXImageList1.Items[nr2].PatternHeight;
end;
kollision := false;
if nr1x < nr2x then
ueberlapp_breite := (nr1x + nr1_breite) - (nr2x)
else
ueberlapp_breite := (nr2x + nr2_breite) - nr1x;
if nr1_breite > nr2_breite then
if ueberlapp_breite >= nr2_breite then ueberlapp_breite := nr2_breite;
if nr1y < nr2y then
ueberlapp_hoehe := (nr1y + nr1_hoehe) - (nr2y)
else
ueberlapp_hoehe := (nr2y + nr2_hoehe) - (nr1y);
if nr1_hoehe > nr2_hoehe then
if ueberlapp_hoehe > nr2_hoehe then ueberlapp_hoehe := nr2_hoehe;
if (ueberlapp_breite > 0) and (ueberlapp_hoehe > 0) then
begin
if nr1_breite >= nr2_breite then
begin
if (nr2x+nr2_breite) >= (nr1x+nr1_breite) then
begin
ueberlapp_nr1_x := nr1_breite - ueberlapp_breite;
ueberlapp_nr2_x := 0;
end;
if ((nr2x+nr2_breite) < (nr1x+nr1_breite))
and (nr2x >= nr1x)then
begin
ueberlapp_nr1_x := (nr2x-nr1x);
ueberlapp_nr2_x := 0;
end;
if (nr2x) < (nr1x) then
begin
ueberlapp_nr1_x := 0;
ueberlapp_nr2_x := nr2_breite - ueberlapp_breite;
end;
end;
if nr1_breite < nr2_breite then
begin
if (nr1x+nr1_breite) >= (nr2x+nr2_breite) then
begin
ueberlapp_nr2_x := nr2_breite - ueberlapp_breite;
ueberlapp_nr1_x := 0;
end;
if ((nr1x+nr1_breite) < (nr2x+nr2_breite))
and (nr1x >= nr2x)then
begin
ueberlapp_nr2_x := (nr1x-nr2x);
ueberlapp_nr1_x := 0;
end;
if (nr1x < nr2x)then
begin
ueberlapp_nr2_x := 0;
ueberlapp_nr1_x := nr1_breite - ueberlapp_breite;
end;
end;
if nr1_hoehe >= nr2_hoehe then
begin
if (nr2y+nr2_hoehe) >= (nr1y+nr1_hoehe) then
begin
ueberlapp_nr1_y := nr1_hoehe - ueberlapp_hoehe;
ueberlapp_nr2_y := 0;
end;
if ((nr2y+nr2_hoehe) < (nr1y+nr1_hoehe))
and (nr2y >= nr1y)then
begin
ueberlapp_nr1_y := (nr2y-nr1y);
ueberlapp_nr2_y := 0;
end;
if (nr2y) < (nr1y) then
begin
ueberlapp_nr1_y := 0;
ueberlapp_nr2_y := nr2_hoehe - ueberlapp_hoehe;
end;
end;
if nr1_hoehe < nr2_hoehe then
begin
if (nr1y+nr1_hoehe) >= (nr2y+nr2_hoehe) then
begin
ueberlapp_nr2_y := nr2_hoehe - ueberlapp_hoehe;
ueberlapp_nr1_y := 0;
end;
if ((nr1y+nr1_hoehe) < (nr2y+nr2_hoehe))
and (nr1y >= nr2y)then
begin
ueberlapp_nr2_y := (nr1y-nr2y);
ueberlapp_nr1_y := 0;
end;
if (nr1y < nr2y)then
begin
ueberlapp_nr2_y := 0;
ueberlapp_nr1_y := nr1_hoehe - ueberlapp_hoehe;
end;
end;
for x := 0 to (ueberlapp_breite-1) div 4 do
for y := 0 to (ueberlapp_hoehe -1)div 4 do begin
if (pat1 = 0) and (DXImageList1.Items[nr1].PatternWidth = 0 ) then begin
farbenr1:=DXImageList1.Items[nr1].picture.Bitmap.Canvas.Pixels[ueberlapp_nr1_x+x*4,ueberlapp_nr1_y+y*2];
end;
if (pat2 = 0) and (DXImageList1.Items[nr2].PatternWidth = 0 )then begin
farbenr2:=DXImageList1.Items[nr2].picture.Bitmap.Canvas.Pixels[ueberlapp_nr2_x+x*4,ueberlapp_nr2_y+y*2];
end;
if (pat1 >= 0) and (DXImageList1.Items[nr1].PatternWidth > 0 ) then begin
farbenr1:=DXImageList1.Items[nr1].PatternSurfaces[pat1].Canvas.Pixels[ueberlapp_nr1_x+x*4,ueberlapp_nr1_y+y*2];
end;
if (pat2 >= 0) and (DXImageList1.Items[nr2].PatternWidth > 0 ) then begin
farbenr2:=DXImageList1.Items[nr2].PatternSurfaces[pat2].Canvas.Pixels[ueberlapp_nr2_x+x*4,ueberlapp_nr2_y+y*2];
end;
if ( farbenr1 <> DXImageList1.Items[nr1].TransparentColor) and (farbenr2 <> DXImageList1.Items[nr2].TransparentColor) then
kollision := true;
end;
DXImageList1.Items[nr1].Restore;
DXImageList1.Items[nr2].Restore;
end;
end;
musst du noch anpassen dann sollte es gehen.... aber du musst immer schauen ob sich das objekt hintern den objekten befindet oder vordem objekt *G*
Michael Springwald MFG
Michael Springwald,
Bitte nur Deutsche Links angeben Danke (benutzte überwiegend Lazarus)
|
|
Zitat
|