Chart that responds to mouse moves !

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,577
Office Version
  1. 2016
Platform
  1. Windows
Hi all,

I am not quite familiar with charting in XL so before I start digging deeper to find a solution , I thought I Should ask here first in case I am just failing to see the obvious\easier alternative.

I want to be able to generate a sound when the user hovers the Mouse over an embeeded Chart . Any Ideas ?

Strictly speaking, an embeeded chart is a Shape and there is no Mouse Move Event for Shapes so I don't really know how to best go about this.

Regards.
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
...so I don't really know how to best go about this.

Neither do I. :) Nevertheless, how 'bout a cheep hack? :cool:

Using five image controls.

Image1 to cover the chart
Image 2,3,4 and 5 will be drawn to the outside of the chart's border.

BackStyle transparent on all five.
BorderStyle none on all as well.

It even kinda works. :wink:

Download example here.

Another option might be to use a dirty doevents loop or an api timer coinciding with the "RangeFromPoint" method of the application object.

Tom


Der Code:

Code:
Private QuasiMouseExit As Boolean

'http://support.microsoft.com/?kbid=213777
'This function declaration must be entered onto a single line.
Private Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
    (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Sub PlaySound()
    If Application.CanPlaySounds Then
        'Substitute the path and filename of the sound you want to play
        Call sndPlaySound32("c:\windows\media\chimes.wav", 0)
    End If
End Sub

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Image1.Visible = False
    If QuasiMouseExit Then PlaySound
    QuasiMouseExit = False
End Sub

Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Image1.Visible = False Then Image1.Visible = True
    QuasiMouseExit = True
    'Image1.BringToFront
End Sub

Private Sub Image3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Image1.Visible = False Then Image1.Visible = True
    QuasiMouseExit = True
    'Image1.BringToFront
End Sub

Private Sub Image4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Image1.Visible = False Then Image1.Visible = True
    QuasiMouseExit = True
    'Image1.BringToFront
End Sub

Private Sub Image5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Image1.Visible = False Then Image1.Visible = True
    QuasiMouseExit = True
    'Image1.BringToFront
End Sub
 
Upvote 0
Tom ...that was a quick answer and it works beautifully ! :biggrin:

I was already experimenting with some Windows Mouse Hooking Code which may be cleaner than using hidden Image Controls or a Timer but it is much more complicated and can also be dangerous .


Thanks very much for your help.
 
Upvote 0
I've given up on anything close to subclassing Excel. My baldspot gets bigger every time I try. :)
 
Upvote 0
Right_Click said:
I've given up on anything close to subclassing Excel. My baldspot gets bigger every time I try. :)

:LOL: Although, I have managed to get some KeyBoard & Mouse Hooking to work before, you are absolutely right. Subclassing\Hooking is a nightmare in MSO applications. :devilish:

I hope that this most talked about new release of XL will be more robust and will support these two extremely useful features.

Regards.
 
Upvote 0
It seems as if every time Jaafar posts a question or an answer I learn something new. This is cool Tom, I downloaded that example, thanks for posting it, and thanks Jaafar for the question !
 
Upvote 0
Hi again,

Out of curiosity, I wanted to see if I could achieve the same result without having to use hidden Image Controls , doevents or Timers.

As you sugested Tom, the RangeFromPoint Method of the Window Object should in theory work for returning the Shape under the Mouse pointer. For some strange reason, when used within a Mouse Hook CallBack procedure, it doesn't work for me ! ( It always returns TRUE !)

So I have used a Custom function which I have named " LocationPoint " to get the exact screen location of the Chart borders so I can then compare these to the Mouse pointer location and generate a sound if the Mouse is currently within the Chart recatngle.

Proceedins:

Create a Chart ( Chart 1) on a worksheet and Copy the following codes :


This Code goes in a Standard Module :

Code:
Option Explicit


Declare Function SetWindowsHookEx Lib _
"user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
    (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function GetDeviceCaps Lib "gdi32" ( _
  ByVal hDC As Long, ByVal nIndex As Long) As Long

Private Declare Function GetDC Lib "user32" ( _
  ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" ( _
  ByVal hwnd As Long, ByVal hDC As Long) As Long
  
Private Type POINTAPI
  x As Long
  y As Long
End Type

Const HC_ACTION = 0
Const WH_MOUSE_LL = 14
Const WM_MOUSEMOVE = &H200
Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90
Const PointsPerInch = 72

Dim hhkLowLevelMouse As Long
Dim blnHookEnabled As Boolean
Dim udtCursorPos As POINTAPI
Dim objTargetShape As Shape
Dim lnghDC As Long
Dim lngPixelsPerPointsX, lngPixelsPerPointsY, lngZoomPercentage

Function LocationPoint(Shp As Shape, Border As String) As POINTAPI
    lnghDC = GetDC(0)
    Dim x, y As Long
        '\\ Get current screen Pixels per points + current Zoom
        lngPixelsPerPointsX = GetDeviceCaps(lnghDC, LOGPIXELSX) / PointsPerInch
        lngPixelsPerPointsY = GetDeviceCaps(lnghDC, LOGPIXELSY) / PointsPerInch
        lngZoomPercentage = (ActiveWindow.Zoom / 100)
    
    '\\ Determine the exact coordinates of the shape's(chart)edges in Pixels
    Select Case Border
        Case Is = "TopLeft"
            x = ActiveWindow.PointsToScreenPixelsX(Shp.Left * _
        (lngPixelsPerPointsX * lngZoomPercentage))
            y = ActiveWindow.PointsToScreenPixelsY(Shp.Top * _
        (lngPixelsPerPointsY * lngZoomPercentage))
        Case Is = "TopRight"
                    x = ActiveWindow.PointsToScreenPixelsX((Shp.Left + Shp.Width) * _
        (lngPixelsPerPointsX * lngZoomPercentage))
                    y = ActiveWindow.PointsToScreenPixelsY(Shp.Top * _
                (lngPixelsPerPointsY * lngZoomPercentage))
        Case Is = "BottomLeft"
                    x = ActiveWindow.PointsToScreenPixelsX(Shp.Left * _
        (lngPixelsPerPointsX * lngZoomPercentage))
                    y = ActiveWindow.PointsToScreenPixelsY((Shp.Top + Shp.Height) * _
               (lngPixelsPerPointsY * lngZoomPercentage))
        Case Is = "BottomRight"
                    x = ActiveWindow.PointsToScreenPixelsX((Shp.Left + Shp.Width) * _
        (lngPixelsPerPointsX * lngZoomPercentage))
                    y = ActiveWindow.PointsToScreenPixelsY((Shp.Top + Shp.Height) * _
                (lngPixelsPerPointsY * lngZoomPercentage))
         Case Else
                MsgBox "error": Exit Function
    End Select
    With LocationPoint
            .x = x
            .y = y
    End With
    ReleaseDC 0, lnghDC

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub PlaySound()
    If Application.CanPlaySounds Then
        'Substitute the path and filename of the sound you want to play
        Call sndPlaySound32("c:\windows\media\chimes.wav", 0)
    End If
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub Hook_Mouse(Sh As Shape)
  
    '\\ Prevent Hooking more than once
    If blnHookEnabled = False Then
        '\\ Change this Target Shape address as required
        Set objTargetShape = Sh
        hhkLowLevelMouse = SetWindowsHookEx _
        (WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
        blnHookEnabled = True
    End If
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 Public Sub UnHook_Mouse()
  
    If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse
    '\\ reset Flag
    blnHookEnabled = False
    
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    '\\ Prevent error if No shape(chart) exists
    On Error Resume Next
    If (nCode = HC_ACTION) Then
    
    '\\ when Mouse is moved
        If wParam = WM_MOUSEMOVE Then
        
            '\\ Process WM_MOUSEMOVE message first
            LowLevelMouseProc = False
            
            '\\ Get Mouse Pointer location in Screen Pixels
            GetCursorPos udtCursorPos
            
            '\\Check if Mouse is within the shape(chart)rectangle
             '\\ Also make sure XL is active
            With udtCursorPos
                If (.x > LocationPoint(objTargetShape, "TopLeft").x) And _
                    (.x < LocationPoint(objTargetShape, "TopRight").x) And _
                    .y > LocationPoint(objTargetShape, "TopLeft").y _
                    And .y < LocationPoint(objTargetShape, "BottomLeft").y And _
                    ActiveSheet Is objTargetShape.Parent And _
                    GetForegroundWindow = FindWindow("XLMAIN", Application.Caption) And _
                    Application.WindowState <> xlMinimized Then '\\if so generate sound
                    PlaySound
                End If
            End With
        End If
    Exit Function
    End If
    
    ' \\ Call next hook if any
    LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
    
End Function



This Code goes in the ThisWorkBook Module :

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    UnHook_Mouse
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Sub Workbook_Open()
    '\\ Change the Chart name as required
    Hook_Mouse Sheets("Sheet1").Shapes("Chart 5")
End Sub

Now, just save the WorkBook, close it and reopen it.

:eek: Please this code uses a System Hook so make sure you save your work before trying it as there is a potential risk of crashing XL !


Regards.
 
Upvote 0
Strange !! the Board doesn't allow me to edit my posts !! The Edit Button is not there !

Anyway I just wanted to say that the name of the chart in the Code is actually "Chart 5" instead of " Chart 1". Also, note that it is embeeded in Sheet1.
 
Upvote 0
Hi rafaaj2000,



The code you have is correct it is Chart1 but the reason you have chart5 is because you created a chart and deleted it and created another chart and deleted it. So everytime you open a new workbook and create a chart it will be chart1 but if you delete that chart and create another chart it will be chart2 and so on.
 
Upvote 0

Forum statistics

Threads
1,213,559
Messages
6,114,302
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top