Pixelgenaue Kollision Abfrage mit Bitmaske

[Sfaizst]

Hallo, tschuldigt, das ich ein solch altes Thema wieder aus der Erde grabe, jedoch habe ich festgestellt, dass die collision nicht mehr richtig funktioniert, wenn ich den create Teil nicht mehr im Timer habe.
Auch nach rumprobieren wie sonst was habe ich bisher noch keine (brauchbare) Lösung gefunden, zudem habe ich die Klasse ein wenig erweitert (Grundfunktionen wie collision nicht geändert), der fehler tritt jedoch beim original sowie bei meiner erweiterung auf (wenn das create der Klasse nicht im Timer ist)

Bsp der fehlerhaften Kollision: Project22.exe

Ich hoffe, ihr könnt mir eine Hilfe geben, woran dies liegen könnte, ich meine, wenn die collision nur funktioniert, wenn create davor aufgerufen wird, muss doch irgendeine variable in der collision geändert werden (oder bin ich auf dem holzpfad?) und wenn, welche variable(n)?

Meine Erweiterung der Klasse:

Delphi-Quellcode:

{************************************************************}
{                                                            }
{   Pixelgenaue Kollision Abfrage mit Bitmaske               }
{                                                            }
{   Copyright (c) 2007 Henning Brackmann  [url]www.blubplayer.de[/url]  }
{   Erweiterung der Klasse von Sfaizst                       }
{************************************************************}

unit U_KollisionAbfrage;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TBitMask = class
  private
    FMaske: array of array of Cardinal;
    FSegmentSize,//Segment der Maske in Bit
    Fwidth, Fheight,
    FwidthSegmentCount: integer;
    procedure initMask;
  public
    property Width : Integer read FWidth write FWidth;
    property Height : Integer read FHeight write FHeight;
    procedure LoadFromGraphic(aBild: TBitmap);
    procedure LoadFromStream(MS : TStream);
    procedure LoadFromStreamEx(MS : TMemoryStream);
    procedure SaveToStream(MS : TStream);
    procedure SaveToStreamEx(MS : TMemoryStream);
    function Collision(x1, y1, x2, y2: integer; BitMask2: TBitMask): boolean;
  end;

  TBitMaskArray = class
  private
    FSize : Integer;
  public
    Masks : Array of TBitMask;
    property Size : Integer read FSize write FSize;
    procedure LoadFromGraphic(aBild: TBitmap);
    procedure LoadFromStream(MS : TStream);
    procedure LoadFromStreamEx(MS : TMemoryStream);
    procedure SaveToStream(MS : TStream);
    procedure SaveToStreamEx(MS : TMemoryStream);
  end;

implementation

function RectinRect(rect1,rect2: Trect): boolean;
begin
  result := true;
  if (rect1.Left >= rect2.BottomRight.x) then result:=false;
  if (rect1.top >= rect2.BottomRight.y) then result:=false;
  if (rect2.Left >= rect1.BottomRight.x) then result:=false;
  if (rect2.top >= rect1.BottomRight.y) then result:=false;
end;

{ TBitMask }

procedure TBitMask.initMask;
var
  tempWidth,tempHeight: integer;
  x,y: integer;
begin
  FSegmentSize := sizeof(Cardinal)*8;
  //Unterscheidung ob Rest oder nicht
  //Bei Rest würde sonst Addition von 1 falsches Ergebnis ergeben
  if (FWidth mod FSegmentSize) = 0 then
    tempWidth := FWidth div FSegmentSize
  else
    tempWidth := trunc(FWidth/FSegmentSize)+1;

  FwidthSegmentCount := tempWidth;
  tempHeight := FHeight;
  setlength(FMaske,tempWidth,tempHeight);
  for x := 0 to tempWidth - 1 do
    for y := 0 to tempHeight - 1 do
      FMaske[x,y]:=0;

end;

procedure TBitMask.LoadFromGraphic(aBild: TBitmap);
type
  PixArray = Array [1..3] of byte;
var
  p: ^PixArray;
  x,y: integer;
  Color: longint;
  Bild: TBitmap;
  Segment: Cardinal;
begin
  Fwidth := aBild.width;
  Fheight := aBild.Height;
  initMask;
  Bild:= TBitmap.create;
  Bild.Assign(aBild);
  aBild.PixelFormat := pf24bit;
   //Reihenfolge (Scanline) der Farbwerte pro Pixel: Blau - Grün - Rot.

  Color:=ColortoRGB(aBild.TransparentColor);
  for y:=0 to bild.Height-1 do
  begin
    p:= bild.ScanLine[y];
    for x:=bild.Width-1 downto 0 do  //downto wegen or 1 und nicht and 100000...
    begin
      Segment := FMaske[FwidthSegmentCount-1 - (x div FSegmentSize),y];
      if (GetBValue(Color)=p^[1]) and (GetGValue(Color)=p^[2]) and (GetRValue(Color)=p^[3])  then
      begin
        //transparentefarbe --> 0
       Segment := Segment shl 1;
      end
      else
      begin
        //nicht transparentefarbe --> 1
        Segment := Segment shl 1;
        Segment := Segment or 1;
      end;
      FMaske[FwidthSegmentCount-1 - (x div FSegmentSize),y] := Segment;
      Inc(p);
    end;
  end;

  Bild.free;
