喫茶XRAYトップページ

[スレッド全体]
[4041] Re2:教えてください。返信　削除
2010/12/21 (火) 23:50:08 Mr.XRAY
> MouseEnterを捕捉すればいいわけなんですが，TMemoとかTListViewなら
> WndProcをオーバーライドしなくてもメッセージがあったような...

Delphi 2010なら，そのものズバリ．
OnMouseEnter, OnMouseLeaveというのがあります．ということは，Delphi 6
でもProtetedに... と，探してみます．

[4042] Re3:教えてください。返信　削除
2010/12/22 (水) 00:22:09 Mr.XRAY
> OnMouseEnter, OnMouseLeaveというのがあります．ということは，Delphi 6
> でもProtetedに... と，探してみます．

あっと，そんな面倒なことをしなくても，OnMouseWheelか
MouseWheelHandlerで実装できそうです．
OnMouseWheelはワード操作フォームでも使っていました．

[4047] スクロールバーの制御返信　削除
2010/12/22 (水) 11:56:09 Mr.XRAY
> あっと，そんな面倒なことをしなくても，OnMouseWheelか
> MouseWheelHandlerで実装できそうです．

というか，OnEnterとかは，直接関係ないですね．ハハハッ．
これ結構ややこしそうです．
WM_MOUSEWHEELイベントは，アクティブなコントロールに対してだけしか
発生，動作しませんから，

>マウスのホイールを回すとマウスポインタがある方のコントロールがスクロー
>ルします。

の機能は，ホイールの作業量分たけ，スクロールバーにメッセージを
送って処理しているのではないかと思います．
とすると，こんな手順になるかと思います．

1. マウス，つまりカーソルがある位置を検出．
   MouseWheelHandlerか，OnMouseWheelイベント
2. マウスホイールの作業量，奥へか，手前かと，その移動量分を検出
3. スクロールバーが表示されていれば，その分だけスクロールするメッセージ
   を送る

だそくですが，1.は，コントロールのプロパティやイベントの引数で取得でき
ますが，個人的にはAPIを使った方が，直接スクリーン座標値が取得できるので
好きです．

var
  APos : TPoint;
  RectMemo1 : TRect;
  RectMemo2 : TRect;
begin
  GetCursorPos(APos);
  GetWindowRect(Memo1.Handle, RectMemo1);
  GetWindowRect(Memo2.Handle, RectMemo2);

  //カーソルがMemo1内にある場合
  if PtInRect(RectMemo1, APos) then begin

てな感じです．ということは，

>　こんなこと知らないのはもしかして私だけ？

「とんでもはっぷん，歩いてじゅっぷん」ですね．

[4053] Re:スクロールバーの制御返信　削除
2010/12/22 (水) 18:59:40 たてぐや
▼ Mr.XRAYさん

> WM_MOUSEWHEELイベントは，アクティブなコントロールに対してだけしか
> 発生，動作しませんから，

　そこで悩んだのでした。
 
> 1. マウス，つまりカーソルがある位置を検出．
>    MouseWheelHandlerか，OnMouseWheelイベント
> 2. マウスホイールの作業量，奥へか，手前かと，その移動量分を検出
> 3. スクロールバーが表示されていれば，その分だけスクロールするメッセージ
>    を送る

　なるほど、マウスポインターの位置さえ解れば、あとメッセージを送る
やりかたはどこぞの本に載っていたような記憶があります。調べてみます
ね。ありがとうございます。
[4059] Re2:スクロールバーの制御返信　削除
2010/12/23 (木) 18:10:47 Mr.XRAY
▼ たてぐやさん

というわけで(どういわけだ!?)，こんな感じでしょうか．
スクロールメッセージ関係は，Halbow資料館の以下にあります．
http://mrxray.on.coocan.jp/Halbow/VCL03.html

//=============================================================================
//  マウスカーソルがあるコントロール上でのみスクロールさせるテスト
//  ここでは，対象コントロールであるMemoがあるForm1のOnMouseWheelイベントで処理
//
//  Form上にMemo1とMemo2がある場合
//  スクロールメッセージの詳しい内容は以下を参照
//  http://mrxray.on.coocan.jp/Halbow/VCL03.html
//=============================================================================
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  APos : TPoint;
  RectMemo1 : TRect;
  RectMemo2 : TRect;
begin
   GetCursorPos(APos);
   GetWindowRect(Memo1.Handle, RectMemo1);
   GetWindowRect(Memo2.Handle, RectMemo2);

   if PtInRect(RectMemo1, APos) then begin
     if WheelDelta > 0 then begin
       Memo1.Perform(EM_SCROLL,SB_LINEDOWN,0);
     end else begin
       Memo1.Perform(EM_SCROLL,SB_LINEUP,0);
     end;
   end;

   if PtInRect(RectMemo2, APos) then begin
     if WheelDelta > 0 then begin
       Memo2.Perform(EM_SCROLL,SB_LINEDOWN,0);
     end else begin
       Memo2.Perform(EM_SCROLL,SB_LINEUP,0);
     end;
   end;

   //元のスクロールメッセージは処理しない
   Handled := True;
