How to get notified when mouse enter controls

[kcvinu]

Hi all,
In my gui code, I have subclassed all controls and used TrackMouseEvent function in order to get notified when mouse enters on all controls. So this is my question, is there any better method to get notified mouse enter and mouse leave events without using TrackMouseEvent function ? Thanks in advance.

[Pierre Bellisle]

Hey,
This could be one way, using WM_SETCURSOR...

Code: Select all

#Define JumpCompiler "<D:\Free\64\fbc.exe>"
#Define JumpCompilerCmd "<-s gui -w pedantic "D:\Free\bas\~~Default.rc">"

#define unicode
#Include Once "windows.bi"
#Include Once "win\shellapi.bi"

#Define AppName         "Template"
#Define ButtonDecrement 101
#Define ButtonIncrement 102
#Define ButtonExit      103
#Define StaticInfo      201

Const Cr   = !"\13" 'Use of escape sequences
Const Lf   = !"\10"
Const CrLf = !"\13\10"
Const Esc  = !"\27"
Const Tab9 = !"\9"

Dim Shared As HINSTANCE hInstance : hInstance = GetModuleHandle(NULL)
'_____________________________________________________________________________

Function WndProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer
 Dim    hButtonDecrement As HWND
 Dim    hButtonIncrement As HWND
 Dim    hButtonExit      As HWND
 Static hStaticInfo      As HWND
 Static hFont            As HFONT
 Dim    wzBuff           As wString * 64
 Static Number           As LONG32 = 0

 Function = 0

 Select Case (uMsg)

   Case WM_CREATE
     Dim As NONCLIENTMETRICS NotClientMetrics : NotClientMetrics.cbSize = SizeOf(NONCLIENTMETRICS)
     SystemParametersInfo(SPI_GETNONCLIENTMETRICS, NotClientMetrics.cbSize, @NotClientMetrics, 0)
     hFont = CreateFontIndirect(@NotClientMetrics.lfMessageFont)

     hButtonDecrement = CreateWindowEx(0, "Button", "&Decrement", _
                                       WS_CHILD Or WS_VISIBLE Or WS_TABSTOP Or WS_GROUP Or _
                                       BS_CENTER Or BS_VCENTER, _
                                       10, 10, 200, 30, _
                                       hWnd, Cast(HMENU, ButtonDecrement), _
                                       hInstance, NULL)
    SendMessage(hButtonDecrement, WM_SETFONT, Cast(UInteger, hFont), TRUE)

     hButtonIncrement = CreateWindowEx(0, "Button", "&Increment", _
                                   WS_CHILD Or WS_VISIBLE Or BS_CENTER Or WS_TABSTOP Or _
                                   BS_NOTIFY Or BS_TEXT Or BS_VCENTER, _
                                   10, 50,200, 30, _
                                   hWnd, Cast(HMENU, ButtonIncrement), _
                                   hInstance, NULL)
    SendMessage(hButtonIncrement, WM_SETFONT, Cast(UInteger, hFont), TRUE)

    hButtonExit   = CreateWindowEx(0, "Button", "E&xit", _
                                   WS_CHILD Or WS_VISIBLE Or BS_CENTER Or WS_TABSTOP Or _
                                   BS_NOTIFY Or BS_TEXT Or BS_VCENTER, _
                                   10, 90, 200, 30, _
                                   hWnd, Cast(HMENU, ButtonExit), _
                                   hInstance, NULL)
    SendMessage(hButtonExit, WM_SETFONT, Cast(WPARAM, hFont), TRUE)

    hStaticInfo = CreateWindowEx (0, "Static", "Hover taskbar's button to " & CRLF & "see thumbnail & toolbar", _
                                   WS_CHILD Or WS_VISIBLE Or SS_CENTER Or _
                                   SS_NOPREFIX Or SS_NOTIFY Or SS_SUNKEN, _
                                   10, 130, 200, 20, _
                                   hWnd, Cast(HMENU, StaticInfo), _
                                   ByVal hInstance, NULL)
    SendMessage(hStaticInfo, WM_SETFONT, Cast(UInteger, hFont), TRUE)

    Case WM_COMMAND
      Dim as WORD ControlId  = LoWord(wParam)
      Dim as WORD ControlMsg = HiWord(wParam)
      Select Case ControlId

        Case ButtonDecrement
          If ControlMsg = BN_CLICKED Or ControlMsg = 1 Then
            Number -= 1
            wzBuff  = Str(Number)
            SendMessage(hStaticInfo, WM_SETTEXT, 0, Cast(UInteger, @wzBuff))
          EndIf

        Case ButtonIncrement
          If ControlMsg = BN_CLICKED Or ControlMsg = 1 Then
            Number += 1
            wzBuff  = Str(Number)
            SendMessage(hStaticInfo, WM_SETTEXT, 0, Cast(UInteger, @wzBuff))
          EndIf

        Case ButtonExit
          If ControlMsg = BN_CLICKED Or ControlMsg = 1 Then
            PostMessage(hWnd, WM_CLOSE, 0, 0)
            Exit Function
          EndIf

     End Select

   Case WM_MOUSEMOVE
     wzBuff  = "Mouse at " & STR(LoWord(lParam)) & " x " & STR(HiWord(lParam))
     SendMessage(hStaticInfo, WM_SETTEXT, 0, Cast(UInteger, @wzBuff))

   CASE WM_SETCURSOR
     IF wParam <> hWnd THEN  'Mouse is over a control
       SendMessage(hWnd, WM_APP, wParam, lParam)
     ELSE
       wzBuff  = "Mouse out of client area"
       SendMessage(hStaticInfo, WM_SETTEXT, 0, Cast(UInteger, @wzBuff))
       SendMessage(hWnd, WM_APP, 0, 0)
     END IF

   CASE WM_APP
     'Notification
     STATIC ControlUnderMousePrev As WORD
     If wParam Then
       Dim As WORD ControlUnderMouse = GetDlgCtrlID(Cast(HWND, wParam))
       If ControlUnderMouse <> ControlUnderMousePrev Then
         wzBuff  = "Mouse over control id " + Str(ControlUnderMouse)
         SendMessage(hStaticInfo, WM_SETTEXT, 0, Cast(UInteger, @wzBuff))
         ControlUnderMousePrev = ControlUnderMouse
         _Beep(1500, 100)
       End If
     Else
       If  ControlUnderMousePrev THEN
         _Beep(500, 100)
       End If
       ControlUnderMousePrev = 0
     End If

   Case WM_CLOSE

   Case WM_DESTROY
     DeleteObject(hFont)
     PostQuitMessage(0)
     Exit Function

   Case Else

 End Select

 Function = DefWindowProc(hWnd, uMsg, wParam, lParam)

