tagCANDY CGI VBレスキュー(花ちゃん) - マウスがボタン上にある時にボタンのバックカラーを変更する(VB6.0) - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
マウスがボタン上にある時にボタンのバックカラーを変更する(VB6.0)
元に戻る スレッド一覧へ 記事閲覧
このページ内の検索ができます。(AND 検索や OR 検索のような複数のキーワードによる検索はできません。)

マウスがボタン上にある時にボタンのバックカラーを変更する(VB6.0) [No.248の個別表示]
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
日時: 2010/01/19 14:57
名前: 花ちゃん

***********************************************************************************
* カテゴリー:[コントロール共通][マウス][]                                        *
* キーワード:MouseEnter,MouseLeave,ボタン上にカーソル,マウスポインター,MouseMove *
***********************************************************************************
タイトル : ボタン上からカーソルが外れた判断
記 事 No : 14378
投 稿 日 : 2010/01/15(Fri) 14:48
元質問者 : らっと  

ユーザーフォームのボタンにカーソルがのると発生するイベントはMouseMoveですが、
カーソルが外れた時をどう判断したら良いのでしょうか?
---------------------------------------------------------------------------------
記事No : 14379
投稿日 : 2010/01/15(Fri) 16:11
回答者 : 花ちゃん  

ボタンのMouseMove イベント(フラグを立て)からユーザーフォームの MouseMove
イベントに変わったら(フラグが立っていて)ボタン上からカーソルが外れた事に
なりませんか?

と答えたのですが、ボタン1個だけとか配列になっているとかならそれでもいいのですが
色んなコントロール上でも同様にしたいとか、コントロールとコントロールの間隔が狭いと
うまく取得できない等の難があり、何かいい方法はないものかと試したのですが、自分的
には今ひとつなのですが、簡単に取得できるような方法が見当たらないので一応参考程度に
投稿しておきます。(いい方法があれば投稿願います。)
(サブクラス化やDirectInputや座標位置から取得する方法も検討はしたのですが...。)

------------------------------------------------------------------------
回答したような方法なら下記でいいのですが。
'.NET 系では、MouseEnter や MouseLeave イベントがありますが。

Private frgCtrl As Boolean 'マウスカーソルがどこにあるかのフラグ
Private Sub Form_MouseMove(Button As Integer, _
                     Shift As Integer, X As Single, Y As Single)
   If frgCtrl = True Then  'マウスカーソルが Label1 上からForm 上に移動した。
      Label1.BackColor = Me.BackColor
      frgCtrl = False      'マウスカーソルが Form 上にある印
   End If
End Sub
Private Sub Label1_MouseMove(Button As Integer, _
                     Shift As Integer, X As Single, Y As Single)
   frgCtrl = True                'マウスカーソルが Label1 上にある印
   Label1.BackColor = vbYellow   '視覚化の為
End Sub

------------------------------------------------------------------------
使用するコントロール類と配置は下図を参照して下さい。
別途、CommandButton の Style プロパティを 1 に設定しておいて下さい。

Option Explicit

'マウスカーソルの位置座標を受取る構造体
Private Type POINTAPI
   X As Long
   Y As Long
End Type

'現在のマウスカーソルの位置座標を取得する(387)
Private Declare Function GetCursorPos Lib "user32" _
    (lpPoint As POINTAPI) As Long