end;

[4060] Re3:スクロールバーの制御返信　削除
2010/12/23 (木) 18:12:19 Mr.XRAY
ハハハッ．間違えました．
SB_LINEDOWNとSB_LINEUPが逆でした．

[4061] Re3:スクロールバーの制御返信　削除
2010/12/23 (木) 18:24:32 たてぐや
▼ Mr.XRAYさん

> というわけで(どういわけだ!?)，こんな感じでしょうか．
> スクロールメッセージ関係は，Halbow資料館の以下にあります．

　詳細なコード、ありがとうございます。利用させていただきます。
[4068] Re3:スクロールバーの制御(解決）返信　削除
2010/12/24 (金) 21:03:06 たてぐや
▼ Mr.XRAYさん

> というわけで(どういわけだ!?)，こんな感じでしょうか．

　ListviewだとRtIntRectが使えないので、下記のようにしました。ちょっと
泥臭いコードですが、これですっきり解決です。

procedure TForm2.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  APos : TPoint;
  CPos : TPoint;
  RectMemo1 : TRect;
  RectMemo2 : TRect;
begin
   GetCursorPos(APos);
   GetWindowRect(Memo1.Handle, RectMemo1);
   GetWindowRect(Listview1.Handle, RectMemo2);

   if PtInRect(RectMemo1, APos) then begin
     if WheelDelta > 0 then begin
       Memo1.Perform(EM_SCROLL,SB_LINEUP,0);
     end else begin
       Memo1.Perform(EM_SCROLL,SB_LINEDOWN,0);
     end;
//元のスクロールメッセージは処理しない
     Handled := true;
    end;
   Cpos.x := Listview1.Left;
   Cpos.Y := Listview1.Top;
   Cpos := ClientToScreen(Cpos);
   if (Apos.X >= Cpos.x) and (Apos.X <= Cpos.x + Listview1.Width)
     and (Apos.Y >= Cpos.y) and (Apos.Y <= Cpos.y + Listview1.Height)
then begin
//Listviewでは元のメッセージを生かす
      Handled := false;
   end
   else Handled := true;
//Listview上でなくてもスクロールしてしまうから。
end;

　これはいろいろ応用できそうですね。ありがとうございました。

※困った時には「神様・仏様、その前にMr.XRAY様」です。
[4069] Re4:スクロールバーの制御(解決）返信　削除
2010/12/24 (金) 22:18:30 Mr.XRAY
▼ たてぐやさん

「勝てば官軍，動けば正義」です．ただ，

> 　ListviewだとRtIntRectが使えないので、下記のようにしました。ちょっと

PtInRectは確か，TWinControlで使用可能なハズなのですが．
スクロールメッセージは，EM_XXXXはTMemo関係なので，これとは別に
一般的なメッセージを使って，こんな感じでいくと思うのですが....
後でテストしてみます．

var
  APos : TPoint;
  RectListView : TRect;
begin
   GetCursorPos(APos);
   GetWindowRect(ListView1.Handle, RectListView);

   if PtInRect(RectListView, APos) then begin
     if WheelDelta > 0 then begin
       ListView1.Perform(WM_VSCROLL, SB_LINEUP,0);
     end else begin
       ListView1.Perform(WM_VSCROLL, SB_LINEDOWN,0);
     end;
   end;

[4072] Re5:スクロールバーの制御(解決）返信　削除
2010/12/25 (土) 11:13:36 たてぐや
▼ Mr.XRAYさん

　済みません。勘違いでした。メッセージ一つ削除させていただき
ました。
[4073] Re5:スクロールバーの制御(解決）返信　削除
2010/12/25 (土) 11:20:58 たてぐや
▼ Mr.XRAYさん

> PtInRectは確か，TWinControlで使用可能なハズなのですが．
> スクロールメッセージは，EM_XXXXはTMemo関係なので，これとは別に
> 一般的なメッセージを使って，こんな感じでいくと思うのですが....
> 後でテストしてみます．

procedure TForm2.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  APos : TPoint;
  CPos : TPoint;
  RectMemo1 : TRect;
  RectMemo2 : TRect;
  Rectlistview1 : TRect;
  Rectlistview2 : TRect;
begin
   GetCursorPos(APos);
   GetWindowRect(Memo1.Handle, RectMemo1);
   GetWindowRect(Listview1.Handle, RectMemo2);

   if PtInRect(RectMemo1, APos) then begin
     if WheelDelta > 0 then begin
       Memo1.Perform(EM_SCROLL,SB_LINEUP,0);
     end else begin
       Memo1.Perform(EM_SCROLL,SB_LINEDOWN,0);
     end;
   end;

   GetWindowRect(ListView1.Handle, RectListView1);
   if PtInRect(RectListView1, APos) then begin
     if WheelDelta > 0 then begin
       ListView1.Perform(WM_VSCROLL, SB_LINEUP,0);
     end else begin
       ListView1.Perform(WM_VSCROLL, SB_LINEDOWN,0);
     end;
   end;

   GetWindowRect(ListView2.Handle, RectListView2);
   if PtInRect(RectListView2, APos) then begin
     if WheelDelta > 0 then begin
       ListView2.Perform(WM_VSCROLL, SB_LINEUP,0);
     end else begin
       ListView2.Perform(WM_VSCROLL, SB_LINEDOWN,0);
     end;
   end;
   Handled := true;

end;

　これで思い通りの動作をさせることができました。
ありがとうございました。
[4074] Re6:スクロールバーの制御(解決）返信　削除
2010/12/25 (土) 11:37:45 Mr.XRAY
▼ たてぐやさん

> 　これで思い通りの動作をさせることができました。

あっ，これからテストしようと思っていたのに〜　(^^)

[4076] Re7:スクロールバーの制御(解決）返信　削除
2010/12/25 (土) 18:59:54 たてぐや
　ということで、整理してまとめなおしたコードです。フォームにはTMemoと
TListview（片方はvsReport、もう一方はvsIcon）があり、そのどこの上で
ホイールアクションを行ってもマウスポインタの下のコントロールがスクロー
ルします。

procedure TForm2.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
{===============================================================================
マウスポインタの下のコントロールをスクロールさせる
===============================================================================}
var
  APos : TPoint;
  RectMemo1     : TRect;
  Rectlistview1 : TRect;
  Rectlistview2 : TRect;
begin
   GetCursorPos(APos);
   GetWindowRect(Memo1.Handle, RectMemo1);
   GetWindowRect(ListView1.Handle, RectListView1);
   GetWindowRect(ListView2.Handle, RectListView2);

   if PtInRect(RectMemo1, APos) then begin
     if WheelDelta > 0 then begin
       Memo1.Perform(EM_SCROLL,SB_LINEUP,0);
     end else begin
       Memo1.Perform(EM_SCROLL,SB_LINEDOWN,0);
     end;
   end;

   if PtInRect(RectListView1, APos) then begin
     if WheelDelta > 0 then begin
       ListView1.Perform(WM_VSCROLL, SB_LINEUP,0);
     end else begin
       ListView1.Perform(WM_VSCROLL, SB_LINEDOWN,0);
     end;
   end;

   if PtInRect(RectListView2, APos) then begin
     if WheelDelta > 0 then begin
       ListView2.Perform(WM_VSCROLL, SB_LINEUP,0);
     end else begin
       ListView2.Perform(WM_VSCROLL, SB_LINEDOWN,0);
     end;
   end;
   Handled := true;
end;
[4078] Re8:スクロールバーの制御(解決）返信　削除
2010/12/25 (土) 20:44:13 Sara
▼ たてぐやさん　こんばんは

横レスです。

procedure TForm2.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  APos : TPoint;
  cmpFind  : TWinControl;
begin
    GetCursorPos(APos);
    cmpFind := FindVCLWindow(APos);
    if cmpFind is TMemo then begin
      if WheelDelta > 0 then begin
        cmpFind.Perform(EM_SCROLL,SB_LINEUP,0);
      end else begin
        CmpFind.Perform(EM_SCROLL,SB_LINEDOWN,0);
      end;
    end;

    if cmpFind is TListView then begin
      if WheelDelta > 0 then begin
        cmpFind.Perform(WM_VSCROLL, SB_LINEUP,0);
      end else begin
        cmpFind.Perform(WM_VSCROLL, SB_LINEDOWN,0);
      end;
    end;
    Handled := true;
end;

こんなのもあります・・・Delphi6で使えるかは不明(^^;
[4079] Re9:スクロールバーの制御(解決）返信　削除
2010/12/25 (土) 20:48:54 Sara
▼ たてぐやさん　こんばんは
 procedure TForm2.FormMouseWheel(Sender: TObject; Shift: TShiftState;
   WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
 var
   APos : TPoint;
   cmpFind  : TWinControl;
 begin
     GetCursorPos(APos);
     cmpFind := FindVCLWindow(APos);
 
     if (cmpFind is TListView) or (cmpFind is TMemo) then begin
       if WheelDelta > 0 then begin
         cmpFind.Perform(WM_VSCROLL, SB_LINEUP,0);
       end else begin
         cmpFind.Perform(WM_VSCROLL, SB_LINEDOWN,0);
       end;
     end;
     Handled := true;
 end;
 
だけでもできますね・・・(^^;　あいかわらず、Delphi6で使えるかは不明(--;
[4080] Re10:スクロールバーの制御(解決）返信　削除
2010/12/25 (土) 21:13:55 たてぐや
▼ Saraさん

> だけでもできますね・・・(^^;　あいかわらず、Delphi6で使えるかは不明(--;

　Delphi6で動作確認できました。ありがとうございます。
　勉強になるなぁ。
[4081] Re11:スクロールバーの制御(解決）返信　削除
2010/12/25 (土) 23:46:06 Mr.XRAY
▼ たてぐやさん
▼ Saraさん

なるほど，TWinControlですからね．
WM_XXX メッセージで全部できますよね．
FindVCLWindowというのもいいですね．
勉強になりますです．ハイ．

[▼次のスレッド]
INCM/CMT
Cyclamen v3.82