Спасибо lukas.
Правда мне был нужен не OnMouseDown, а OnMouseUp. Но поскольку OnMouseDown в TScrollBar тоже нет, можно считать что это пригодится тож. 
Однако для меня остаётся не понятным следующее. 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.
В чём я не прав? |
