powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Lazarus: назначить родительский OnMouseMove WinControl'ным детям
17 сообщений из 17, страница 1 из 1
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
    #39558651
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
На форме эдиты, кнопки, мемы ...

Пытаюсь реализовать сабж в 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
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
    #39558654
Ghost Writer
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Док,

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

круто! о_О
Спасибо
...
Рейтинг: 0 / 0
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
    #39558670
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А если пойти дальше... Положил туда же 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
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
    #39558671
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ошибка в коде
Код: pascal
1.
TChildControl(TWinControl(TPageControl).Controls[j]).OnMouseMove:= @FormMouseMove;


но даже в переправленном виде, то же исключение
...
Рейтинг: 0 / 0
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
    #39558675
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Уф, разобрался :)
Код: 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
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
    #39558690
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.
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
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
    #39558732
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexey,

Вот шайтан!

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

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


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

У меня сложность вернуть по клику мыша имя любого из множества винконтролов, лежащих на одном родителе, любым другим способом, отличным от аналога этого .
...
Рейтинг: 0 / 0
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
    #39559626
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ДокУ меня сложность вернуть по клику мыша имя любого из множества винконтролов
А этот вариант не устраивает?
Код: 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
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
    #39559731
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
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
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
    #39559734
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Док,

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


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

Ух-ты, и так, оказывается, можно. Завтра гляну, спасибо
...
Рейтинг: 0 / 0
Lazarus: назначить родительский OnMouseMove WinControl'ным детям
    #39559802
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
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
17 сообщений из 17, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Lazarus: назначить родительский OnMouseMove WinControl'ным детям
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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