Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Lazarus: назначить родительский OnMouseMove WinControl'ным детям / 17 сообщений из 17, страница 1 из 1
23.11.2017, 23:49:51
    #39558651
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
На форме эдиты, кнопки, мемы ...

Пытаюсь реализовать сабж в RT, че-та лыжы не едут :(
Код: pascal
1.
2.
3.
4.
5.
6.
7.
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to Pred(TWinControl(Sender).ControlCount) do
    TWinControl(Sender).Controls[i].?????:= @FormMouseMove;
end; 


Или я хочу невозможного?
=================
Док.

Win7 Ultim x64/Deb 9.1(GNOME, MATE; gtk2) i386:
FB 3.0.2.32703, диалект 3, SS,
Lazarus 1.9(r.56443); FPC 3.1.1 (r.37610), IBX by -Rik-; IBE 2017.4.19.2
...
Рейтинг: 0 / 0
24.11.2017, 00:20:09
    #39558654
Ghost Writer
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Док,

Код: pascal
1.
2.
3.
4.
type
  TAccessControl = class(TControl);  
...
TAccessControl(TWinControl(Sender).Controls[i]).OnMouseMove := @FormMouseMove;
...
Рейтинг: 0 / 0
24.11.2017, 00:42:26
    #39558662
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Ghost Writer,

круто! о_О
Спасибо
...
Рейтинг: 0 / 0
24.11.2017, 01:08:16
    #39558670
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
А если пойти дальше... Положил туда же PageControl, на который набросал еще мелочи
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
procedure TForm1.FormCreate(Sender: TObject);
var
  i,j: integer;
begin
  for i := 0 to Pred(TWinControl(Sender).ControlCount) do
    begin
      if (TWinControl(Sender).Controls[i] is TPageControl)
        then
          begin
            TChildControl(TWinControl(Sender).Controls[i]).OnMouseMove:= @FormMouseMove;

            for j:= 0 to Pred(TWinControl(TPageControl).ControlCount) do
              begin
                TChildControl(TWinControl(TPageControl).Controls[i]).OnMouseMove:= @FormMouseMove;
              end;
          end
        else
          TChildControl(TWinControl(Sender).Controls[i]).OnMouseMove:= @FormMouseMove;
    end;
end; 


При отладке в выделенной строке получаю
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
[Window Title]
Error

[Content]
Project project1 raised exception class 'External: SIGSEGV'.

 At address 4354A0

[OK]


Ы? Что не так?
...
Рейтинг: 0 / 0
24.11.2017, 01:12:25
    #39558671
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
ошибка в коде
Код: pascal
1.
TChildControl(TWinControl(TPageControl).Controls[j]).OnMouseMove:= @FormMouseMove;


но даже в переправленном виде, то же исключение
...
Рейтинг: 0 / 0
24.11.2017, 01:48:12
    #39558675
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Уф, разобрался :)
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
procedure TForm1.FormCreate(Sender: TObject);
var
  i,j,k: integer;
  PC: TPageControl;
  TS: TTabSheet;
begin
  PC:= nil;
  TS:= nil;

  for i := 0 to Pred(TWinControl(Sender).ControlCount) do
    begin
      if (TWinControl(Sender).Controls[i] is TPageControl)
        then
          begin
            PC:= TPageControl(TWinControl(Sender).Controls[i]);
            TChildControl(PC).OnMouseMove:= @FormMouseMove;

            if PC.PageCount > 0
              then
                for j:= 0 to Pred(PC.PageCount) do
                  begin
                    TS:= TTabSheet(PC.Controls[j]);
                    TChildControl(TS).OnMouseMove:= @FormMouseMove;

                    for k:= 0 to Pred(TS.ControlCount) do
                      TChildControl(TS.Controls[k]).OnMouseMove:= @FormMouseMove;
                  end
              else
                Continue;
          end
        else
          TChildControl(TWinControl(Sender).Controls[i]).OnMouseMove:= @FormMouseMove;
    end;
end;   

...
Рейтинг: 0 / 0
24.11.2017, 03:12:32
    #39558690
Kazantsev Alexey
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Док,

Это делается сильно проще...
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, ComCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    ApplicationProperties1: TApplicationProperties;
    procedure ApplicationProperties1UserInput(Sender: TObject; Msg: Cardinal);
  private

  public

  end;

var
  Form1: TForm1;

implementation

uses

  LMessages;

{$R *.lfm}

{ TForm1 }

procedure TForm1.ApplicationProperties1UserInput(Sender: TObject; Msg: Cardinal);
var

 ctrl : TControl;

begin

 if Msg = LM_MOUSEMOVE then
  begin

   ctrl := FindControlAtPosition(Mouse.CursorPos, True);

   if Assigned(ctrl) then
    Caption := Format('%s (%s)', [ctrl.Name, ctrl.QualifiedClassName])
   else
    Caption := '';

  end;

end;

end.


Результат
...
Рейтинг: 0 / 0
24.11.2017, 08:40:18
    #39558732
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Kazantsev Alexey,

Вот шайтан!

Спасибо, гляну
...
Рейтинг: 0 / 0
25.11.2017, 16:08:41
    #39559420
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Kazantsev Alexey,

классная штука. Можно без лишнего геморроя и изящно отследить и клики кнопками мыша и многое другое.

У меня вопрос по мат.части: если сделать так

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
private
FControlUnderCur: TWinControl;
...

procedure TForm1.ApplicationProperties1UserInput(Sender: TObject; Msg: Cardinal);
var
  ctrl : TControl;
begin
...
 if (ctrl is TWinControl) {1} then FControlUnderCur:= TWinControl(ctrl);{2}
