Changing Buttons on Mouseover

[Gavin_Mannion]

Hi All,

I am trying to figure out how to change the look of buttons when a mouse pointer hovers over them.

I have managed to change the button on the mousemove event but then how do I change it back when the mouse leaves the buttons area?

Thanks,
Gavin

[chrisjk]

You have to change it back in the Form's mousemove event.

[Gavin_Mannion]

....

Thanks.
Easy enough.

[Gavin_Mannion]

Ooops

This doesn't work if you have 2 buttons close to each other, because if you move the mouse quick enough you can highlight both the buttons at the same time.

Is there not a better way to do this?

And no I'm not moving the mouse extremely quickly just to see if I can break it either ...

Cheers,
Gavin

[chrisjk]

Thanks.
Easy enough.

Yep, although you will get problems if the button is too close to the edge of the form. If the user moves the mouse quicky off your form, the forms mousemove won't fire.

[Gavin_Mannion]

Originally posted by chrisjk
Yep, although you will get problems if the button is too close to the edge of the form. If the user moves the mouse quicky off your form, the forms mousemove won't fire.

We seem to have posted at the same time with the same problem.

Is there another way around this?

[chrisjk]

Originally posted by Gavin_Mannion
Ooops

This doesn't work if you have 2 buttons close to each other, because if you move the mouse quick enough you can highlight both the buttons at the same time.

Is there not a better way to do this?

And no I'm not moving the mouse extremely quickly just to see if I can break it either ...

Cheers,
Gavin

You can do something about it, but it requires the use of API...this example posts a message when the mouse moves outside the form. You should be able to modify it to fire when the mouse moves outside the button

'In a module
Public Const TME_CANCEL = &H80000000
Public Const TME_HOVER = &H1&
Public Const TME_LEAVE = &H2&
Public Const TME_NONCLIENT = &H10&
Public Const TME_QUERY = &H40000000
Public Const WM_MOUSELEAVE = &H2A3&
Public Type TRACKMOUSEEVENTTYPE
    cbSize As Long
    dwFlags As Long
    hwndTrack As Long
    dwHoverTime As Long
End Type
 
Public Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long
Public Declare Function SetCursorPos Lib "user32.dll" (ByVal x As Long, ByVal y As Long) As Long
'Subclassing is explained in our subclassing tutorial at [url]http://www.allapi.net/[/url]
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public PrevProc As Long
 
