☆FormのOnMouseWheelDown(Up)

CAD Viewerを作っていて、FormのOnMouseWheelDown(Up)で問題が発生しました。 CADではコードがややこしいので、下記のような簡単なもので考えてみることにします。 問題点としては、PaintBoxに描画したものをマウスホイールにより拡大縮小する 仕様なのですが、この動作によりListBoxがスクロールしてしまうことです。

問題のあるコード

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    PaintBox1: TPaintBox;
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    P: Integer;
    procedure DrawData;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  P := 0;
  Form1.OnResize := PaintBox1Paint;
  for I := 0 to 99  do
    ListBox1.Items.Add(IntToStr(I));
end;

procedure TForm1.DrawData;
var
  Rect: TRect;
begin
  // Clear
  Rect.Top := PaintBox1.Top;
  Rect.Left := PaintBox1.Left;
  Rect.Bottom := PaintBox1.Height;
  Rect.Right := PaintBox1.Width;
  // Rectangle
  PaintBox1.Canvas.FillRect(Rect);
  Rect.Top := (PaintBox1.Top + P);
  Rect.Left := PaintBox1.Left + P;
  Rect.Bottom := PaintBox1.Height - P;
  Rect.Right := PaintBox1.Width - P;
  PaintBox1.Canvas.Rectangle(Rect);
end;

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Dec(P,5);
  DrawData;
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Inc(P,5);
  DrawData;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  DrawData;
end;

end.

対策後のコード
MouseWheelDown(Up)をそれぞれ下記のようにしました。

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var
  Pt: TPoint;
begin
  GetCursorPos(Pt);
  Pt := ScreenToClient(Pt);
  if ((Pt.X > 0) and (Pt.X < PaintBox1.Width)) and
     ((Pt.Y > 0) and (Pt.Y < PaintBox1.Height)) then
  begin
    Handled := True;
    Dec(P,5);
    DrawData;
  end;
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
var
  Pt: TPoint;
begin
  GetCursorPos(Pt);
  Pt := ScreenToClient(Pt);
  if ((Pt.X > 0) and (Pt.X < PaintBox1.Width)) and
     ((Pt.Y > 0) and (Pt.Y < PaintBox1.Height)) then
  begin
    Handled := True;
    Inc(P,5);
    DrawData;
  end;
end;

これによりPaintBox1上にマウスがある場合のみPaintBox1にマウスホイールが働きます。 ListBox1をスクロールするには、ListBox1上にマウスを移動させます。