喫茶XRAY [Mr.XRAY掲示板]

[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