powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Как передать сендер в обработчик сообщений
25 сообщений из 47, страница 1 из 2
Как передать сендер в обработчик сообщений
    #39547160
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Пытаюсь поменять мышом размер панели в RT.
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
Type
  TPanel = class(ExtCtrls.TPanel)

  private
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  end; 

  { TForm1 }

  TForm1 = class(TForm)
//<skiped>
    Panel1: TPanel;
    Panel2: TPanel;
//<skiped>



Отловить курсор в верхнем левом углу несложно (с помощью абсолютных координат)
Код: pascal
1.
2.
3.
4.
5.
6.
7.
procedure TPanel.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  inherited;
  if (Msg.Result = HTCLIENT) 
    and PtInRect(Rect(0, 0, 10, 10), ScreenToClient(Point(Msg.XPos, Msg.YPos))) then
    Msg.Result := HTTOPLEFT;
end; 



1. Как задать координаты правого нижнего угла (с помощью относ. координат)?
2. Как задать данный обработчик только для одного конкретного экземпляра этого класса (например, только для Panel2)?
=================
Док.

Win7 Ultim x64/Deb 9.1(GNOME, MATE; gtk2) i386:
FB 3.0.2.32703, диалект 3, SS,
Lazarus 1.9(r.56145); FPC 3.1.1 (r.36290), IBX by -Rik-; IBE 2017.4.19.2
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547167
Фотография wadman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Док1. Как задать координаты правого нижнего угла (с помощью относ. координат)?
Они уже заданы. Уточни вопрос.
Док2. Как задать данный обработчик только для одного конкретного экземпляра этого класса (например, только для Panel2)?
Добавь булево свойство, которое будет активировать обработчик.
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547173
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
wadmanОни уже заданы. Уточни вопрос.
как задать в обработчике координаты Rect(0,0,10,10) в нижнем правом углу?
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547180
Фотография wadman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ДокwadmanОни уже заданы. Уточни вопрос.
как задать в обработчике координаты Rect(0,0,10,10) в нижнем правом углу?
Имеешь в виду Height-10 и Width-10?
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547198
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ДокПытаюсь поменять мышом размер панели в RT.
...
2. Как задать данный обработчик только для одного конкретного экземпляра этого класса (например, только для Panel2)?

Вот тут официальный пример от эмбы.
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547199
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Если вытащить самую суть:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
procedure TMyListBoxDescendant.SubClassWndProc(var Message: TMessage);
begin
  if (Message.Msg = WM_STYLEMESSAGE) then
    Style:= TListBoxStyle(Message.WParam)
  else
    WndProc(Message);
end;
 
procedure TMyListBoxDescendant.ToggleSubClass(On: Boolean);
begin
  if On then
    WindowProc := SubClassWndProc
  else
    WindowProc := WndProc;
end;
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547238
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
wadmanИмеешь в виду Height-10 и Width-10?
да, мне нужны именно ширина/высота изменяемой панели. Хотел как-то феншуйно, типа Sender.Width, но придется, как обычно, через поля класса реализовывать :)

alekcvpЕсли вытащить самую суть
спасибо, попробую. Пока тупо повесил изменение булевой переменной на обработчики OnMouseEnter/OnMouseLeave
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547252
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Докспасибо, попробую. Пока тупо повесил изменение булевой переменной на обработчики OnMouseEnter/OnMouseLeave
Наловишь кучу глюков, в случае когда фокус переключается на другое окно в то время как курсор над панелью.
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547259
Фотография wadman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Докда, мне нужны именно ширина/высота изменяемой панели. Хотел как-то феншуйно, типа Sender.Width, но придется, как обычно, через поля класса реализовывать :)
ControlAtPos поможет...
alekcvpНаловишь кучу глюков, в случае когда фокус переключается на другое окно в то время как курсор над панелью.
Это обрабатывается стандартно: по нажатию кнопки события от мыши грабятся и при отпускании кнопки - освобождаются.
https://msdn.microsoft.com/en-us/library/windows/desktop/ms646262(v=vs.85).aspx
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547261
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ДокwadmanИмеешь в виду Height-10 и Width-10?
Хотел как-то феншуйно, типа Sender.Width, но придется, как обычно, через поля класса реализовывать :)
У тебя же обработчик - метод класса-контрола, зачем тебе Sender когда там Self есть, он и будет Sender'ом.
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547297
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alekcvpзачем тебе Sender когда там Self есть, он и будет Sender'ом
епрст, как же я мог про это забыть!

