コンポーネント内でマウスホイールのイベントに対応したいのですが (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イベントの感知が出来るようになったのよ」
裕子：「え？ ナンの話？」
真琴：「ハルコさんだったら、もっと良いやり方するかもしれないけど、アタシはこれが精一杯」
裕子：「マコト、ノンキ過ぎ、ハルコさんの心配はしないの？ もう捜索願い出した方がイイんじゃない？」
真琴：「大丈夫、ハルコさんがドコに居るかは分かってるのよ、でも、いつコッチに帰るのかは…^^;」

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

戻る