end;


procedure TBitMask.LoadFromStreamEx(MS: TMemoryStream);
var x,y : Integer;
begin
  InitMask;
  for x := 0 to High(FMaske) do
    for y := 0 to High(FMaske[x]) do
      MS.ReadBuffer(FMaske[x,y],sizeof(Cardinal));
end;

procedure TBitMask.LoadFromStream(MS: TStream);
var
 TmpMs : TMemoryStream;
begin
  TmpMs := TMemoryStream.Create;
  try
    MS.Position := 0;
    TmpMs.CopyFrom(MS,MS.Size);
    TmpMs.Position := 0;
    TmpMs.ReadBuffer(FWidth,sizeof(Integer));
    TmpMs.ReadBuffer(FHeight,sizeof(Integer));
    LoadFromStreamEx(TmpMS);
    MS.Position := 0;
  finally
    TmpMS.Free;
  end;
end;

procedure TBitMask.SaveToStreamEx(MS: TMemoryStream);
var x,y : Integer;
begin
  for x := 0 to High(FMaske) do
    for y := 0 to High(FMaske[x]) do
      MS.WriteBuffer(FMaske[x,y],sizeof(Cardinal));
end;

procedure TBitMask.SaveToStream(MS: TStream);
var
 TmpMS : TMemoryStream;
begin
  TmpMS := TMemoryStream.Create;
  try
    TmpMs.WriteBuffer(FWidth,sizeof(Integer));
    TmpMs.WriteBuffer(FHeight,sizeof(Integer));
    SaveToStreamEx(TmpMS);
    Ms.Position := 0;
    MS.CopyFrom(TmpMs,TmpMs.Size);
    Ms.Position := 0;
  finally
    TmpMS.Free;
  end;
end;

function TBitMask.Collision(x1,y1: integer; x2,y2: integer; BitMask2: TBitMask): boolean;
var
  y1start,y1ende: integer;
  y2start,y2ende: integer;
  x1SegmentStart,x1SegmentEnde: integer;
  x2SegmentStart,x2SegmentEnde: integer;

  tempSegment: Cardinal;
  x,y: integer;
  shiftcountRight: integer;
  shiftcountLeft: integer;
  indexLeftBild1Segment: integer;
  indexRightBild1Segment: integer;
  Bild1CalcWidth,Bild2CalcWidth: integer;

  SchnittRect: TRect;
  Bild1SchnittRect: TRect;
  Bild2SchnittRect: TRect;
begin
  if RectinRect(Rect(x1,y1,x1+Fwidth,y1+Fheight),Rect(x2,y2,x2+BitMask2.Fwidth,y2+BitMask2.Fheight)) then
  begin

    //Koordinaten umrechnen durch die einteilung in elemnet
    //ist Bildbreite immer vielfaches von 32 Also muss Von der normalen breite
    //umgerechnet werden
    x1:=x1-(FwidthSegmentCount*FSegmentSize-FWidth);
    x2:=x2-(BitMask2.FwidthSegmentCount*FSegmentSize-BitMask2.FWidth);

    //Breite umrechnen
    Bild1CalcWidth := self.FwidthSegmentCount*FSegmentSize;
    Bild2CalcWidth := BitMask2.FwidthSegmentCount*FSegmentSize;


    IntersectRect(SchnittRect,Rect(x1,y1,x1+Bild1CalcWidth,y1+Fheight),Rect(x2,y2,x2+Bild2CalcWidth,y2+BitMask2.Fheight));
    Bild1SchnittRect := Rect(SchnittRect.Left-x1,SchnittRect.Top-y1,SchnittRect.Right-x1-1,SchnittRect.Bottom-y1-1);
    Bild2SchnittRect := Rect(SchnittRect.Left-x2,SchnittRect.Top-y2,SchnittRect.Right-x2-1,SchnittRect.Bottom-y2-1);

    y1start := Bild1SchnittRect.top;
    y1ende := Bild1SchnittRect.bottom;
    y2start := Bild2SchnittRect.top;
    y2ende := Bild2SchnittRect.bottom;

    x1SegmentStart := Bild1SchnittRect.Left div FSegmentsize;
    x1SegmentEnde := Bild1SchnittRect.Right div FSegmentsize;
    x2SegmentStart := Bild2SchnittRect.Left div FSegmentsize;
    x2SegmentEnde := Bild2SchnittRect.Right div FSegmentsize;

    shiftcountRight := (Bild2CalcWidth+(x2-x1)) mod FSegmentsize;
    shiftcountLeft := FSegmentsize-shiftcountRight;

    result := false;
    for x := x2SegmentStart to x2SegmentEnde do
    begin
      if (x2+x*FSegmentsize)>=(x1+x1SegmentStart*FSegmentsize) then
      begin  //Es gibt links vom Element ein Bild1 element
        indexLeftBild1Segment := (x2+(x)*FSegmentsize-x1) div FSegmentsize;
        for y := y2start to y2ende do
        begin
          tempSegment := (BitMask2.Fmaske[x,y] shr shiftcountRight);
          if (FMaske[indexLeftBild1Segment,y1start+y-y2start] and tempSegment)<>0 then
          begin
            result:=true;
            exit;
          end;
        end;
      end;

      if (x2+x*FSegmentsize)<=(x1+x1SegmentEnde*FSegmentsize) then
      begin  //Es gibt rechts vom Element ein Bild1 element
        indexRightBild1Segment := ((x2-1-x1+FSegmentSize+(x*FSegmentsize)) div FSegmentsize);
        for y := y2start to y2ende do
        begin
          tempSegment := (BitMask2.Fmaske[x,y] shl shiftcountLeft);
          if (FMaske[indexRightBild1Segment,y1start+y-y2start] and tempSegment)<>0 then
          begin
            result:=true;
            exit;
          end;
        end;
      end;

    end;

  end;
