コンポーネント内でマウスホイールのイベントに対応したいのですが (ID:38650)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

綺麗じゃないけど、こんな感じでどう？

まずは、コンポーネント。
type
  TpaintBoxB = class(TPaintBox)
  private
    { Private 宣言 }
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
    procedure MouseWheelHandler(var Message: TMessage); override;
  published
    { Published 宣言 }
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TpaintBoxB]);
end;

{ TpaintBoxB }

procedure TpaintBoxB.MouseWheelHandler(var Message: TMessage);
var
  ClientPos: TPoint;
begin
  with TCMMouseWheel(Message) do
  begin
    ClientPos := ScreenToClient(SmallPointToPoint(Pos));
    if (0 <= ClientPos.X) and (ClientPos.X <= Self.Width ) and
       (0 <= ClientPos.Y) and (ClientPos.Y <= Self.Height) then
    begin
      Result := 0;
      if DoMouseWheel(ShiftState, WheelDelta, SmallPointToPoint(Pos)) then
        Message.Result := 1
      else if Assigned(Parent) then
        with TMessage(Message) do
          Result := Parent.Perform(CM_MOUSEWHEEL, WParam, LParam);
    end;
  end;
end;

end.

本当はコンポーネントだけで済ませたかったけど
メッセージが飛んでこない？から、こんな感じで画面を作る。
type
  TForm1 = class(TForm)
    paintBoxB1: TpaintBoxB;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    procedure MouseWheelHandler(var Message: TMessage); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.MouseWheelHandler(var Message: TMessage);
begin
  paintBoxB1.MouseWheelHandler(Message);
  inherited;
end;

多分TpaintBoxBのメッセージを受ける位置がずれている。
調査したら分かるかもしれないけど、分かってもTpaintBoxB
コンポーネントだけで解決できるか微妙かも？

←解決時は質問者本人がここをチェックしてください。

戻る