マウスの中央のボタンのイベントを取得するには？
解決TPaintBoxを継承したコンポーネント内でprocedure WMMousewheel(var Msg: TMessage); message WM_MOUSEWHEEL宣言し使用しています。
これをＦorm1に貼り付けてマウスの中央のボタンのイベントを拾っていす。
しかし、
下記のように書いただけでは基準点がモニターの左上になる？のでTPaintBoxの領域内でイベントを拾うことができない領域が発生したり、
TPaintBoxの領域外でイベントを取得したりします。
イベントをTPaintBoxの領域内のすべての位置で取得し、領域外では取得しないようにするにはどう書けばいいのでしょうか？
TMyPaintBox = class(TPaintBox)
private
////マウススクロール
procedure WMMousewheel(var Msg: TMessage); message WM_MOUSEWHEEL;
procedure TMyPaintBox.WMMousewheel(var Msg: TMessage);
begin
if (Msg.WParam > 0) then
begin
// ホイールを奥に動かした時の処理
MessageBeep(MB_ICONINFORMATION);
end
else begin
// ホイールを手前に動かした時の処理
MessageBeep(MB_OK);
end;
end;
TControlのprotectedメソッドに
DoMouseWheel
DoMouseWheelDown
DoMouseWheelUp
があります。
dynamicですので、これをoverrideする方が自然かもわかりませんね。
ふぐちゃんさん
連絡いただきありがとうございます。
『昨日遅刻した男』です。
こちらで下記を実行してみましたがうまくいきませんでした。
ご指導ねがいなす。
protected
//追加
function DoMouseWheel(Shift:TShiftState;WheelDelta:Integer;
MousePos: TPoint): Boolean; override;
function TEditor.DoMouseWheel(Shift: TShiftState; WheelDelta:
Integer;MousePos: TPoint): Boolean;
begin
MessageBeep(MB_OK);
Result := inherited DoMouseWheel(Shift, WheelDelta,MousePos);
end;
昨日遅刻した？日が変わったので一昨日遅刻した、、、
失礼しました。。
自己レス
function TEditor ではなくて
function TMyPaintBox でした。
昨日遅刻した男さんの質問をよく読んでいませんでした。すみません。
私の前回のレスは表題の「マウスの中央のボタンのイベントを取得するには？」
に対して書いたものでした。
TPaintBoxを継承したコンポですか。
ウィンドウハンドルを持っていませんからホイールをその上で動かしても
メッセージは来ませんね。(^_^;)
> ウィンドウハンドルを持っていませんからホイールをその上で動かしても
> メッセージは来ませんね。(^_^;)
そんなことはありません。TPaintBox だって OnClick イベントがあるように
親の TWinControl からもらっています。質問を読む限り、メッセージは来ている
ようですし。
単なるスクリーン座標からの座標変換が問題なら、ScreenToClient() メソッドで
解決できるはずですけど
> TPaintBox だって OnClick イベントがあるように
いい加減なことを書きまして、大変申し訳ありませんでした。
昨日遅刻した男さん、本当にごめんなさい。
いやいやさん、ふぐちゃんさん
書き込みいただきありがとうございます。
TPaintBoxはウィンドウハンドルをもっていないのでWM_MOUSEWHEELでホイールのイベントを取得しているのですが、やはり下記のような動作になります。
>下記のように書いただけでは基準点がモニターの左上になる？
ではなくて
基準点はモニターの左上-(親のコントロールの左上座標-コンポーネントの左上座標)になってしまいます。
＊親のコントロールの左上座標-コンポーネントの左上座標とは親のコントロールにのせたコンポーネントの座標プロパテイ（Top,Left)
すなわち、WM_MOUSEWHEELで取得できるイベントの範囲がずれているためWM_MOUSEWHEELイベントを発生する前にこのズレを補正しないといけないわけで、、、やはり無理？かもしれません。
自分の Top Left Width Height が分かっていて、親のそれも分かってるんだから
補正するのは簡単でしょ。なんで悩むのか不思議。
いやいやさん
ありがとうございます。
>補正するのは簡単でしょ。なんで悩むのか不思議。
>すなわち、WM_MOUSEWHEELで取得できるイベントの範囲がずれているため
自作コンポーネント（TMyPaintBox）の領域でのWM_MOUSEWHEELのイベントが発生しない部分があるので悩んでいます。
この発生しない部分でのイベントの取得はどのようにすればいいのでしょうか？
> すなわち、WM_MOUSEWHEELで取得できるイベントの範囲がずれているため
WM_MOUSEWHEELの仕様については。MSサイトでは、探し方が悪く見つけることができませんでしたが、
ここ(http://www.maa.spacetown.ne.jp/~fool/programer/memo/api32_memo.html)によると、
ホイール系のメッセージは、スクリーン座標がとんでくる仕様っぽいですね。
WM_MOUSEMOVEとかは、コントロールのクライアント座標なのに・・・。
そのため、正しくホイールメッセージが取得できないわけです。
> 補正するのは簡単でしょ。なんで悩むのか不思議。
座標の補正をすべきなのは、メッセージを受け取ったコントロールなので、
自分(TMyPaintBox)からは、どうしようもできないってことでしょう。
もしできるなら、ApplicationのOnMessageでWM_MOUSEWHEEL捕まえて、
補正をかけるくらいじゃないかと。
どうしてもコンポーネントでなんとかしないのであれば、動くかわかりませんが、
以下のようにしてみるのはどうでしょう。
ただし、記憶だけで書いてるため、作ってみるなら詳細は調べてみて欲しいです。
1)TMyPaintBoxで、メッセージ受信専用ウィンドウ(=MyHandle)を用意。
ここ http://homepage2.nifty.com/Mr_XRAY/Halbow/Notes/N007.html 参照。
2)WM_WOUSEENTERかCM_WOUSEENTERあたりで、SetFocus(MyHandle)して、
MOUSELEAVEで、SetFocus(Screen.ActiveControl)する。
3)SetFocus(MyHandle)しておけば、メッセージ受信専用ウィンドウ宛に
WM_MOUSEWHEELがとんでくる(はず)なので、そこで処理する。
ん？さん
ありがとうございます。
>座標の補正をすべきなのは、メッセージを受け取ったコントロールなので、
>自分(TMyPaintBox)からは、どうしようもできないってことでしょう。
>もしできるなら、ApplicationのOnMessageでWM_MOUSEWHEEL捕まえて、
>補正をかけるくらいじゃないかと。
やはり簡単ではなさそうですね。
一番簡単なやりかた（貼り付けた親（Form1）にWM_MOUSEWHEELをおいて制御する）で解決しようと思います。
みなさん。ほんとにありがとうございました。
ちょっとおもしろそうだったので、途中まで作ってみました。
いちおう、これで正しく動いている気がします。
当方D5なので、D5での動作確認しかしていません。
つっこみがあれば、どうぞつっこんでください。
---------------------------------
TMyPaint =class(TPaintBox)
private
AllocHandle :THandle;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
private
procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMousewheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
protected
procedure WndMethod(var Message:TMessage);
end;
constructor TMyPaint.Create(aOwner: TComponent);
var
wndLong :LongInt;
begin
inherited Create(aOwner);
{メッセージ受信ウインドウの作成}
AllocHandle := AllocateHWnd(WndMethod);
{子ウインドウ化：これがないとフォームが非アクティブになる}
wndLong := GetWindowLong(AllocHandle, GWL_STYLE);
wndLong := wndLong AND not WS_POPUP or WS_CHILD;
SetWindowLong(AllocHandle, GWL_STYLE, wndLong);
end;
destructor TMyPaint.Destroy;
begin
{メッセージ受信ウインドウの破棄}
DeallocateHwnd(AllocHandle);
inherited Destroy;
end;
procedure TMyPaint.WMMouseWheel(var Message: TWMMouseWheel);
begin
TCMMouseWheel(Message).ShiftState := KeysToShiftState(Message.Keys);
Perform(CM_MOUSEWHEEL, TMessage(Message).wParam, TMessage(Message).lParam);
end;
procedure TMyPaint.CMMouseEnter(var Message: TMessage);
begin
SetFocus(AllocHandle);
end;
procedure TMyPaint.CMMouseLeave(var Message: TMessage);
begin
if Screen.ActiveControl <> nil then begin
SetFocus(Screen.ActiveControl.Handle);
end;
end;
procedure TMyPaint.CMMousewheel(var Message: TCMMouseWheel);
begin
with Message do
begin
Result := 0;
if DoMouseWheel(ShiftState, WheelDelta, SmallPointToPoint(Pos)) then
Message.Result := 1
else if Parent <> nil then
with TMessage(Message) do
Result := Parent.Perform(CM_MOUSEWHEEL, WParam, LParam);
end;
end;
procedure TMyPaint.WndMethod(var Message:TMessage);
var
form :TCustomForm;
begin
if (WM_MOUSEFIRST <= Message.Msg) and (Message.Msg <= WM_MOUSELAST) then begin
{マウスメッセージはすべて自分で処理するのでいいのでしょうか？}
Message.Result := Perform(Message.Msg, Message.wParam, Message.lParam);
end
else begin
if (Message.Msg = WM_ACTIVATEAPP) then begin
form := GetParentForm(Self);
if form <> nil then begin
Windows.SetParent(AllocHandle, form.Handle);
end;
end;
Message.Result := CallWindowProc(@DefWindowProc, AllocHandle, Message.Msg,
Message.wParam, Message.lParam);
end;
end;
ん〜？さん
すばらしいです！！。
解決印を押してしまったにもかかわらず、投稿いただき、
ありがとうございます。m(__)m
下記のようにしたところバッチリです。
もうひとつだけお聞きしたことがあります。他のアプリ（仮にA）にフォーカスを移動した後に、このTMyPaintコンポーネント上にマウスを移動させてマウスの中ボタンをまわすと他のアプリ（仮にA）のマウススクロールイベントが作動します。TMyPaintコンポーネントにマウスカソールが入ってきたときにTMyPaintコンポーネントのマウススクロールイベントを発生させるようにするにはどこを改良すればいいでのでしょうか？
お手数をおかけします。よろしくお願いします。
procedure TMyPaint.WndMethod(var Message:TMessage);
var
form :TCustomForm;
begin
if (WM_MOUSEFIRST <= Message.Msg) and (Message.Msg <= WM_MOUSELAST) then begin
{マウスメッセージはすべて自分で処理するのでいいのでしょうか？}
if (Message.WParam > 0) then
begin
// ホイールを奥に動かした時の処理
MessageBeep(MB_ICONINFORMATION);
end
else begin
// ホイールを手前に動かした時の処理
MessageBeep(MB_OK);
end;
Message.Result := Perform(Message.Msg, Message.wParam, Message.lParam);
end
else begin
if (Message.Msg = WM_ACTIVATEAPP) then begin
form := GetParentForm(Self);
if form <> nil then begin
Windows.SetParent(AllocHandle, form.Handle);
end;
end;
Message.Result := CallWindowProc(@DefWindowProc, AllocHandle, Message.Msg,
Message.wParam, Message.lParam);
end;
> 他のアプリ（仮にA）にフォーカスを移動した後に、このTMyPaintコンポーネント上にマウスを移動させてマウスの中ボタンをまわすと他のアプリ（仮にA）のマウススクロールイベントが作動します。
これって、当然じゃない？
アクティブになっていないアプリに、マウス関連メッセージ飛ばす必要はないでしょう。
そうじゃないと、例えばIEとWordが起動していて、全面のWORDをホイールでスクロールさせたら、
裏に隠れたIEもスクロールしたらおかしいでしょ？
まず、ウインドウズのお作法に反する動作かと思います。
私が知らないだけで、そういう動作もありってことなら、後学のために教えて欲しいです。
細かい説明ができる識者の方、いらっしゃいましたら教えてください。
なお、どうしてもホイールを効かせたいのなら、逆転の発想をするしかないでしょう。
アクティブなアプリにしか、メッセージが飛ばないのなら、自分のアプリを強引にアクティブにするしかないんじゃないですか？
ちなみに、WndMethodの中でホイールの方向調べなくても、DoMouseWheelDown とか飛んでいくはずですが、とんでいないのですか？
DoMouseWheelDownのメソッドを実行させるために、Performを使って自分自身にメッセージ処理を行わせているのです。
それに、すべてのマウスメッセージがすべてトラップされているので、場合によっては、
MouseDownとか、MouseMoveでもビープ音鳴りません？
（メッセージのパラメータを知らずしての発言なので、スルーして結構）
ん？さん ありがとうざいます。
>これって、当然じゃない？
そうですね。
>私が知らないだけで、そういう動作もありってことなら、後学のために教えて欲しいです。
私はこのコンポーネントでCADのようなプログラムを作っています。
たとえば線を描画するとき
１．マウスダウンで始点指示
２．マウスアップで始点決定
３．マウスムーブで始点マウスカソール間を描画実行（マウスは押されていない状態）
４．マウスダウンで始点指示
５．マウスダウンで始点決定
の流れがあるとしたとき
上の３の状態で使用者が何らかの目的で他のアプリをアクティブにしてそのままMyPaintコンポーネントにマウスカソールを移動させたとき、上記３．を継続して実行するので、使用者（自身も）はこのアプリがアクティブになったと勘違いする時がある。このときにマウスの中ボタンをMyPaintコンポーネントの処理に当てるというのは有効であると思ったのですが、、、
ちなみに他のCADをこのように実行してみたら他のアプリのマウススクロールイベントが発生しました。
>MouseDownとか、MouseMoveでもビープ音鳴りません？
音鳴ります。
> 上の３の状態で使用者が何らかの目的で他のアプリをアクティブにして
> そのままMyPaintコンポーネントにマウスカソールを移動させたとき、
> 上記３．を継続して実行するので、使用者（自身も）はこのアプリが
> アクティブになったと勘違いする時がある。このときにマウスの中ボタンを
> MyPaintコンポーネントの処理に当てるというのは有効であると思ったのですが、、、
> ちなみに他のCADをこのように実行してみたら他のアプリのマウススクロール
> イベントが発生しました。
ん〜？？？
これは、「昨日遅刻した男さんの作っているアプリ」も、「他のCAD」も同じように
アクティブじゃなくても、マウスムーブが発生し、線の描画が行われているという
ことですか？
それと、中ボタン(マウスホイール？)に割り当ててどうしたいのか？
すみませんが、何を言わんとしているのかわかりません。
マウスムーブは、アクティブじゃなくてもカーソル下のコントロールに
対して入ってくる。
一方、マウスホイールは、アクティブなコントロールにしか届かない。
（ホイールがカーソル下のコントロールにしか飛ばないのであれば、
コントロール外に出した状態でホイールを使えなくなりますよね？
カーソルが邪魔だから、アプリの外に出している。こういうときに
文書をスクロールさせるのに、ホイール使っても動かないことになる。
非常に不便です。
文字入力が、アクティブでフォーカスのあるコントロールにしか
できないように、ホイールの動作も同じコトが言えると思いますが？）
Windowsの仕様なので、これをどうしろっていうのであれば、他のアプリの
メッセージすらすべて自分で処理しないといけない状況になるでしょう。
だとすれば、『アクティブじゃないときのマウスムーブで描画しないようにする。
これで、アクティブだと勘違いされない。』
というのが、正しい解決策かと思います。
もっとも、再度のアクティブ化でマウスクリックした場合、マウスクリックで
線分確定が動くと、直前の動作を忘れて「いきなり線ができた」などという
苦情もありそうな気もします。
| ツイート |  |