'指定の座標位置にあるウィンドウのハンドルを取得する(106)
Private Declare Function WindowFromPoint Lib "user32" _
    (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Private frgCtrl As Boolean 'マウスカーソルがどこにあるかのフラグ

Private Sub Form_MouseMove(Button As Integer, _
                     Shift As Integer, X As Single, Y As Single)
   If frgCtrl = True Then  'マウスカーソルが Label1 上からForm 上に移動した。
      Label1.BackColor = Me.BackColor
      frgCtrl = False      'マウスカーソルが Form 上にある印
   End If
End Sub

Private Sub Label1_MouseMove(Button As Integer, _
                     Shift As Integer, X As Single, Y As Single)
   frgCtrl = True                'マウスカーソルが Label1 上にある印
   Label1.BackColor = vbYellow   '視覚化の為
End Sub

'----------------------------------------------------------------------------

Private Sub Command1_Click()
   Timer1.Interval = 100
   Timer1.Enabled = Not Timer1.Enabled
End Sub

Private Sub Timer1_Timer()
   Dim hCtrl As Long
   Dim Ret   As Long
   Dim Pos   As POINTAPI
   '現在のマウスカーソルの位置座標を取得
   Ret = GetCursorPos(Pos)
   'その位置のウィンドウのハンドルを取得
   hCtrl = WindowFromPoint(Pos.X, Pos.Y)
   Dim ctrl As Control
   For Each ctrl In Me.Controls
      If TypeName(ctrl) = "Label" Or TypeName(ctrl) = "Timer" Then
         'ハンドルが取得できないコントロールの場合
         '別途取得が必要なら座標位置から割り出し特定するか、個別にコードを
         '書いて下さい。
      Else
         If ctrl.hWnd = hCtrl Then
            ctrl.BackColor = vbRed
         Else
            ctrl.BackColor = Me.BackColor
         End If
      End If
   Next
End Sub


画像をクリックすると元のサイズで見られます。
メンテ

Page: 1 |

マウスがボタン上にある時にボタンのバックカラーを変更する(VB6.0)  (No.1の個別表示) [スレッド一覧へ]
日時: 2010/01/20 11:30
名前: 魔界の仮面弁士

***********************************************************************************
* カテゴリー:[コントロール共通][マウス][]                                        *
* キーワード:MouseEnter,MouseLeave,ボタン上にカーソル,マウスポインター,MouseMove *
***********************************************************************************

「マウスが離れた時のイベント」を組み込む際には、SetCapture API による
実装が知られています(過去ログにも登場しています)。

ただし、「コントロール配列」や「ウィンドウレスコントロール」には
対応させ難いため、利用範囲が多少限定される事になります。

'===========================================================================
'クラスモジュール「IButtonLeave」
Option Explicit

Public Sub MouseLeaveCallback(ByVal Button As VB.CommandButton)
End Sub

Public Sub MouseEnterCallback(ByVal Button As VB.CommandButton)
End Sub


'===========================================================================
'フォームモジュール「Form1」…ボタンを数個貼っておく
Option Explicit

Implements IButtonLeave
Private Samples As VBA.Collection

Private Sub Form_Load()
    'Add したもののみが対象です。
    Set Samples = New VBA.Collection
    Samples.Add CreateSample(Command1)
    Samples.Add CreateSample(Command2)
    Samples.Add CreateSample(Command3)
End Sub

Private Function CreateSample(ByVal Button As CommandButton) As Sample
    Set CreateSample = New Sample
    CreateSample.Initialize Button
End Function

Private Sub IButtonLeave_MouseEnterCallback(ByVal Button As CommandButton)
    Button.Caption = "Enter"
End Sub

Private Sub IButtonLeave_MouseLeaveCallback(ByVal Button As CommandButton)
    Button.Caption = "Leave"
End Sub


'===========================================================================
'クラスモジュール「Sample」
Option Explicit

Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetCapture Lib "user32" () As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Private mOwner As IButtonLeave
Private WithEvents mButton As VB.CommandButton

Public Sub Initialize(ByVal Button As VB.CommandButton)
    Set mOwner = Button.Parent
    Set mButton = Button
End Sub

Private Sub mButton_MouseMove(MouseButton As Integer, Shift As Integer, X As Single, Y As Single)
    If X >= 0 And X < mButton.Width And Y >= 0 And Y < mButton.Height Then
        If GetCapture() <> mButton.hWnd Then
            mOwner.MouseEnterCallback mButton
            SetCapture mButton.hWnd
        End If
    Else
        mOwner.MouseLeaveCallback mButton
        ReleaseCapture
    End If
End Sub
'===========================================================================
メンテ

Page: 1 |

 投稿フォーム               スレッド一覧へ
題  名 スレッドをトップへソート
名  前
パスワード (記事メンテ時に使用)
投稿キー (投稿時 投稿キー を入力してください)
コメント

   クッキー保存   
スレッド一覧へ