5th
Сен

Липкие обьекты

Posted by Chas under Пост-обзор

Как можно сделать эффект липких объектов?

Stilet:
Обработчик перемещения так чтоб картинки клеились к друг другу сбоку:

код:

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
var cx2,cx,pt2:TPoint;i:integer; r1,r2:double;
begin
   if (pt.X>0)and(pt.Y>0) then begin
     pt2:=TImage(Sender).ClientToScreen(Point(x,y));
     TImage(Sender).Left:=TImage(Sender).Left+(pt2.X-pt.X);
     TImage(Sender).Top:=TImage(Sender).Top+(pt2.y-pt.y);
     pt:=pt2;
     cx.X:=TImage(Sender).Left+TImage(Sender).Width div 2;
     cx.y:=TImage(Sender).Top+TImage(Sender).Height div 2;
      r1:=sqrt(sqr(TImage(Sender).Width)+sqrt(TImage(Sender).Height));
     for i := 0 to ControlCount – 1 do begin
      if (Controls is TImage)and(Controlssender) then begin
        with TImage(Controls) do begin
         cx2.X:=Left+Width div 2;
         cx2.y:=Top+Height div 2;
         r2:=sqrt(sqr(Width)+sqrt(Height));
         if sqrt(sqr(cx.X-cx2.X)+sqr(cx.y-cx2.y))<((r2+r1)/2+20) then begin
         //******************************************
            if (cx.X>cx2.X) then begin
             TImage(Sender).Left:=Left+Width;
             TImage(Sender).Top:=top;
            end;
            if (cx.X<cx2.X) then begin
             TImage(Sender).Left:=Left-Width;
             TImage(Sender).Top:=top;
            end;
         //******************************************
         end;
       end;
      end;
     end;
   end;
end;

Тема на форуме

Похожие статьи

Теги: |