Public Sub HookForm(F As Form)
    PrevProc = SetWindowLong(F.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHookForm(F As Form)
    SetWindowLong F.hWnd, GWL_WNDPROC, PrevProc
End Sub
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = WM_MOUSELEAVE Then
        'if we receive a WM_MOUSELEAVE message, show it
        Form1.Print "The mouse left the form!"
    End If
    WindowProc = CallWindowProc(PrevProc, hWnd, uMsg, wParam, lParam)
End Function

'In a form (Form1)
Private Sub Form_Click()
    Dim ET As TRACKMOUSEEVENTTYPE
    'initialize structure
    ET.cbSize = Len(ET)
    ET.hwndTrack = Me.hWnd
    ET.dwFlags = TME_LEAVE
    'start the tracking
    TrackMouseEvent ET
    'show a message to the user
    Me.Print "Move the mouse cursor outside the form" + vbCrLf + "to generate a WM_MOUSELEAVE event"
End Sub
Private Sub Form_Load()
    'KPD-Team 2001
    'URL: [email][email protected][/email]
    'E-Mail: [email][email protected][/email]
    'show a warning message
    MsgBox "WARNING: This sample uses subclassing." + vbCrLf + "To end this program, always use the X button of the form." + vbCrLf + "Do not use VB's Stop button and do not use the 'End' keyword in your VB code." + vbCrLf + vbCrLf + "For more information about subclassing, check out" + vbCrLf + "our subclassing tutorial at [url]http://www.allapi.net/[/url]", vbExclamation
    'set the graphics mode to persistent
    Me.AutoRedraw = True
    Me.Print "Click the form to begin"
    'start subclassing this form
    HookForm Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'stop subclassing this form
    UnHookForm Me
End Sub

[Gavin_Mannion]

HAH..

There is not a chance I am going into all that muck at 16:32 my time.

I have only started VB last week, wow that looks confusing.

I will give it a shot in the morning.

Thanks,
Gavin

PS: It's so much easier to do that in ASP.
A:Hover ... lovely

[chrisjk]

Okay, I modified it for you

Into a module

Public Const TME_CANCEL = &H80000000
Public Const TME_HOVER = &H1&
Public Const TME_LEAVE = &H2&
Public Const TME_NONCLIENT = &H10&
Public Const TME_QUERY = &H40000000
Public Const WM_MOUSELEAVE = &H2A3&
 
Public Type TRACKMOUSEEVENTTYPE
    cbSize As Long
    dwFlags As Long
    hwndTrack As Long
    dwHoverTime As Long
End Type
 
Public Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long
Public Declare Function SetCursorPos Lib "user32.dll" (ByVal x As Long, ByVal y As Long) As Long
 
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Public Const GWL_WNDPROC = (-4)
Public PrevProc As Long
 
Public Sub HookForm(F As Control)
 
PrevProc = SetWindowLong(F.hWnd, GWL_WNDPROC, AddressOf WindowProc)
 
End Sub
Public Sub UnHookForm(F As Control)
 
SetWindowLong F.hWnd, GWL_WNDPROC, PrevProc
 
End Sub
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
If uMsg = WM_MOUSELEAVE Then
    'if we receive a WM_MOUSELEAVE message, show it
    Form1.Print "The mouse left the button!"
End If
 
WindowProc = CallWindowProc(PrevProc, hWnd, uMsg, wParam, lParam)
 
End Function

into a form

Private Sub command1_Click()
 
Dim ET As TRACKMOUSEEVENTTYPE
'initialize structure
ET.cbSize = Len(ET)
ET.hwndTrack = Command1.hWnd
ET.dwFlags = TME_LEAVE
'start the tracking
TrackMouseEvent ET
'show a message to the user
Me.Print "Move the mouse cursor outside the button" + vbCrLf + "to generate a WM_MOUSELEAVE event"
 
End Sub
Private Sub Form_Load()
 
MsgBox "WARNING: This sample uses subclassing." + vbCrLf + "To end this program, always use the X button of the form." + vbCrLf + "Do not use VB's Stop button and do not use the 'End' keyword in your VB code." + vbCrLf + vbCrLf + "For more information about subclassing, check out" + vbCrLf + "our subclassing tutorial at [url]http://www.allapi.net/[/url]", vbExclamation
'set the graphics mode to persistent
Me.AutoRedraw = True
Me.Print "Click the button to begin"
'start subclassing this form
HookForm Command1
    
End Sub
Private Sub Form_Unload(Cancel As Integer)
 
'stop subclassing this control
UnHookForm Command1
 
End Sub

[MarkT]

This example uses 4 command buttons with there style property set to graphical

Option Explicit
 
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  ChangeColor Command1
End Sub
 
Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  ChangeColor Command2
End Sub
 
Private Sub Command3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  ChangeColor Command3
End Sub
 
Private Sub Command4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   ChangeColor Command4
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   DefaultColor
End Sub
 
Private Sub ChangeColor(cmdButton As CommandButton)
   DefaultColor
   cmdButton.BackColor = vbRed
End Sub
 
Private Sub DefaultColor()
   Dim ctl As Control
   For Each ctl In Controls
      If TypeOf ctl Is CommandButton Then
         ctl.BackColor = Me.BackColor
      End If
   Next ctl
End Sub

[chrisjk]

Mark, no offense by maybe you should read the whole thread

[MarkT]

This seemed to be the question

Hi All,

I am trying to figure out how to change the look of buttons when a mouse pointer hovers over them.

I have managed to change the button on the mousemove event but then how do I change it back when the mouse leaves the buttons area?

Thanks,
Gavin

What did I miss?

[chrisjk]

Originally posted by MarkT
What did I miss?

You missed this...

Ooops

This doesn't work if you have 2 buttons close to each other, because if you move the mouse quick enough you can highlight both the buttons at the same time.

Is there not a better way to do this?

And no I'm not moving the mouse extremely quickly just to see if I can break it either

[MarkT]

Try my code and I bet you can never highlight 2 buttons at once. You could even have them overlapping and only the one the the pointer is on will be highlighted.
You may be able to keep one highlighted if you move off the form real quickly or the button is against the edge of the form, but as soon as you return to the form it will change back.

[Gavin_Mannion]

Thanks for all the help so far and I nearly have this working now.

Just one small problem.

How do I pass the command button to a module..

By that I mean I have a public function in a module called ChangeButton()

What I would like to be able to do is from the form call the function as in something like ChangeButton(form1.command1) and the module to recognise the correct button to change.

I have tried a few different things but nothing seems to be working.

Thanks for the help,
Gavin

[MarkT]

Try in your module

Public Sub ChangeButton(frm as Form) 
   Debug.Print frm.ActiveControl.Name
End sub

and in your form

Private Sub Command1_Click()
   ChangeButton Me
End Sub

[Gavin_Mannion]

Cool ..

Thanks,
Gavin

[Joacim Andersson]

The following code will change the backcolor of a command button when the mouse is hovering the button.
(The command button style property must be set to graphical)

Private Declare Function SetCapture _
 Lib "user32" ( _
 ByVal hwnd As Long) As Long
 
Private Declare Function ReleaseCapture _
 Lib "user32" () As Long
 
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static blnHasCapture As Boolean
    
    If blnHasCapture = False Then
        SetCapture Command1.hwnd
        blnHasCapture = True
    End If
    If (X < 0 Or X > Command1.Width) Or (Y < 0 Or Y > Command1.Height) Then
        Command1.BackColor = vbButtonFace
        ReleaseCapture
        blnHasCapture = False
    Else
        Command1.BackColor = vbRed
    End If
End Sub
 
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SetCapture Command1.hwnd
End Sub

Best regards