VPF::TScrollBar и OnMouseUp - Форум программистов

Doga

Дата 6.3.2008, 20:32 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 115
Регистрация: 20.12.2007
Где: Россия, Обнинск

Репутация: нет
Всего: нет

Всем привет.

Возникла необходимость реализовать событие OnMouseUp в наследнике класса TScrollBar. Собственно, само событие вытащить в секцию published класса удалось легко, однако оно не возникает, если отпускается левая кнопка мыши (с правой кнопкой всё в порядке). Похоже сообщение WM_LBUTTONUP блокируется на уровне предков класса TScrollBar, т.е. в классе TWinControl или даже в TControl.

Подскажите, пожалуйста, как обойти эту проблему, если это вообще возможно...

lukas

Дата 6.3.2008, 21:25 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 771
Регистрация: 23.2.2007

Репутация: 3
Всего: 15

Doga,

так мало его вытащить, нужно еще сообщения отлавливать:

Код


 Type
  TMyScrollBar = class(TScrollBar)
 private
   FOnMouseDown: TMouseMoveEvent;
 protected
   DoMouseDown (var Msg: TMessage); message WM_LBUTTONDOWN;
 published
   OnMouseDown:  TMouseMoveEvent read FOnMouseDown write FOnMouseDown;
 end;


...
...
...

procedure TMyScrollBar.DoMouseDown(var Msg: TMessage);
begin
 if Assigned(FOnMouseDown) then FOnMouseDown(Self,mbLeft,0,0);
end;

Это сообщение отредактировал(а) lukas - 6.3.2008, 21:27

--------------------

http://code.google.com/p/orionphp/ - opensource скриптовой язык Orion (аналог PHP) для freepascal/delphi.

Doga

Дата 7.3.2008, 14:29 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 115
Регистрация: 20.12.2007
Где: Россия, Обнинск

Репутация: нет
Всего: нет

Спасибо lukas.

Правда мне был нужен не OnMouseDown, а OnMouseUp. Но поскольку OnMouseDown в TScrollBar тоже нет, можно считать что это пригодится тож. smile

Однако для меня остаётся не понятным следующее. TControl, предок предка TScrollBar, уже имеет переменную FOnMouseDown. Так же имеется набор необходимых прцедур для работы с событием WM_LBUTTONDOWN.

Код


procedure TControl.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y);
end;

procedure TControl.DoMouseDown(var Message: TWMMouse; Button: TMouseButton;
  Shift: TShiftState);
begin
  if not (csNoStdEvents in ControlStyle) then
    with Message do
      if (Width > 32768) or (Height > 32768) then
        with CalcCursorPos do
          MouseDown(Button, KeysToShiftState(Keys) + Shift, X, Y)
      else
        MouseDown(Button, KeysToShiftState(Keys) + Shift, Message.XPos, Message.YPos);
end;

//Обработчик события WM_LBUTTONDOWN
procedure TControl.WMLButtonDown(var Message: TWMLButtonDown);
begin
  SendCancelMode(Self);
  inherited;
  if csCaptureMouse in ControlStyle then MouseCapture := True;
  if csClickEvents in ControlStyle then Include(FControlState, csClicked);
  DoMouseDown(Message, mbLeft, []);
end;

Почему нельзя воспользоваться уже готовой функциональностью? Чем Ваш вариант лучше?

Теперь что касается OnMouseUp. Здесь ситуация аналогичная. В Tcontrol уже есть и само свойство OnMouseUp, и переменная FOnMouseUp, необхдимая для работы с этим свойством, и необходимый набор процедур.

Код


procedure TControl.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X, Y);
end;

procedure TControl.DoMouseUp(var Message: TWMMouse; Button: TMouseButton);
begin
  if not (csNoStdEvents in ControlStyle) then
    with Message do MouseUp(Button, KeysToShiftState(Keys), XPos, YPos);
end;

procedure TControl.WMLButtonUp(var Message: TWMLButtonUp);
begin
  inherited;
  if csCaptureMouse in ControlStyle then MouseCapture := False;
  if csClicked in ControlState then
  begin
    Exclude(FControlState, csClicked);
    if PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then Click;
  end;
  DoMouseUp(Message, mbLeft);
end;

procedure TControl.WMRButtonUp(var Message: TWMRButtonUp);
begin
  inherited;
  DoMouseUp(Message, mbRight);
end;

procedure TControl.WMMButtonUp(var Message: TWMMButtonUp);
begin
  inherited;
  DoMouseUp(Message, mbMiddle);
end;

Я считал, что в общем случае, достаточно перенести свойство OnMouseUp в секцию published, тогда для его поддержки автоматически должна будет использоваться существующая функциональность класса. Да, мне кажется так и происходит - я уже говорил, что событие OnMouseUp (в моём варианте) реагирует по крайней мере на WM_RBUTTONUP. Проблема только с WM_LBUTTONUP.

В чём я не прав?

lukas

Дата 7.3.2008, 18:24 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 771
Регистрация: 23.2.2007

Репутация: 3
Всего: 15

да по всей видимосту у предка это свойство просто Абстрактное, т.е. без функциональности...

--------------------

http://code.google.com/p/orionphp/ - opensource скриптовой язык Orion (аналог PHP) для freepascal/delphi.

Doga

Дата 7.3.2008, 19:50 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 115
Регистрация: 20.12.2007
Где: Россия, Обнинск

Репутация: нет
Всего: нет

Не согласен. smile

Создать экземпляр абстрактного класса нвозможно. Это следствие свойств абстрактных классов.
Как известно, TScrollBar таким недостатком не страдает.

Дело в чём то другом, но только не в этом...

lukas

Дата 7.3.2008, 21:03 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 771
Регистрация: 23.2.2007

Репутация: 3
Всего: 15

Doga,

да... а вообще то должно и в твоем случае работать, хм... с combobox-om у меня все получалось отлично...

Это сообщение отредактировал(а) lukas - 7.3.2008, 21:04

--------------------

http://code.google.com/p/orionphp/ - opensource скриптовой язык Orion (аналог PHP) для freepascal/delphi.

Rrader

Дата 8.3.2008, 07:07 (ссылка)

(нет голосов)

Загрузка ...

Inspired =)

Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191

http://support.microsoft.com/kb/102552

--------------------

Let's do this quickly!
Rest in peace, Vit!

Doga

Дата 10.3.2008, 20:24 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 115
Регистрация: 20.12.2007
Где: Россия, Обнинск

Репутация: нет
Всего: нет

2Rrader. Я понял, спасибо.

А вообще, решение проблемы OnMouseUp существовало до моего вопроса. Собственно, и проблемы то не было. Достаточно было в событии OnScroll отслеживать значение параметра ScrollCode (TScrollCode). ScrollCode становится равным scEndScroll, когда отпускается левая кнопка мыши или клавиша на клавиатуре.
Более того, в связи с этим, отпала необходимость в наследнике TScrollBar'а. smile

Сказать по правде, раньше никогда не обращал внимания на этот параметр. Век живи - век учись... smile

Так что, всем спасибо, решение найдено, вопрос снят. smile

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »