Thema: Delphi [DelphiX] Kollision

Einzelnen Beitrag anzeigen

mimi

Registriert seit: 1. Dez 2002
Ort: Oldenburg(Oldenburg)
2.008 Beiträge
 
FreePascal / Lazarus
 
#5

Re: [DelphiX] Kollision

  Alt 12. Sep 2004, 12: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)
  Mit Zitat antworten Zitat