Последние записи
- Сделать авторизацию пользователя в программе
- Сделать границы компонента edit – жирными?
- Как настроить адрес без указания на index.php?
- Чтение из Excel и валидация. Можно ли как-то ускорить данный процесс?
- Загрузить файл из папки с программой
- Компьютеры для бухгалтера и дизайнера. В чём разница?
- Удалить все повторения в строке
- Как в treeview узнать индекс узла по которому был click?
- Исходник программы «азбука Морзе»
- Рассылка. Выпуск 139
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;
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;
