Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Как передать сендер в обработчик сообщений / 25 сообщений из 47, страница 1 из 2
03.11.2017, 09:14:36
    #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
03.11.2017, 09:26:30
    #39547167
wadman
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как передать сендер в обработчик сообщений
Док1. Как задать координаты правого нижнего угла (с помощью относ. координат)?
Они уже заданы. Уточни вопрос.
Док2. Как задать данный обработчик только для одного конкретного экземпляра этого класса (например, только для Panel2)?
Добавь булево свойство, которое будет активировать обработчик.
...
Рейтинг: 0 / 0
03.11.2017, 09:42:50
    #39547173
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как передать сендер в обработчик сообщений
wadmanОни уже заданы. Уточни вопрос.
как задать в обработчике координаты Rect(0,0,10,10) в нижнем правом углу?
...
Рейтинг: 0 / 0
03.11.2017, 09:52:45
    #39547180
wadman
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как передать сендер в обработчик сообщений
ДокwadmanОни уже заданы. Уточни вопрос.
как задать в обработчике координаты Rect(0,0,10,10) в нижнем правом углу?
Имеешь в виду Height-10 и Width-10?
...
Рейтинг: 0 / 0
03.11.2017, 10:12:57
    #39547198
alekcvp
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как передать сендер в обработчик сообщений
ДокПытаюсь поменять мышом размер панели в RT.
...
2. Как задать данный обработчик только для одного конкретного экземпляра этого класса (например, только для Panel2)?

Вот тут официальный пример от эмбы.
...
Рейтинг: 0 / 0
03.11.2017, 10:14:11
    #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
03.11.2017, 11:02:29
    #39547238
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как передать сендер в обработчик сообщений
wadmanИмеешь в виду Height-10 и Width-10?
да, мне нужны именно ширина/высота изменяемой панели. Хотел как-то феншуйно, типа Sender.Width, но придется, как обычно, через поля класса реализовывать :)

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

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

[/spoiler]

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

[/spoiler]

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

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

Tactical Nuclear Penguinхак за который надо чтонть отрывать...
это лазарь, там штатными средствами, имхо, немногого можно добиться. Надеюсь, что хак некритичный и без подводных камней. Щас на винде запилю, потом в в линуксе попробую
...
Рейтинг: 0 / 0
03.11.2017, 17:37:39
    #39547587
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как передать сендер в обработчик сообщений
alekcvpпотом в отдельный компонент переносишь :)
ага, этот следующий после своего аналога RaizePageControl
...
Рейтинг: 0 / 0
06.11.2017, 15:51:41
    #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
06.11.2017, 16:47:05
    #39548440
Kazantsev Alexey
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как передать сендер в обработчик сообщений
ДокНо это вероятно, из-за слабенькой видеокарты
Это не из-за видеокарты, и вообще не лаги. Это просто не работает захват мыши. Кстати, т.к. у панели по дефолту включен стиль csCaptureMouse, то самостоятельно захватом рулить не нужно.
...
Рейтинг: 0 / 0
06.11.2017, 21:07:37
    #39548565
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как передать сендер в обработчик сообщений
Kazantsev AlexeyЭто не из-за видеокарты, и вообще не лаги. Это просто не работает захват мыши.
Можешь поподробнее? Где и что в системе посмотреть? Подобная хр@нь иногда наблюдалась в gnome classic на debian 7, когда пытался ресайзить какое-либо окно. Сейчас все линуксы стоят в виртуалке, на убунте еще не смотрел.

Кстати, если не трудно, погляди проект у себя...
...
Рейтинг: 0 / 0
07.11.2017, 00:49:15
    #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
07.11.2017, 00:52:20
    #39548658
Kazantsev Alexey
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как передать сендер в обработчик сообщений
Kazantsev AlexeyGTK-виджетсета
лазарусовского GTK-виджетсета
...
Рейтинг: 0 / 0
07.11.2017, 13:21:27
    #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
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Как передать сендер в обработчик сообщений / 25 сообщений из 47, страница 1 из 2
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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