end;

{ TBitMaskArray }

procedure TBitMaskArray.LoadFromGraphic(aBild: TBitmap);
var
  TmpBild : tBitmap;
  I, TilePosX, TilePosY : Integer;
begin
  if FSize = 0 then fSize := 32;
  TmpBild := TBitmap.Create;
  TmpBild.Width := fSize;
  TmpBild.Height := fSize;
  SetLength(Masks,(aBild.Height * aBild.Width) div FSize);
         for I := 0 to ((aBild.Height * aBild.Width) div FSize)-1 do
          begin
          if I = 0 then
             begin
               TilePosX := 0;
               TilePosY := 0;
             end Else
             begin
          if TilePosX < (aBild.Width div FSize) -1 then
             Inc(TilePosX) Else
             begin
               TilePosX := 0;
               Inc(TilePosY);
             end;
             end;
             TmpBild.Canvas.CopyRect(Rect(0, 0, TmpBild.Width, TmpBild.Height), aBild.Canvas, Rect(TilePosX*FSize,TilePosY+FSize,(TilePosX+1)*fSize,(TilePosY+1)*FSize));
             Masks[I] := TBitMask.Create;
             with Masks[I] do
               begin
                 Width := fSize;
                 Height := fSize;
                 LoadFromGraphic(TmpBild);
               end;
    end;
end;

procedure TBitMaskArray.LoadFromStreamEx(MS: TMemoryStream);
var I : Integer;
begin
  if FSize = 0 then fSize := 32;
  for I := 0 to High(Masks) do
    begin
      Masks[I] := TBitMask.Create;
      with Masks[I] do
        begin
          Width := fSize;
          Height := fSize;
          LoadFromStreamEx(MS);
        end;
    end;
end;

procedure TBitMaskArray.LoadFromStream(MS: TStream);
var
 TmpMs : TMemoryStream;
 CountInt : Integer;
begin
  TmpMs := TMemoryStream.Create;
  try
    MS.Position := 0;
    TmpMs.CopyFrom(MS,MS.Size);
    TmpMs.Position := 0;
    TmpMs.ReadBuffer(FSize,sizeof(Integer));
    TmpMs.ReadBuffer(CountInt,sizeof(Integer));
    SetLength(Masks,CountInt);
    LoadFromStreamEx(TmpMS);
    MS.Position := 0;
  finally
    TmpMS.Free;
  end;
end;

procedure TBitMaskArray.SaveToStreamEx(MS: TMemoryStream);
var I : Integer;
begin
  for I := 0 to High(Masks) do
    begin
      Masks[I].SaveToStreamEx(MS);
    end;
end;

procedure TBitMaskArray.SaveToStream(MS: TStream);
var
 TmpMs : TMemoryStream;
 CountInt : integer;
begin
  TmpMs := TMemoryStream.Create;
  try
    TmpMs.WriteBuffer(FSize,sizeof(Integer));
    CountInt := Length(Masks);
    TmpMs.WriteBuffer(CountInt,sizeof(Integer));
    SaveToStreamEx(TmpMS);
    TmpMs.Position := 0;
    Ms.CopyFrom(TmpMs,TmpMs.Size);
  finally
    TmpMS.Free;
  end;
end;


end.

Ich hoffe ihr könnt mir helfen

Viele Grüße

Sfaizst