PHP DM Gate v0.9 » Перехват сообщения WM_MOUSEWHEEL <span class="vd">[D7, WinXP]</span>

LarryFlint © (22.03.12 20:55) [0]

Многоуважаемые мастера.
Пробую создать свой первый компонент. Наследник - TEdit (не TCustomEdit потому что проба, если все получится, перепишу правильно)
Некий аналог SpinEdit, но без кнопок, вместо кнопок реакция на ващение колеса мыши.
Не судите строго, понимаю что неправильно, подскажите где неправильно?
unit GsvDgtEdit;

interface

uses
SysUtils, Classes, Controls, StdCtrls, Messages;

type
TGsvDgtEdit = class(TEdit)
private
FDigit: Integer;
FMouseWheel: TNotifyEvent;
function GetDigit: Integer;
procedure SetDigit(value:Integer);
protected
procedure KeyPress(var Key: Char); override;
procedure MouseWheel (Var Msg: TWMMOUSEWHEEL; Value: Integer); message WM_MOUSEWHEEL ;
property OnMouseWheel: TNotifyEvent read FMouseWheel write FMouseWheel;
public
{ Public declarations }
published
constructor Create(AOwner: TComponent); override;
property Digit: Integer read GetDigit write SetDigit;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('MyComponent', [TGsvDgtEdit]);
end;

constructor TGsvDgtEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;

function TGsvDgtEdit.GetDigit: Integer;
begin
try
Result:=StrToInt(text);
except on EConvertError do
begin
Result := 0; text := '';
end;
end;
end;

procedure TGsvDgtEdit.SetDigit(Value: Integer);
begin
FDigit := Value;
Text := IntToStr(value);
end;

procedure TGsvDgtEdit.KeyPress(var key: char);
begin
case key of
'0'..'9', #8, #13: ;
'-': if Length(text) <> 0 then key := #0;
else
key := #0;
end;
inherited KeyPress(key);
end;

procedure TGsvDgtEdit.MouseWheel (Var Msg: TWMMOUSEWHEEL; Value: Integer);
begin
FDigit := Value;

if Msg.WheelDelta > 0 then
begin
Value:= Value+1;
Text := IntToStr(value);
end
else
begin
Value:= Value-1;
Text := IntToStr(value);
end;
end; {}
end.

<Цитата>
DimaBr © (23.03.12 10:00) [1]

TGsvDgtEdit = class(TEdit)
private
function GetValue: Integer;
procedure SetValue(const AValue: Integer);
protected
procedure KeyPress(var Key: Char); override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;override;
published
property Value: Integer read GetValue write SetValue;
property OnMouseWheel;
end;

implementation

function TGsvDgtEdit.GetValue: Integer;
begin
TryStrToInt(Text,Result);
end;

procedure TGsvDgtEdit.SetValue(const AValue: Integer);
begin
Text := IntToStr(AValue);
end;

procedure TGsvDgtEdit.KeyPress(var key: char);
begin
case key of
'0'..'9', #8, #13: ;
'-': if Length(text) <> 0 then key := #0;
else Key := #0;
end;
inherited KeyPress(key);
end;

function TGsvDgtEdit.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
var V: integer;
begin
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
if not Result then Exit;
V := Value;
inc(V,Sign(WheelDelta));
Text := IntToStr(V);
end;

<Цитата>
Cobalt © (23.03.12 11:57) [2]

А в чем вопрос-то был?
Что-то не работало? Или работало не так?

<Цитата>
DimaBr © (23.03.12 14:41) [3]

> Cobalt © (23.03.12 11:57) [2]
Просто нет такого метода для диспетчеризации
procedure MouseWheel (Var Msg: TWMMOUSEWHEEL; Value: Integer);

<Цитата>
LarryFlint © (23.03.12 22:09) [4]

Спасибо за помощь.
Собственно дело, в первую очередь, не в самом компоненте (хотя и компонент то-же нужен), а в том что-бы попробовать и понять, как создавать компоненты.
С полем FDigit все понятно - не нужно оно, просто свойство Value с доступом через методы Getxxx и Setxxx.
inherited DoMouseWheel - перекрываем родительский метод, доставшийся в наследство от TControl.
Только все равно не работает. Правда я переделал - унаследовал от TCustomEdit, может быть в этом дело?
Т.е. событие OnMouseWheel у нового компонента есть и если написать обработчик

procedure TForm1.GsvDigitEdit1MouseWheel(Sender: TObject;
Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
begin
if WheelDelta<0 then
GsvDigitEdit1.Value:=GsvDigitEdit1.Value+1
else
GsvDigitEdit1.Value:=GsvDigitEdit1.Value-1;
end;

то работает. Но смысл был в том чть-бы компонент без обработчика реагировал на колесо.
И дело очевидно не в

inc(V,Sign(WheelDelta));

потому что так то-же не работает

function TGsvDigitEdit.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
var V: integer;
begin
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
if not Result then Exit;
V := Value;
//inc(V,Sign(WheelDelta));
if WheelDelta<0 then V:=V+1 else V:=V-1;

Value:=V;
Text := IntToStr(V);
end;

<Цитата>
DimaBr © (23.03.12 23:26) [5]

> LarryFlint © (23.03.12 22:09) [4]
Вы думаете я подсунул вам нерабочий код ?

<Цитата>
DimaBr © (23.03.12 23:27) [6]

Если вы не копировали а переписывали, то возможно вкралась ошибочка

<Цитата>
LarryFlint © (24.03.12 01:01) [7]

> Вы думаете я подсунул вам нерабочий код ?

Не думаю.
inc(V,Sign(WheelDelta));

- точно работает, во всяком случае в обработчике OnMouseWheel.
Код я копировал, поэтому ошибка моловероятна.
Меня больше интересует ПОЧЕМУ не работает, чем правильный код.
Не совсем понятна строка -
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);

