Pixelgenaue Kollision Abfrage mit Bitmaske

Gandalfus · Beiträge: 129

Also es geht um Pixelgenaue Kollision Abfrage mit Bitmaske

Das Prinzip ist hier beschreiben:
www.codeworx.org/gam..._kollision_pixel.php

Ich habe es jetzt für beliebig grosse Bilder realisiert.

die Klasse

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:

{************************************************************}
{                                                            }
{   Pixelgenaue Kollision Abfrage mit Bitmaske               }
{                                                            }
{   Copyright (c) 2007 Henning Brackmann  www.blubplayer.de  }
{                                                            }
{************************************************************}

unit U_KollisionAbfrage;

interface

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

type
  TBildBitMaske = class
  private
    SegmentSize: integer;//Segment der Maske in Bit
    procedure initMaske;
    procedure getMaske(aBild: TBitmap);
    function isKollisionWidth(x1, y1, x2, y2: integer;
      Bild2: TBildBitMaske): boolean;
  public
    Maske: array of array of Cardinal;
    width,height: integer;
    widthSegmentCount: integer;
    constructor create(aBild: TBitmap);
  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;

{ TBildBitMaske }

constructor TBildBitMaske.create(aBild: TBitmap);
begin
  width := aBild.width;
  height := aBild.height;
  SegmentSize := sizeof(Cardinal)*8;
  initMaske;
  getMaske(aBild);
end;

procedure TBildBitMaske.initMaske;
var
  tempWidth,tempHeight: integer;
  x,y: integer;
begin
  //Unterscheidung ob Rest oder nicht
  //Bei Rest würde sonst Addition von 1 falsches Ergebnis ergeben
  if (Width mod SegmentSize) = 0 then
    tempWidth := Width div SegmentSize
  else
    tempWidth := trunc(Width/SegmentSize)+1;

  widthSegmentCount := tempWidth;
  tempHeight := Height;
  setlength(Maske,tempWidth,tempHeight);
  for x := 0 to tempWidth - 1 do
    for y := 0 to tempHeight - 1 do
      Maske[x,y]:=0;

end;

procedure TBildBitMaske.getMaske(aBild: TBitmap);
type
  PixArray = Array [1..3] of byte;
var
  p: ^PixArray;
  x,y: integer;
  Color: longint;
  Bild: TBitmap;
  Segment: Cardinal;
begin
  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 := Maske[widthSegmentCount-1 - (x div SegmentSize),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;
      Maske[widthSegmentCount-1 - (x div SegmentSize),y] := Segment;
      Inc(p);
    end;
  end;

  Bild.free;
end;



function TBildBitMaske.isKollisionWidth(x1,y1: integer; x2,y2: integer; Bild2: TBildBitMaske): 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+width,y1+height),Rect(x2,y2,x2+Bild2.width,y2+Bild2.height)) 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-(widthSegmentCount*SegmentSize-Width);
    x2:=x2-(Bild2.widthSegmentCount*SegmentSize-Bild2.Width);

    //Breite umrechnen
    Bild1CalcWidth := self.widthSegmentCount*SegmentSize;
    Bild2CalcWidth := Bild2.widthSegmentCount*SegmentSize;


    IntersectRect(SchnittRect,Rect(x1,y1,x1+Bild1CalcWidth,y1+height),Rect(x2,y2,x2+Bild2CalcWidth,y2+Bild2.height));
    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 Segmentsize;
    x1SegmentEnde := Bild1SchnittRect.Right div Segmentsize;
    x2SegmentStart := Bild2SchnittRect.Left div Segmentsize;
    x2SegmentEnde := Bild2SchnittRect.Right div Segmentsize;

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

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

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

    end;

  end;
end;

end.

Eine einfachs Beispielprogramm:
Benötigt: 2 Images, 1 Timer

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:

procedure TForm1.Timer1Timer(Sender: TObject);
var
  BildBitMaske1,BildBitMaske2: TBildBitMaske;
begin

  if ((GetAsyncKeystate(vk_left)) <> 0) then
  begin
    Image24.Left := Image2.Left-1;
  end;
  if ((GetAsyncKeystate(vk_right)) <> 0) then
  begin
    Image2.Left := Image2.Left+1;
  end;
  if ((GetAsyncKeystate(vk_up)) <> 0) then
  begin
    Image2.top := Image2.top-1;
  end;
  if ((GetAsyncKeystate(vk_down)) <> 0) then
  begin
    Image2.top := Image2.top+1;
  end;

  BildBitMaske1 := TBildBitMaske.create(Image1.Picture.Bitmap);
  BildBitMaske2 := TBildBitMaske.create(Image2.Picture.Bitmap);
  if BildBitMaske1.isKollisionWidth(Image1.Left,Image1.top,Image2.Left,Image2.top,BildBitMaske2) then
    Form1.Canvas.textout(0,0,'Kollision          ')
  else
    Form1.Canvas.textout(0,0,'keine Kollision');

end;

Bemerkung: TBildBitMaske.create aufrufen (also die Bitmaske erstellen) solte man aus Performance gründen nur einmalim Program machen. Ich habe es hier wegen der Übersichtlichkeit im Timer gemacht.

mfg

_________________
Wennn man feststellt, dass es drei Moeglichkeiten gibt, die einen Vorgang schiefgehen lassen koennen und man diese ausschaltet, entstehen automatisch drei neue Moeglichkeiten.

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

genau so was habe ich gesucht.
Ich habe es für Lazarus Angepasst, jedoch klappt es jetzt überhaupt nicht:
Hauptsächlich habe ich die Procedure getmaske Verändert.
Weil es unter Lazarus leider noch kein Scanline gab habe ich es auf Pixels angepasst.
Ich hoffe da habe ich keine Fehler gemacht

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:

