Перетаскивание объектов по форме

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Перетаскивание объектов по форме

Сообщение Neep » 05.12.2018 15:57:06

Сделал перетаскивание объектов по форме, классический вариант:
Код: Выделить всё
TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    Memo2: TMemo;
    Panel1: TPanel;
    procedure ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  protected
  private
    MouseDownSpot : TPoint;
    Capturing : boolean;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  SetCapture(TWinControl(Sender).Handle);
  Capturing := true;
  MouseDownSpot.X := x;
  MouseDownSpot.Y := Y;
  TWinControl(Sender).Cursor:= crArrow;
end;

procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if Capturing then
  begin
    TWinControl(Sender).Left := TWinControl(Sender).Left - (MouseDownSpot.x - x);
    TWinControl(Sender).Top := TWinControl(Sender).Top - (MouseDownSpot.y - y);
  end;
end;

procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Capturing then
   begin
     ReleaseCapture;
     Capturing := false;
     TWinControl(Sender).Left := TWinControl(Sender).Left - (MouseDownSpot.x - x);
     TWinControl(Sender).Top := TWinControl(Sender).Top - (MouseDownSpot.y - y);
     TWinControl(Sender).Cursor:= crDefault;
   end;
end;                                                             

но получается что в кнопке например, появляется подсветка, когда на неё мыша попадает, в Memo курсор мигает, и текст можно вводить. А нужно как в дизайнере форм, чтобы контрол был "не живой", пока не разрешу.
т.е. у если разрешил редактировать форму, то они стали "не живые", потом запретил, и все стали обычными, со своими событиями.
Предполагаю, гдето надо сообщения перехватывать, но не могу разобраться.
Neep
незнакомец
 
Сообщения: 3
Зарегистрирован: 05.12.2018 15:28:06

Re: Перетаскивание объектов по форме

Сообщение Mirage » 05.12.2018 23:49:11

Может, дисаблить просто на время перетаскивания?
Mirage
энтузиаст
 
Сообщения: 832
Зарегистрирован: 06.05.2005 20:29:07
Откуда: Russia

Re: Перетаскивание объектов по форме

Сообщение wadman » 06.12.2018 08:54:20

У TApplication есть OnMessage. В нем можно фильтровать сообщения таскаемым контролам.
wadman
постоялец
 
Сообщения: 109
Зарегистрирован: 18.10.2016 15:54:28

Re: Перетаскивание объектов по форме

Сообщение Neep » 06.12.2018 10:48:29

wadman писал(а):У TApplication есть OnMessage. В нем можно фильтровать сообщения таскаемым контролам.

Да нету там такого.
Neep
незнакомец
 
Сообщения: 3
Зарегистрирован: 05.12.2018 15:28:06

Re: Перетаскивание объектов по форме

Сообщение wadman » 06.12.2018 12:36:03

Neep писал(а):Да нету там такого.

Хм, круто они отошли от делфи в этом плане...

Судя по всему, решение только для винды, то вполне сойдет и такой способ http://forum.lazarus-ide.org/index.php?topic=29001.0

Еще стоит глянуть на csDesigning, который может контролировать поведение контрола:
Код: Выделить всё
TComponentState = set of (csLoading, csReading, csWriting, csDestroying,
    csDesigning, csAncestor, csUpdating, csFixups, csFreeNotification,
    csInline, csDesignInstance);
wadman
постоялец
 
Сообщения: 109
Зарегистрирован: 18.10.2016 15:54:28

Re: Перетаскивание объектов по форме

Сообщение Neep » 06.12.2018 16:27:00

А есть еще в designer/designer.pp такие процедуры
Код: Выделить всё
    procedure MouseDownOnControl(Sender: TControl; var TheMessage: TLMMouse);
    procedure MouseMoveOnControl(Sender: TControl; var TheMessage: TLMMouse);
    procedure MouseUpOnControl(Sender: TControl; var TheMessage:TLMMouse);

они по событию в IsDesignMsg в TDesigner, который наследуется от TComponentEditorDesigner который... и я запутался.
Как вызывается IsDesignMsg?
Neep
незнакомец
 
Сообщения: 3
Зарегистрирован: 05.12.2018 15:28:06

Re: Перетаскивание объектов по форме

Сообщение LearnMagic » 16.12.2018 01:38:05

http://www.delphisources.ru/pages/faq/base/panel_mouse_move.html
"Так можно таскать мышкой TPanel по форме в run-time'е.
Поместите на форму TPanel и напишите обработчик события OnMauseDown,
запустите программу и задвинте эту панель подальше.
Код: Выделить всё
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DRAGMOVE = $F012;
begin
  ReleaseCapture;
  {а если сюда написать Form1, то можно таскать форму по экрану}
  Panel1.Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;

на самом деле таким образом можно таскать по форме любые визуальные компоненты"
LearnMagic
новенький
 
Сообщения: 59
Зарегистрирован: 10.11.2016 23:13:38

Re: Перетаскивание объектов по форме

Сообщение Лекс Айрин » 16.12.2018 07:21:05

Neep писал(а):Предполагаю, гдето надо сообщения перехватывать, но не могу разобраться.


Просто надо, как уже предлагали, отключать компоненты во время движения. Да, они станут серыми, но это и дополнительный контроль.
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 4540
Зарегистрирован: 19.02.2013 16:54:51
Откуда: Волгоград

Re: Перетаскивание объектов по форме

Сообщение *Rik* » 16.12.2018 08:30:37

Neep писал(а):Предполагаю, гдето надо сообщения перехватывать, но не могу разобраться.

Смотри TDesignerManager в самом конце:
http://visual-t.ru/components.html

Но созданную форму нельзя перевести в полноценный режим дизайна, её можно только создать с соответствующими опциями.
Аватара пользователя
*Rik*
постоялец
 
Сообщения: 375
Зарегистрирован: 19.04.2011 12:18:51
Откуда: Урал


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Yandex [Bot] и гости: 4

Рейтинг@Mail.ru