Hallo,
ich möchte gerne zwei Sprite miteinander andockbar machen.
Das ganze soll ein Map Editor werden.

Bei meinem jetzigen Quellcode springen die Sprites zu einer ganz falschen Stellen wenn mehrere Sprites drum herum sind.

Hier mal der Quellcode:

zusammenfalten · markieren

Delphi-Quellcode:

procedure TForm2.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  p:TAdPoint;
  spritet, spritet2, spriteb, spriteb2, spritel, spritel2, spriter, spriter2: TSprite;
begin
  if ssLeft in Shift then
  begin
 if (Selected.Item<>nil) and (Selected.Item is TTexture) then
begin
       spritet := nil;
       spritet2 := nil;
       spriteb := nil;
       spriteb2 := nil;
       spritel := nil;
       spritel2 := nil;
       spriter := nil;
       spriter2 := nil;
      p := AdSpriteEngine.ScreenPointToSpriteCoords(AdPoint(X,Y));
       spritet := AdSpriteEngine.GetSpriteAt(round(Selected.Item.WorldX) + 1, round(Selected.Item.WorldY) -10);
      spritet2 := AdSpriteEngine.GetSpriteAt(round(Selected.Item.WorldX) + round(Selected.Item.width) - 1, round(Selected.Item.WorldY-10));
       spriteb := AdSpriteEngine.GetSpriteAt(round(Selected.Item.WorldX) + 1, round(Selected.Item.WorldY) + round(Selected.Item.height)+10);
      spriteb2 := AdSpriteEngine.GetSpriteAt(round(Selected.Item.WorldX) + round(Selected.Item.width) - 1, round(Selected.Item.WorldY+round(Selected.Item.height)+10));
       spritel := AdSpriteEngine.GetSpriteAt(round(Selected.Item.WorldX) - 10,round(Selected.Item.WorldY) + 1);
      spritel2 := AdSpriteEngine.GetSpriteAt(round(Selected.Item.WorldX) - 10,round(Selected.Item.WorldY) + round(Selected.Item.height) - 1);
       spriter := AdSpriteEngine.GetSpriteAt(round(Selected.Item.WorldX) + round(Selected.Item.width) +10, round(Selected.Item.WorldY) + 1);
      spriter2 := AdSpriteEngine.GetSpriteAt(round(Selected.Item.WorldX) + round(Selected.Item.width) +10, round(Selected.Item.WorldY)+round(Selected.Item.height) - 1);

      if (spritet is TTexture) or (spritet2 is TTexture) or (spriteb is TTexture) or (spriteb2 is TTexture) or (spritel is TTexture) or (spritel2 is TTexture) or (spriter is TTexture) or (spriter2 is TTexture) then
       begin
       if ((spritet<>nil) and (spritet is TTexture)) or ((spritet2<>nil) and (spritet2 is TTexture)) then
       begin
         if (spritet<>nil) and (spritet is TTexture) then
          begin
           Selected.Item.X:=spritet.X;
           Selected.Item.Y:=spritet.Y+128;
          end
         else
          begin
           Selected.Item.X:=spritet.X;
           Selected.Item.Y:=spritet.Y+128;
          end;
       Label12.Caption:='top';
       end;

       if ((spriteb<>nil) and (spriteb is TTexture)) or ((spriteb2<>nil) and (spriteb2 is TTexture)) then
       begin
        if (spriteb<>nil) and (spriteb is TTexture) then
          begin
           Selected.Item.X:=spriteb.X;
           Selected.Item.Y:=spriteb.Y-128;
          end
         else
          begin
           Selected.Item.X:=spriteb.X;
           Selected.Item.Y:=spriteb.Y-128;
          end;
       Label12.Caption:='bottom';
       end;

       if ((spritel<>nil) and (spritel is TTexture)) or ((spritel2<>nil) and (spritel2 is TTexture)) then
       begin
         if (spritel<>nil) and (spritel is TTexture) then
          begin
           Selected.Item.X:=spritel.X+128;
           Selected.Item.Y:=spritel.Y;
          end
         else
          begin
           Selected.Item.X:=spritel.X+128;
           Selected.Item.Y:=spritel.Y;
          end;
       Label12.Caption:='left';
       end;

       if ((spriter<>nil) and (spriter is TTexture)) or ((spriter2<>nil) and (spriter2 is TTexture)) then
       begin
         if (spriter<>nil) and (spriter is TTexture) then
          begin
           Selected.Item.X:=spriter.X-128;
           Selected.Item.Y:=spriter.Y;
          end
         else
          begin
           Selected.Item.X:=spriter.X-128;
           Selected.Item.Y:=spriter.Y;
          end;
       Label12.Caption:='right';
       end;
       end
       else
       begin
       Selected.Item.X := p.x - Selected.dx;
       Selected.Item.Y := p.y - Selected.dy;
       end;