...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547414
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Сделал так (для частного случая)
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
procedure TPanel.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  inherited;
  if (Msg.Result = HTCLIENT)
      and PtInRect(Rect(Self.Width - 10, Self.Height - 10, Self.Width, Self.Height), ScreenToClient(Point(Msg.XPos, Msg.YPos)))
        and (((Self as TControl).Name = 'Panel3') or ((TControl(Self).Name = 'Panel1')))then
    Msg.Result := HTBOTTOMRIGHT;
end;



Теперь, как бы грамотно проконтролировать, чтобы панельку нельзя было растянуть ниже и правее лежащих компонентов?
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547420
Фотография wadman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ДокТеперь, как бы грамотно проконтролировать, чтобы панельку нельзя было растянуть ниже и правее лежащих компонентов?
wadmanControlAtPos поможет...
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547448
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ДокТеперь, как бы грамотно проконтролировать, чтобы панельку нельзя было растянуть ниже и правее лежащих компонентов?
ИМХО: определить какие конкретно компоненты ограничивают её размер и при ресайзе проверять что Left + Width панели < Left того компонента.
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547450
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ДокСделал так (для частного случая)
Код: pascal
1.
        and (((Self as TControl).Name = 'Panel3') or ((TControl(Self).Name = 'Panel1')))then

[/spoiler]

Раз уж всё равно наследуешь, то сделай новое свойство: Sizeable: Boolean и выставляй/проверяй его, чем такие извращения. А если ты завтра панельку переименуешь?..
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547493
Tactical Nuclear Penguin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alekcvpДокСделал так (для частного случая)
Код: pascal
1.
        and (((Self as TControl).Name = 'Panel3') or ((TControl(Self).Name = 'Panel1')))then

[/spoiler]

Раз уж всё равно наследуешь, то сделай новое свойство: Sizeable: Boolean и выставляй/проверяй его, чем такие извращения. А если ты завтра панельку переименуешь?..

где там наследник? хак за который надо чтонть отрывать...
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547495
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Tactical Nuclear Penguinгде там наследник? хак за который надо чтонть отрывать...
Нормальный хак, сначала на нём всё что нужно отлаживаешь, потом в отдельный компонент переносишь :)
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547586
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alekcvpРаз уж всё равно наследуешь, то сделай новое свойство: Sizeable
хотел было отказаться от него, но с учетом последнего условия, видимо, придется менять этот флаг в OnMouseDown/OnMouseUp панельки. Там же и координаты "ограничивающего" компонента задавать.

Tactical Nuclear Penguinхак за который надо чтонть отрывать...
это лазарь, там штатными средствами, имхо, немногого можно добиться. Надеюсь, что хак некритичный и без подводных камней. Щас на винде запилю, потом в в линуксе попробую
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39547587
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alekcvpпотом в отдельный компонент переносишь :)
ага, этот следующий после своего аналога RaizePageControl
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39548412
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Резюмирую свои мучения.

Поскольку проект Лазаревый, то виндовое АПИ так и не удалось запустить под Линукс, ибо нету в сорцах под никсы некоторых констант (HTBOTTOMRIGHT и его родственников). Потому пришлось идти обходным путем. Чтобы уж совсем по феншую было, написал наследника в отдельном юните (слизал отсюдова ). Единственное, переписал Paint, чтобы grip size hbcjdfkcz уж наверняка и не зависел от наличия в системе шрифтов
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
procedure TSizeablePanel.Paint;
var
  EdgeMarg: Integer;