End Function
'_____________________________________________________________________________

Function WinMain(ByVal hInstance As HINSTANCE, ByVal hPrevInst As HINSTANCE, _
                 ByVal CmdLine As WString Ptr, ByVal CmdShow As Integer) As UINT
 Dim WinClass   As WNDCLASS
 Dim wMsg       As MSG
 Dim hWnd       As HWND
 Dim hIco       As HICON
 Dim WindowSize As SIZEL
 Dim wsAppName  As WString * 128

 wsAppName              = AppName & " - " & SizeOf(UInteger) * 8
 WindowSize.cx          = 230
 WindowSize.cy          = 190
 hIco                   = ExtractIcon(GETMODULEHANDLE(""), "Shell32.dll", 294)
 WinClass.style         = CS_HREDRAW Or CS_VREDRAW
 WinClass.lpfnWndProc   = ProcPtr(WndProc)
 WinClass.cbClsExtra    = 0
 WinClass.cbWndExtra    = 0
 WinClass.hInstance     = hInstance
 WinClass.hIcon         = hIco
 WinClass.hCursor       = LoadCursor(NULL, IDC_ARROW)
 WinClass.hbrBackground = Cast(HGDIOBJ, COLOR_BTNFACE + 1) 'Default color
 WinClass.lpszMenuName  = NULL
 WinClass.lpszClassName = @wsAppName

 If (RegisterClass(@WinClass)) Then
   hWnd = CreateWindowEx(WS_EX_WINDOWEDGE, _
                         wsAppName, wsAppName, _
                         WS_OVERLAPPED OR WS_CLIPCHILDREN Or WS_DLGFRAME Or WS_BORDER Or WS_VISIBLE Or WS_CAPTION Or _
                         WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SYSMENU , _
                         (GetSystemMetrics(SM_CXSCREEN) - WindowSize.cx) / 2, _ 'PosX
                         (GetSystemMetrics(SM_CYSCREEN) - WindowSize.cy) / 2, _ 'PosY
                         WindowSize.cx, WindowSize.cy, _ 'Width, height
                         NULL, NULL, hInstance, NULL)

   ShowWindow(hWnd, SW_SHOW)
   UpdateWindow(hWnd)

   While GetMessage(@wMsg, ByVal NULL, 0, 0) > 0
     If IsDialogMessage(hWnd, @wMsg) = 0 Then
       TranslateMessage(@wMsg)
       DispatchMessage(@wMsg)
     End If
   Wend

  End If
  DestroyIcon(hIco)

  Function = wMsg.message

End Function
'_____________________________________________________________________________

End WinMain(hInstance, NULL, Command(), SW_NORMAL) 'Call main() and return the error code to the OS
'_____________________________________________________________________________
'

[kcvinu]

@Pierre Bellisle ,
Thanks for the reply. Thats a great help for me. Really a good workaround for TrackMouseEvent.

[Pierre Bellisle]

Great!
I'm glad to help a little. :-)