end
else
begin
//Code zum bewegen der Welt(unwichtig)
end;
  end;
end;

Und im Anhang noch die Anwendung mit dem Fehler.

~Sorry musste den Beitrag löschen~

So ich hab oben den Beitrag nochmal editiert, ist doch noch nicht gelöst

Aufmerksame DPler könnten ziemlich sicher vermuten womit du da arbeitest, aber dennoch wäre es das Mindeste anzugeben mit was für einer Lib du dort hantierst.

Ohh Sorry, jetzt kann ich den Beitrag nicht mehr Editieren

Aber dann schreib ich das mal hier, ich arbeite mit: [Andorra 2D]

Wenn alle Objekte/Sprites bei dir Gleich groß sind, ist das relativ einfach:

markieren

Delphi-Quellcode:

var
  mx,my:Integer;
begin
  mx:=x div Size
  my:=y div Size
  Object.x:=mx*Size
  Object.Y:=my*Size
end;

Objekt ist dein Sprite was du erstellen möchtest, und Size ist die Größe der Spritest. Wie gesagt wenn sie alle gleich groß sind.
X und Y könnten z.b. die Mauszeiger Positionen enthalten.

Sind die Objekte alle Unterschiedlich groß gibt es ein Problem... Bein einem Spiel von mir habe ich das so gelöst, das ich eine Größe Ermittelt habe, die in etwa alle Objekte umfasst... dann habe ich daraus ein Raster erstellt und die Objekte alle in diesem Raster Zentriert ! optimal ist das zwar noch nicht, aber es scheint bei mir ganz gut zu laufen.
Den Code habe ich für meine 2D Engine geschrieben, aber wenn du ihn haben möchtest könnte ich ihn raußsuchen. Du musst ihn dann nur noch anpassen.

Ich könnte mir bei Unterschiedlich Großen Objekten auch noch folgendes vorstellen:
Wenn das Spielfehld nicht ganz so viele Objekte hat, könntest du feststellen, welches Objekt am nahsten vom das Objekt liegt welches erstellt werden soll. Dann könntest du diese Position als Ausgangs Position nehmen.
Problem ist dann nur noch die Richtige Seite zu ermitteln.

(Darum schreibe ich lieber Spiele wo alle Objekte gleich groß sind *G*)

Ich habe mir diese Variante überlegt, dabei müssen die Texturen horizontal min. 50% überlappen um vertikal anzudocken oder vertikal min. 50% um horizontal. Ein festes Raster wird nicht benötigt. Würde mich interessieren ob das so funktioniert.

markieren

Code:

type
  TDockDirection = (ddTop, ddBottom, ddLeft, ddRight);

  TDockInfo = record
    Direction: TDockDirection;
    Sprite: TSprite;
    Distanz: Double;
    procedure Clear(ADirection: TDockDirection);
    procedure Init(ADirection: TDockDirection; ASprite: TSprite);
  end;

  TSelected = record
    Item: TSprite;
    dx: Double;
    dy: Double;
    function GetCenter: TAdPoint;
    function GetDockInfo(ADirection: TDockDirection): TDockInfo; overload;
    function GetDockInfo: TDockInfo; overload;
    procedure SetDock(ADockInfo: TDockInfo);
  end;

var
  Selected: TSelected;

implementation

const
  DockRadius = 10;
  DirectionText: array [TDockDirection] of String =
    ('Top', 'Bottom', 'Left', 'Right');

procedure TDockInfo.Clear(ADirection: TDockDirection);
begin
  Direction := ADirection;
  Sprite   := nil;
  Distanz  := 0;
end;

