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

名前

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

本文 真琴：「そろそろ梅雨入りが近いかも、ねぇ、おじいちゃん」 勝爺：「そうだな、オレのカンではたぶん来週あたり…、今のうちに屋根の修理しておくか」 真琴：「えっ、おじいちゃんが？ 落ちたりしたら大変だから、業者さんに頼んだ方がイイんじゃない？」 勝爺：「なぁに大丈夫だよ、気をつけてやるから」 真琴：「ホントに？ やっぱり心配だなぁ」 裕子：「こんにちは〜、あれ？ 何が始まるの？」 勝爺：「おぅ ユウコ、お前は何時もタイミングいいな、マコトと一緒に下でこのハシゴをおさえてくれ」 裕子：「え〜？ マサルさんがハシゴで屋根に登るの？ アタシの上には落ちてこないでよ？^^;」 【 パネルの上にPaintBoxを乗せたTPaintPanelコンポ 】 uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ThemeMgr; type TPaintPanel = class; TPaintBox = class(ExtCtrls.TPaintBox) private FPaintPanel: TPaintPanel; procedure WMLButtonDown(var Msg: TMessage); message WM_LBUTTONDOWN; procedure WMMouseWheel(var Msg: TWMMouseWheel); message WM_MOUSEWHEEL; end; TPaintPanel = class(TPanel) private FPaintBox: TPaintBox; FOnMouseWheel: TMouseWheelEvent; procedure WMMouseWheel(var Msg: TWMMouseWheel); message WM_MOUSEWHEEL; public procedure SetParent(aParent: TWinControl); override; published property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel; end; type TForm1 = class(TForm) Memo1: TMemo; ThemeManager1: TThemeManager; procedure FormCreate(Sender: TObject); private FSize: Integer; PaintPanel1: TPaintPanel; procedure PaintPanel1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); end; var Form1: TForm1; implementation {$R *.DFM} procedure TPaintPanel.SetParent(aParent: TWinControl); begin inherited; if aParent = nil then exit; // PaintPanelの内部いっぱいにPaintBoxを作成 FPaintBox := TPaintBox.Create(Self); FPaintBox.FPaintPanel := Self; FPaintBox.Parent := Self; FPaintBox.Align := alClient; //Self.ParentBackground := False; // D6以降でXPManを使う場合に必要？ end; procedure TPaintBox.WMLButtonDown(var Msg: TMessage); begin inherited; // PaintBox上でマウスの左ボタンを押したら親のPaintPanelにFocusをセット Parent.SetFocus; end; procedure TPaintBox.WMMouseWheel(var Msg: TWMMouseWheel); var p1, p2: TPoint; Handled: Boolean; begin // マウスカーソルがコンポ上にあるか？(スクリーン全体でWheelEventを起こす場合は判定不要) P1 := ClientToScreen(Point(Left, Top)); P2 := ClientToScreen(Point(Left+Width, Top+Height)); if (Msg.XPos < P1.X)or(Msg.XPos > P2.X) then exit; if (Msg.YPos < P1.Y)or(Msg.YPos > P2.Y) then exit; // カーソルがコンポ上にあってFocusがあればWheelイベント発生させる Handled := False; if Assigned(FPaintPanel.FOnMouseWheel) then begin FPaintPanel.FOnMouseWheel(FPaintPanel, KeysToShiftState(Msg.Keys), Msg.WheelDelta, ScreenToClient(Point(Msg.XPos,MSG.YPos)), Handled); exit; end; // Handledの戻り値は無視 // 必要ならここでOnMouseWheelUP、OnMouseWheelDOWNイベントを発生させる end; procedure TPaintPanel.WMMouseWheel(var Msg: TWMMouseWheel); begin // 親のPanelに来たメッセージを子のPaintBoxに横流し // このコードの追加でマウスカーソルがスクリーン上の何処にあっても感知できる FPaintBox.WMMouseWheel(Msg); end; procedure TForm1.FormCreate(Sender: TObject); begin // Form上にPaintPanelコンポを動的生成 PaintPanel1 := TPaintPanel.Create(Self); PaintPanel1.Parent := Self; //PaintPanel1.Align := alClient; PaintPanel1.Top := 50; PaintPanel1.Left := 30; PaintPanel1.Width := 400; PaintPanel1.Height := 300; PaintPanel1.Color := clYellow; // clWhite; PaintPanel1.BevelInner := bvNone; PaintPanel1.BevelOuter := bvNone; PaintPanel1.OnMouseWheel := PaintPanel1MouseWheel; FSize := 0; end; // コンポのOnMouseWheelイベントハンドラ procedure TForm1.PaintPanel1MouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); begin // マウスの各値をMemoに表示 Memo1.Lines.Add(Format('%d：%d：%.8X / %d',[MousePos.X, MousePos.Y, WheelDelta, Integer(ssShift in Shift)])); // Wheelの回転でPaintBoxに描いた赤い四角形のサイズを拡大／縮小させる with TPaintPanel(Sender) do begin Canvas.Pen.Color := clRed xor Color; Canvas.Pen.Mode := pmXOR; Canvas.PolyLine([Point(0, 0), Point(0, FSize), Point(Fsize, FSize), Point(FSize, 0), Point(0, 0)]); if (WheelDelta > 0) then begin // ホイールを奥に動かした時 if FSize > 0 then dec(FSize); end else begin // ホイールを手前に動かした時 inc(FSize); end; Canvas.PolyLine([Point(0, 0), Point(0, FSize), Point(Fsize, FSize), Point(FSize, 0), Point(0, 0)]); end; end; 勝爺：「ご苦労さん、まぁこれで雨漏りはしないだろぅ、ん？ ナンだ？ 差し出したその手は」 裕子：「バイト代の請求、…アタシも屋根の上に登らされて手伝わされたンだから、当然でしょ？」 勝爺：「それならな、後で、美味しい夕食をごちそうしてやるから…」 裕子：「ホント^^？」 勝爺：「それがバイト代のかわりだぞ」 裕子：「う〜ん、もう…いつもこんなカンジで丸め込まれちゃうんだから〜」 真琴：「ねぇ、おじいちゃん、雨漏りの原因はナンだったの？」 勝爺：「屋根のスレートのパネルがズレて隙間ができてたんだ、この前の強風のせいだろう」 真琴：「そのズレ直せたの？ じゃぁ もう大丈夫ね？ 二人ともケガしなくて良かった^^」 裕子：「屋根の上でマサルさんが危うく落ちそうになったのよ、それを助けてあげたンだから感謝してもらわないと…」 真琴：「そんな危ないコトが？ ユウコ、ありがとう、…アタシも発生場所のズレを直してコンポ内のドコでもWheelイベントの感知が出来るようになったのよ」 裕子：「え？ ナンの話？」 真琴：「ハルコさんだったら、もっと良いやり方するかもしれないけど、アタシはこれが精一杯」 裕子：「マコト、ノンキ過ぎ、ハルコさんの心配はしないの？ もう捜索願い出した方がイイんじゃない？」 真琴：「大丈夫、ハルコさんがドコに居るかは分かってるのよ、でも、いつコッチに帰るのかは…^^;」