...



проверка {1} в принципе нужна?
...
Рейтинг: 0 / 0
25.11.2017, 16:15:37
    #39559425
wadman
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Докпроверка {1} в принципе нужна?
Конечно! Особенно если учесть, что ctrl нигде не присваивается...

А вообще (если вдруг ctrl это sender) ты же сам назначаешь обработчика. Не всем-же подряд?
...
Рейтинг: 0 / 0
25.11.2017, 19:52:46
    #39559481
Kazantsev Alexey
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Докпроверка {1} в принципе нужна?
Конечно нужна. Но если тебе нужны только оконные контролы, то можно использовать FindLCLWindow(). Ну а если есть желание заморочиться, то можно вообще взять ControlAtPos() у которой куча параметров для отбора.
...
Рейтинг: 0 / 0
26.11.2017, 16:12:21
    #39559625
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Kazantsev AlexeyНу а если есть желание заморочиться, то можно вообще взять ControlAtPos() у которой куча параметров для отбора.
К слову, ControlAtPos в Лазаре существует в виде трех перегруженных функций, но у меня получилось реализовать только этот вариант
Код: pascal
1.
function ControlAtPos(const Pos: TPoint; Flags: TControlAtPosFlags): TControl; override;


Все остальные среда не дает реализовать.

У меня сложность вернуть по клику мыша имя любого из множества винконтролов, лежащих на одном родителе, любым другим способом, отличным от аналога этого .
...
Рейтинг: 0 / 0
26.11.2017, 16:19:56
    #39559626
Kazantsev Alexey
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
ДокУ меня сложность вернуть по клику мыша имя любого из множества винконтролов
А этот вариант не устраивает?
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
 if Msg = LM_LBUTTONDOWN then
  begin

//   ctrl := FindControlAtPosition(Mouse.CursorPos, True);
   ctrl := FindLCLWindow(Mouse.CursorPos);

   if Assigned(ctrl) then
    Caption := Format('%s (%s)', [ctrl.Name, ctrl.QualifiedClassName])
   else
    Caption := '';

  end;

...
Рейтинг: 0 / 0
26.11.2017, 23:27:29
    #39559731
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Kazantsev Alexey,

ага, дошло только сейчас, как можно это использовать. Спасибо ;)

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
 if Msg = LM_LBUTTONDOWN then
  begin
   ctrl := FindLCLWindow(Mouse.CursorPos);

   if Assigned(ctrl) then  Blablabla(ctrl);
  end;

procedure Blablabla (Sender: TWinControl);
begin
  if TWinControl(Sender).Parent = TTabSheet1 then ...
end;
...
Рейтинг: 0 / 0
27.11.2017, 00:07:45
    #39559734
Kazantsev Alexey
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Док,

Можно всё же использовать ControlAtPos:
Код: pascal
1.
ctrl := TabSheet1.ControlAtPos(TabSheet1.ScreenToClient(Mouse.CursorPos), True, True);


Только в этом случае нужно следить, чтобы TabSheet1 был активным.
...
Рейтинг: 0 / 0
27.11.2017, 00:16:09
    #39559735
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Kazantsev Alexey,

Ух-ты, и так, оказывается, можно. Завтра гляну, спасибо
...
Рейтинг: 0 / 0
27.11.2017, 09:55:22
    #39559802
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Kazantsev Alexey,

поэкспериментировал
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
procedure TForm1.ApplicationProperties1UserInput(Sender: TObject; Msg: Cardinal
  );
var
  WC: TWinControl;
  Ctrl: TControl;
begin
  //MC:= FindControlAtPosition(Mouse.CursorPos,True);
  WC:= FindLCLWindow(Mouse.CursorPos);

  if Assigned(WC) then
    begin
      case Msg of
        LM_MOUSEMOVE:
              begin
                Label2.Caption:= WC.Name;
              end;

        LM_LBUTTONDOWN:
              begin
                Label1.Caption:= WC.Name;

                case PageControl1.ActivePageIndex of
                  0: ClosePanel(WC,WC.Parent, mbLeft);//TabSheet1
                  1:
                    begin
                      Ctrl:= TabSheet2.ControlAtPos(TabSheet2.ScreenToClient(Mouse.CursorPos), True,True);
                      if Assigned(Ctrl) and (Ctrl is TWinControl)
                        then ClosePanel(TWinControl(Ctrl), TWinControl(Ctrl).Parent,mbLeft);
                    end;
                end;


              end;

        LM_RBUTTONDOWN:
              begin
                //if PageControl1.ActivePage = TabSheet1 then ClosePanel(WC, WC.Parent,mbRight);
                ClosePanel(WC,PageControl1.ActivePage,mbRight);
              end;
      end;
    end;
end;
...
procedure TForm1.ClosePanel(Sender, AParent: TWinControl; MB: TMouseButton);
begin
  case MB of
    mbLeft:
          begin
            if (TWinControl(Sender).Parent = AParent) and not (TWinControl(Sender) = FPnl) then
              if Assigned(FPnl) then FreeAndNil(FPnl);
          end;
    mbRight:
          begin
            if (TWinControl(Sender) = AParent) or (TWinControl(Sender).Parent = AParent) then
              if Assigned(FPnl) then FreeAndNil(FPnl);
          end;
  end;
end; 


Поиск TWinControl напрямую мне показался проще. В любом случае, задача решена. Спасибо за помощь и ценные советы.
...
Рейтинг: 0 / 0
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Lazarus: назначить родительский OnMouseMove WinControl'ным детям / 17 сообщений из 17, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]