procedure TBildBitMaske.getMaske(aBild: TBitmap);
type
  PixArray = Array [1..3] of byte;
var
  p: TColor;
  x,y: integer;
  Color: longint;
  Bild: TBitmap;
  Segment: Cardinal;
begin
  Bild:= TBitmap.create;
  Bild.PixelFormat := pf24bit;

  Bild.Assign(aBild);
   //Reihenfolge (Scanline) der Farbwerte pro Pixel: Blau - Grün - Rot.
//  aBild.
//  aBild.TransparentColor:=clWhite;
  Color:=ColortoRGB(clWhite);
  for y:=0 to bild.Height-1 do begin
    for x:=bild.Width-1 downto 0 do  begin //downto wegen or 1 und nicht and 100000...
      p:= bild.Canvas.Pixels[x,y];
      Segment := Maske[widthSegmentCount-1 - (x div SegmentSize),y];
      if (GetBValue(Color)=GetBValue(p)) and (GetGValue(Color)=GetGValue(p)) and (GetRValue(Color)=GetRValue(p))  then
      begin
        //transparentefarbe --> 0
       Segment := Segment shl 1;
      end
      else
      begin
        //nicht transparentefarbe --> 1
        Segment := Segment shl 1;
        Segment := Segment or 1;
      end;
     Maske[widthSegmentCount-1 - (x div SegmentSize),y] := Segment;
      Inc(p);
    end;
  end;
  //writeln('OK');
  Bild.free;
end;

Außerdem musste ich noch die Create Methode Anpassen, die macht jetzt gar nix mehr das mache ich woanders:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

procedure TPluto2DSprite.LoadImage;
var
  ImageListItem:TPlutoImageListItem;
  i:Integer;
begin
  if id <> '' then begin
    ImageListItem:=ImageList.FindID(id);
    if ImageListItem <> NIL then begin
      SpriteImage:=ImageListItem.image;
      name:=ImageListItem.name;
      typ:=ImageListItem.typ;
      Width:=SpriteImage.Width;
      Height:=SpriteImage.Height;
      zusatzt:=ImageListItem.zusatzt;
      SpriteImage.Transparent:=ImageListItem.image.Transparent;
      SpriteImage.TransparentColor:=ImageListItem.image.TransparentColor;

      bitMask.width:=ImageListItem.image.Width;
      bitMask.height:=ImageListItem.image.Height;

      bitMask.SegmentSize :=sizeof(Cardinal)*8;
      bitMask.initMaske;
      bitMask.getMaske(ImageListItem.image);      
    end;
  end;
end; // LoadImage

Aufrufen tue ich es so(in einem Timer)

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:

procedure TForm1.Timer1Timer(Sender: TObject);
var
  ci,sy:Integer;
begin
  if Shot.shotrun then begin
    if shot.st +1 >= 5 then begin
      shot.st:=0;
      if Shot.Top-shot.Height >=0 then begin
        sy:=Shot.Top-shot.Height;
//        writeln(sy);
        if Gegner.bitMask.isKollisionWidth(shot.left,sy,Gegner.Left,Gegner.Top,Shot.bitMask) then
        //Shot.bitMask.isKollisionWidth(shot.left,sy,Gegner.Left,Gegner.Top,Gegner.bitMask) then
          ci:=1
        else
          ci:=-1;
        writeln(ci);

        if ci > -1 then begin
//          writeln(random(100),'\',ci);
          Shot.shotrun:=False;
        end
        else
          Shot.Top:=Shot.Top-shot.Height;

        Shot.DrawSprite;

      end
      else begin
        Shot.shotrun:=False;
        Timer1.Enabled:=False;
      end;
    end
    else
      shot.st:=shot.st+1;
  end;
end;

Und jetzt ist immer eine Kollision Auch wann gar keine ist... wo ist mein Fehler ? bzw. wo sind meine Fehler ?

_________________
MFG
Michael Springwald, "kann kein englisch...."

Gandalfus · Beiträge: 129

vieleicht so (am besten erstmal nur das ändern und den rest unverändert lassen):

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:

procedure TBildBitMaske.getMaske(aBild: TBitmap);
var
  p: TColor;
  x,y: integer;
  Color: TColor;
  Bild: TBitmap;
  Segment: Cardinal;
begin
  Bild:= TBitmap.create;
  Bild.PixelFormat := pf24bit;

  Bild.Assign(aBild);
   //Reihenfolge (Scanline) der Farbwerte pro Pixel: Blau - Grün - Rot.
//  aBild.
//  aBild.TransparentColor:=clWhite;
  Color:=clWhite;
  for y:=0 to bild.Height-1 do begin
    for x:=bild.Width-1 downto 0 do  begin //downto wegen or 1 und nicht and 100000...
      p:= bild.Canvas.Pixels[x,y];
      Segment := Maske[widthSegmentCount-1 - (x div SegmentSize),y];
      if p=Color then
      begin
        //transparentefarbe --> 0
       Segment := Segment shl 1;
      end
      else
      begin
        //nicht transparentefarbe --> 1
        Segment := Segment shl 1;
        Segment := Segment or 1;
      end;
      Maske[widthSegmentCount-1 - (x div SegmentSize),y] := Segment;
    end;
  end;
  //writeln('OK');
  Bild.free;
end;

_________________
Wennn man feststellt, dass es drei Moeglichkeiten gibt, die einen Vorgang schiefgehen lassen koennen und man diese ausschaltet, entstehen automatisch drei neue Moeglichkeiten.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme