Sprite andockbar

[Blup]

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.

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.