сначала присваеваим результату функции значение возвращенное родительской функцией, затем используем результат функции в самой функции.
if not Result then Exit;

Что я понял неправильно?

<Цитата>
LarryFlint © (24.03.12 01:39) [8]

В любом случае ОГРОМНОЕ СПАСИБО.
Видимо я правильно сомневался, вот так работает -
function TGsvDigitEdit.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
var V: integer;
begin
inherited DoMouseWheel(Shift, WheelDelta, MousePos); //Result :=
//if not Result then Exit;
V := Value;
//inc(V,Sign(WheelDelta));
if WheelDelta<0 then V:=V+1 else V:=V-1;

Value:=V;
Text := IntToStr(V);
end;

Теперь буду взрывать себе мозг пытаясь понять почему так работает, а предидущий вариант нет, и какая в данном случае связь между:
function DoMouseWheel(...);

объявляем метод одноименный с методом предка
inherited DoMouseWheel(Shift, WheelDelta, MousePos)

- и вызываем родительский в перекрывающем методе

property OnMouseWheel;

объявляем свойство-событие, видимо одноименное с свойством-событием одного из предков, и ...
и все.
Взрыв мозга

<Цитата>
DimaBr © (25.03.12 00:28) [9]

1. Вы перекрываете ФУНКЦИЮ, следовательно сначала нужно получить результат унаследованной (в которой и вызовется обработчик OnMouseWheel и пользователь вашего компонента например отменит действие)
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);

2. Далее проверяем результат, и если действие отменено, то не изменяем текущее значение а просто уходим
if not Result then Exit;

Можно было бы написать так, но мне так не нравиться
if Result then begin
// действия по изменению текущего значения Edit-a
end;

3.
property OnMouseWheel;

- Открываем свойство, чтобы оно было доступно в инспекторе

<Цитата>
LarryFlint © (25.03.12 21:06) [10]

Спасибо за разъяснения.
...\Delphi\...\Controls.pas (возможно ошибаюсь в имени файла)

property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;

function TControl.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
....
if Assigned(FOnMouseWheel) then
FOnMouseWheel(Self, Shift, WheelDelta, MousePos, Result);

Здесь и возникает связь между DoMouseWheel и property OnMouseWheel.
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);

- здесь вызывается обработчик если таковой имеет место быть в программе
if Assigned(FOnMouseWheel)

Если не надо что-бы пользователь (компонента) переопределял OnMouseWheel опускаем
published
...
property OnMouseWheel;

if Result then begin
// действия по изменению текущего значения Edit-a
end;

- Такая мысль у меня возникала, но смысла в этом не вижу, да и
if not Result then Exit;

- изящней

Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);

- используем имеющуюся переменную Result, раз уж это допустимо, что-бы не городить огород с внутренней переменной типа Boolean. (Здесь не уверен)

Судя по результатам, в :
if not Result then Exit;

- Result = false

Не пойму, как пользователь может отменить действие? Понятно что в
procedure TForm1.GsvDigitEdit1MouseWheel

Но как?
Еще раз спасибо за ответы.

<Цитата>
DimaBr © (25.03.12 21:35) [11]

Заглянем в Controls.pas
function TControl.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
var
IsNeg: Boolean;
begin
Result := False;
if Assigned(FOnMouseWheel) then
FOnMouseWheel(Self, Shift, WheelDelta, MousePos, Result);
if not Result then
begin
Inc(FWheelAccumulator, WheelDelta);
while Abs(FWheelAccumulator) >= WHEEL_DELTA do
begin
IsNeg := FWheelAccumulator < 0;
FWheelAccumulator := Abs(FWheelAccumulator) - WHEEL_DELTA;
if IsNeg then
begin
if FWheelAccumulator <> 0 then FWheelAccumulator := -FWheelAccumulator;
Result := DoMouseWheelDown(Shift, MousePos);
end
else
Result := DoMouseWheelUp(Shift, MousePos);
end;
end;
end;

Вон оно то самое место, где вызывается обработчик пользователя
FOnMouseWheel(Self, Shift, WheelDelta, MousePos, Result);

Если пользователь в своём коде напишет
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
Handled := true;
end;

То следующий оператор
if not Result then

приведёт к тому что остальной код работать не будет. Тоже самое делает и мы

<Цитата>
LarryFlint © (25.03.12 23:15) [12]

Нечто подобное я и ожидал:
Handled := true;

Как раз сегодня у Фаронова читал, правда мало что понял.
Что-то вроде: не принимать сообщений от родителя (или собственника, разницу уже понял, но еще не осознал) или не передовать сообщение дочернему компоненту.

в принципе можно ввести что-нибудь типа
published
...
property IsMouseWheel: Boolean;

в инспекторе поставил false и не реагирует на колесо

в остальном вроде бы все правильно понял?
И еще раз Спасибо.

<Цитата>
DimaBr © (26.03.12 10:40) [13]

Этих свойств можно наделать кучу, только зачем их хранить в ресурсе. Такая ситуация бывает очень редко, плюс возможно реагировать только например на прокрутку вперёд или на прокрутку в определённой области окна, такое свойствами не опишешь.

<Цитата>
LarryFlint © (26.03.12 12:26) [14]

Видимо нужен баланс между простотой самого компонента и простотой его использования. Изменить свойство в инспекторе или писать обработчик. Это, как я понимаю, уже вопрос хорошего тона в програмировании.

<Цитата>