TGraphicControlから派生したdelphiコンポーネントを作成しました。マウスホイールのサポートを追加することは可能ですか？
- - 編集 - -
以下に示すようにMouseWheelイベントを公開しましたが、呼び出されません。
TMyComponent = class(TGraphicControl)
published
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
end;
- - 編集 - -
以下に示すように、WM_MOUSEWHEELメッセージとCM_MOUSEWHEELメッセージをトラップしようとしましたが、機能していないようです。しかし、私はなんとかCM_MOUSEENTERメッセージをトラップすることができました。あるタイプのメッセージをトラップできるのに、他のタイプのメッセージをトラップできない理由がわかりません。
いくつかの VCL コンストラクト (それらが意図的な実装の選択であるか、バグである可能性があります1)があるため、フォーカスされたコントロールとそのすべての親のみがマウス ホイール メッセージを取得し、マウスがキャプチャされたコントロールと集中した親を持っています。
レベルではTControl、後者の条件を強制できます。CM_MOUSEENTERマウスがコントロールのクライアント スペースに入ると、コントロールは VCL からメッセージを受け取ります。強制的にマウス ホイール メッセージを受信するには、その親にフォーカスし、そのメッセージ ハンドラーでマウスをキャプチャします。
procedure TWheelControl.CMMouseEnter(var Message: TMessage);
begin
FPrevFocusWindow := SetFocus(Parent.Handle);
MouseCapture := True;
inherited;
end;
ただし、これらの設定は、マウスがコントロールから出たときに元に戻す必要があります。コントロールは現在マウスをキャプチャしているCM_MOUSELEAVEため、受信されていないため、たとえばWM_MOUSEMOVEメッセージハンドラーでこれを手動で確認する必要があります。
procedure TWheelControl.WMMouseMove(var Message: TWMMouseMove);
begin
if MouseCapture and
not PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then
begin
MouseCapture := False;
SetFocus(FPrevFocusWindow);
end;
inherited;
end;
ここで、コントロールによって受信されたホイール メッセージが続いてOnMouseWheel、OnMouseWheelDownおよびOnMouseWheelUpイベントを発生させると仮定します。しかし、いや、もう 1 つ介入が必要です。メッセージは、MouseWheelHandlerたまたまフォームまたはアクティブ コントロールのいずれかにメッセージを渡すコントロールに入ります。これらのイベントを発生させるには、CM_MOUSEWHEEL制御メッセージを送信する必要があります。
procedure TWheelControl.MouseWheelHandler(var Message: TMessage);
begin
Message.Result := Perform(CM_MOUSEWHEEL, Message.WParam, Message.LParam);
if Message.Result = 0 then
inherited MouseWheelHandler(Message);
end;
この最終コードは次のようになります。
unit WheelControl;
interface
uses
System.Classes, Winapi.Windows, Winapi.Messages, Vcl.Controls;
type
TWheelControl = class(TGraphicControl)
private
FPrevFocusWindow: HWND;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
public
procedure MouseWheelHandler(var Message: TMessage); override;
published
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
end;
implementation
{ TWheelControl }
procedure TWheelControl.CMMouseEnter(var Message: TMessage);
begin
FPrevFocusWindow := SetFocus(Parent.Handle);
MouseCapture := True;
inherited;
end;
procedure TWheelControl.MouseWheelHandler(var Message: TMessage);
begin
Message.Result := Perform(CM_MOUSEWHEEL, Message.WParam, Message.LParam);
if Message.Result = 0 then
inherited MouseWheelHandler(Message);
end;
procedure TWheelControl.WMMouseMove(var Message: TWMMouseMove);
begin
if MouseCapture and
not PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then
begin
MouseCapture := False;
SetFocus(FPrevFocusWindow);
end;
inherited;
end;
end.
ご覧のとおり、これはフォーカスされたコントロールを変更します。これは、Windows ベースのデスクトップ アプリケーションのユーザー エクスペリエンス ガイドラインに反しており、フォーカスされたコントロールが明示的にフォーカスされた状態である場合、視覚的な混乱を招く可能性があります。
別の方法として、デフォルトの VCL マウス ホイール処理をすべてオーバーライドApplication.OnMessageしてバイパスし、そこで処理することもできます。これは、次のように行うことができます。
unit WheelControl2;
interface
uses
System.Classes, Winapi.Windows, Winapi.Messages, Vcl.Controls, Vcl.AppEvnts,
Vcl.Forms;
type
TWheelControl = class(TGraphicControl)
published
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
end;
implementation
type
TWheelInterceptor = class(TCustomApplicationEvents)
private
procedure ApplicationMessage(var Msg: tagMSG; var Handled: Boolean);
public
constructor Create(AOwner: TComponent); override;
end;
procedure TWheelInterceptor.ApplicationMessage(var Msg: tagMSG;
var Handled: Boolean);
var
Window: HWND;
WinControl: TWinControl;
Control: TControl;
Message: TMessage;
begin
if Msg.message = WM_MOUSEWHEEL then
begin
Window := WindowFromPoint(Msg.pt);
if Window <> 0 then
begin
WinControl := FindControl(Window);
if WinControl <> nil then
begin
Control := WinControl.ControlAtPos(WinControl.ScreenToClient(Msg.pt),
False);
if Control <> nil then
begin
Message.WParam := Msg.wParam;
Message.LParam := Msg.lParam;
TCMMouseWheel(Message).ShiftState :=
KeysToShiftState(TWMMouseWheel(Message).Keys);
Message.Result := Control.Perform(CM_MOUSEWHEEL, Message.WParam,
Message.LParam);
Handled := Message.Result <> 0;
end;
end;
end;
end;
end;
constructor TWheelInterceptor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OnMessage := ApplicationMessage;
end;
initialization
TWheelInterceptor.Create(Application);
end.
イベントのHandledパラメーターをに設定するように注意してください。そうしないと、フォーカスされたコントロールもスクロールします。MouseWheel*True
フォーカスの代わりにカーソル下のコントロールにマウスホイール入力を指示する方法も参照してください。マウス ホイールの処理に関する背景と、より一般的な解決策については、 を参照してください。
1) Quality Central バグ レポート #135258およびQuality Central バグ レポート #135305を参照してください。
TGraphicControlTControlは既にマウスホイールをサポートしています。wm_MouseWheelメッセージ、、、、DoMouseWheelおよびメソッド、およびDoMouseWheelDownプロパティを参照してください。DoMouseWheelUpMouseWheelHandlerWheelAccumulator
マウス ホイール メッセージを受信できるのは、TWinControl の子孫だけです。TGraphicControl は Window ベースのコントロールではないため、できません。VCL がメッセージを TGraphicControl にルーティングする場合は機能する可能性がありますが、そうではないようです。TCustomControl から派生することができ、それが機能します。
私も同じ問題を抱えてる。まだ解決策を見つけられていませんが、これが役立つかもしれません：
APIヘルプによると、他のコンポーネントがWin APIメソッドSetCaptureを呼び出していると思われます。
「SetCapture 関数は、マウス キャプチャを現在のスレッドに属する指定されたウィンドウに設定します。ウィンドウがマウスをキャプチャすると、カーソルがそのウィンドウの境界内にあるかどうかに関係なく、すべてのマウス入力がそのウィンドウに送られます。ウィンドウごとにマウスをキャプチャできます。」
新しいユーザーとして、スレッド全体へのリンクを投稿できません。
編集済み
コンポーネントを TCustomControl の子孫として作成すると、次のように問題を解決できます。
WM_MOUSEWHEEL メッセージをトラップします。