begin
  inherited Paint;
  with Canvas do
  begin
    Pen.Style:= psSolid;
    Pen.Width:= 1;
    Pen.Color:= clGray;
    EdgeMarg:= 3;
    MoveTo(Self.ClientWidth - 6,Self.ClientHeight - EdgeMarg);
    LineTo(Self.ClientWidth - EdgeMarg,Self.ClientHeight - 6);
    MoveTo(Self.ClientWidth - 9,Self.ClientHeight - EdgeMarg);
    LineTo(Self.ClientWidth - EdgeMarg,Self.ClientHeight - 9);
    MoveTo(Self.ClientWidth - 12,Self.ClientHeight - EdgeMarg);
    LineTo(Self.ClientWidth - EdgeMarg,Self.ClientHeight - 12);
  end;
end; 


В результате получил нужное. Единственное, картинка лагает на линуксе. Но это вероятно, из-за слабенькой видеокарты (если у кого линь основной ОСью, проверьте, плз, - сорцы приложил)



...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39548440
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ДокНо это вероятно, из-за слабенькой видеокарты
Это не из-за видеокарты, и вообще не лаги. Это просто не работает захват мыши. Кстати, т.к. у панели по дефолту включен стиль csCaptureMouse, то самостоятельно захватом рулить не нужно.
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39548565
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev AlexeyЭто не из-за видеокарты, и вообще не лаги. Это просто не работает захват мыши.
Можешь поподробнее? Где и что в системе посмотреть? Подобная хр@нь иногда наблюдалась в gnome classic на debian 7, когда пытался ресайзить какое-либо окно. Сейчас все линуксы стоят в виртуалке, на убунте еще не смотрел.

Кстати, если не трудно, погляди проект у себя...
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39548656
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ДокГде и что в системе посмотреть?
Это не системная проблема, это "особенности" работы GTK-виджетсета. В общем, когда ты после захвата мыши меняешь экранный курсор, то сообщения мыши начинают приходить в обычном режиме (т.е. в контрол над которым находится курсор). Решается назначением курсора контролу.

Кстати, можешь оформить баг-репорт и посмотреть, как скоро его закроют ;)

Пример, где ресайз делается сильно проще :)
Код: 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.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
   fdx, fdy : Integer;
   fresize : boolean;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin

 if (GetCaptureControl = panel1) and fresize then
  panel1.SetBounds(panel1.left, panel1.top, x + fdx, y + fdy);

end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  panel1.cursor := crDefault;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const

 sizeGripSize = 17;

begin

  fdx := panel1.width - x;
  fdy := panel1.height - y;

  fresize := (fdx < sizegripSize) and (fdy < sizeGripSize);

  if fresize then
   panel1.Cursor := crHandPoint;

end;

end.

...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39548658
Kazantsev Alexey
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev AlexeyGTK-виджетсета
лазарусовского GTK-виджетсета
...
Рейтинг: 0 / 0
Как передать сендер в обработчик сообщений
    #39548908
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Kazantsev Alexeyлазарусовского GTK-виджетсета
Да ты просто волшебник :)

Немного поправил твой код (курсор crSizeNWSE при наведении не отображался)
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
procedure TSizeablePanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
//<skiped>

  if PtInRect(Rect(Self.ClientWidth - sizeGripSize, Self.ClientHeight - sizeGripSize,
              Self.ClientWidth, Self.ClientHeight), ScreenToClient(Mouse.CursorPos))
    then
      Cursor := crSizeNWSE
    else
      Cursor:= crDefault;
end;



Тормоза пропали



Кстати, народ писал , что при достаточных ресурсах машины GTK-виджет работает нормально даже при выше приведенном коде.

В любом случае, спасибо за помощь и пояснения

зы. для идущих следом модуль приложил
...
Рейтинг: 0 / 0
25 сообщений из 47, страница 1 из 2
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Как передать сендер в обработчик сообщений
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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