procedure TDockInfo.Init(ADirection: TDockDirection; ASprite: TSprite);
begin
  Clear(ADirection);
  if Assigned(Selected.Item) and (ASprite is TTexture) then
  begin
    Sprite := ASprite;
    case ADirection of
      ddTop:   Distanz := Selected.Item.Y - (ASprite.Y + ASprite.Height);
      ddBottom: Distanz := (Selected.Item.Y + Selected.Item.Height) - ASprite.Y;
      ddLeft:  Distanz := Selected.Item.X - (ASprite.X + ASprite.Width);
      ddRight: Distanz := (Selected.Item.X + Selected.Item.Width) - ASprite.X;
    end;
    {die beiden Texturen dürfen maximal DockRadius überlappen}
    if Abs(Distanz) > DockRadius then
      Clear(ADirection);
  end;
end;

function TSelected.GetCenter: TAdPoint;
begin
  if Assigned(Item) then
  begin
    Result.X := Item.X + (Item.Width / 2);
    Result.Y := Item.Y + (Item.Height / 2);
  end
  else
  begin
    Result.X := 0;
    Result.Y := 0;
  end;
end;

function TSelected.GetDockInfo(ADirection: TDockDirection): TDockInfo;
var
  p: TAdPoint;
begin
  if Assigned(Item) then
  begin
    p := GetCenter;
    case ADirection of
      ddTop:   p.Y := Item.Y              - DockRadius;
      ddBottom: p.Y := Item.Y + Item.Height + DockRadius;
      ddLeft:  p.X := Item.X              - DockRadius;
      ddRight: p.X := Item.X + Item.Width + DockRadius;
    end;
    Result.Init(ADirection, AdSpriteEngine.GetSpriteAt(p));
  end
  else
    Result.Clear(ADirection);
end;

function TSelected.GetDockInfo: TDockInfo;
var
  DockInfo: TDockInfo;
  Direction: TDockDirection;
begin
  Result.Clear(ddTop);
  {in welcher Richtung ist eine Texttur am nähesten zum Andocken geeignet}
  for Direction := Low(TDockDirection) to High(TDockDirection) do
  begin
    DockInfo := GetDockInfo(Direction);
    if Assigned(DockInfo.Sprite) and
       ((not Assigned(Result.Sprite)) or
        (Abs(Result.Distanz) > Abs(DockInfo.Distanz))) then
      Result := DockInfo;
  end;
end;

procedure TSelected.SetDock(ADockInfo: TDockInfo);
begin
  if (Item is TTexture) and (ADockInfo.Sprite is TTexture) then
  begin
    {sind die Texturen nicht von der gleichen Größe, hier anpassen}
    Item.X := ADockInfo.Sprite.X;
    Item.Y := ADockInfo.Sprite.Y;
    case ADockInfo.Direction of
      ddTop:    Item.Y := ADockInfo.Sprite.Y + ADockInfo.Sprite.Height;
      ddBottom: Item.Y := ADockInfo.Sprite.Y - Item.Height;
      ddLeft:   Item.X := ADockInfo.Sprite.X - Item.Width;
      ddRight:  Item.X := ADockInfo.Sprite.X + ADockInfo.Sprite.Width;
    end;
  end;
end;

procedure TForm2.Panel1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  p: TAdPoint;
  DockInfo: TDockInfo;
begin
  if ssLeft in Shift then
  begin
    if Selected.Item is TTexture then
    begin
      {erst einmal das ausgewählte Element an die Position bewegen,
       wo es ohne Docking hingehören würde}
      p := AdSpriteEngine.ScreenPointToSpriteCoords(AdPoint(X,Y));
      Selected.Item.X := p.x - Selected.dx;
      Selected.Item.Y := p.y - Selected.dy;
      {welche Textur ist am besten zum Andocken geeignet}
      DockInfo := Selected.GetDockInfo;
      if Assigned(DockInfo.Sprite) then
      begin
        Selected.SetDock(DockInfo);
        Label12.Caption := DirectionText[DockInfo.Direction];
      end
      else
        Label12.Caption := '';
    end
    else
    begin
      //Code zum bewegen der Welt(unwichtig)
    end;
  end;
end;

Übrigens ist eine zusätzliche Prüfung auf nil nicht erforderlich, wenn sowieso eine Typprüfung erfolgt.