Обработчик OnMouseWheel (Down, Up)

[Alex2]

Как сделать, чтобы работал обработчик OnMouseWheel когда мышь находится над объектом типа TPaintBox. Я сделал потомка от TPaintBox с опубликованными свойствами OnMouseWheel, OnMouseWheelDown, OnMouseWheelUp. Сделал соответствующую процедуру, но обработчик не работает. В чем здесь может быть дело?

[asmodey1]

procedure TForm1.PaintBox1MouseEnter(Sender: TObject);
begin
B := True;
end;

procedure TForm1.PaintBox1MouseLeave(Sender: TObject);
begin
B := False;
end;

TPaintBox является потомком TControl-а, а у TControl-а нет таких событий.
Каким это образом вам удалось "опубликовать" несуществующие события ?

[chertovich]

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if B then
    ShowMessage('Курсор над PaintBox')
  else
    ShowMessage('Курсор не над PaintBox')
end;

procedure TForm1.PaintBox1MouseEnter(Sender: TObject);
begin
  B := True;
end;

procedure TForm1.PaintBox1MouseLeave(Sender: TObject);
begin
  B := False;
end;

[asmodey1]

И что ? Работает ?
С таким же успехом можно написать:

procedure TForm1.PaintBox1TraTaTa(Sender: TObject);
begin
ShowMessage('А вот фигушки !');
end;

И тоже не будет никакой реакции...

[Alex2]

Сообщение от asmodey1

TPaintBox является потомком TControl-а, а у TControl-а нет таких событий.
Каким это образом вам удалось "опубликовать" несуществующие события ?

ну как же нету, см. 856 строчку модуля Controls

    property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
    property OnMouseWheelDown: TMouseWheelUpDownEvent read FOnMouseWheelDown
      write FOnMouseWheelDown;
    property OnMouseWheelUp: TMouseWheelUpDownEvent read FOnMouseWheelUp write
      FOnMouseWheelUp;

Очень интересно, как chertovich сгенерировал код?

procedure TForm1.PaintBox1MouseEnter(Sender: TObject);
begin
  B := True;
end;

у TPaintBox нет же события MouseEnter. Не вручную же он это писал? ))))

Я смастерил нечто, что работает. Вот код, в которым я тупо повторил приватные процедуры TControl, сделав их публичными:

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TMyPaintBox=class(TPaintBox)
    public
      procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
      procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  end;
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  B:boolean;
  pBox: TMyPaintBox;
implementation

{$R *.dfm}

{ TMyPaintBox }

procedure TMyPaintBox.CMMouseEnter(var Message: TMessage);
begin
  if Parent <> nil then
  begin
    Parent.Perform(CM_MOUSEENTER, 0, Longint(Self));
    B:=true;
  end;
end;

procedure TMyPaintBox.CMMouseLeave(var Message: TMessage);
begin
  if Parent <> nil then
  begin
    Parent.Perform(CM_MOUSELEAVE, 0, Longint(Self));
    B:=false;
  end;
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
  pBox:=TMyPaintBox.Create(Self);
  pBox.Parent:=Self;
  pBox.Left:=0;
  pBox.Top:=0;
  pBox.Width:=200;
  pBox.Height:=200;
end;

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var i:integer;  
begin
  if B then
    i:=1
  else
    i:=0;
end;

end.

Тут оптимизатор компилятора нам здесь "помогает", но если отслеживать дебаггером строчку " if B then", то можно убедиться, что всё работает.

[Alex2]

chertovich, идея понятна - обрабатываем событие прокрутки, идущее от формы. Осталось только добавить условие - курсор - над PaintBox-ом. Казалось бы, что тип Sender-а даст нам TPaintBox - вот вам и контроль нахождения курсора над нужным компонентом, но Sender - не от PainBox-а. Второй вариант - проверять вхождение и выхождение мыши на компонент, что и предложил chertovich. И всё же, всё же, почему же не работает обработчик у потомка с опубликованными свойствами для прокрутки колёсика мыши?

[chertovich]

У меня D2009 (в отличие от D7) и в нем класс TControl имеет такой функционал, несмотря на то, что это не TWinControl. Наверное, эти события эмулируются путем предка компонента. Для тех у кого нет таких событий, можно, например определять положение курсора и соотностить к положению самого компонента.
Есть еще вариант: написать свой компонент наследованием TWinControl и добавить к нему канву. А можно сделать еще с полосами прокрутки, наследуя TScrollingWinControl ))