Windows Functionality Suite (WFS) and WndProc

  1. 2 months ago

    Garry P

    Sep 9 Pre-Release Testers, Xojo Pro Europe (Torquay, UK)

    I've added the Windows Functionality Suite (WFS) to my project as I need to listen for the following WndProc messages:

    WM_SYSCOLORCHANGE 0x0015
    WM_THEMECHANGED 0x031A
    WM_DWMCOLORIZATIONCOLORCHANGED 0x0320

    I've patched WFS so it actually compiles now (I have forked it and will submit a pull request) but I can't find any examples of how to use the WndProc functionality in WFS to actually listen for a message. Can anyone help?

  2. Christian S

    Sep 9 Pre-Release Testers, Xojo Pro, XDC Speakers, Third Party Store Germany

    WinNotificationMBS class can also listen or those.

  3. Jeff T

    Sep 9 Pre-Release Testers Midlands of England, Europe
    Edited 2 months ago

    The way I do it, based on the WFS and some stuff from Aaron Ballman..

    Global module called WndProchelpers

    Methods:

    Protected Sub Subclass(wnd as Window, proc as WndProcSubclass)
      #if TargetWin32 then
        
        // Do a sanity check
        if wnd = nil or proc = nil then return
        
        // Now make sure we have the wnd procs and subclasses
        if mOldWndProc = nil then mOldWndProc = new Dictionary
        if mSubClass = nil then mSubClass = new Dictionary
        
        // Check to see if we've already subclassed this window.
        if mOldWndProc.HasKey( wnd.Handle ) then return
        
        // Now we want to set the new window procedure.  This call will return
        // the old window procedure, so we don't need to call GetWindowLong
        Declare Function SetWindowLongA Lib "User32" ( hwnd as Integer, index as Integer, newValue as Ptr ) as Integer
        
        Const GWL_WNDPROC = -4
        dim oldWndProc as Integer = SetWindowLongA( wnd.Handle, GWL_WNDPROC, AddressOf WndProc )
        
        // Now save the old window procedure into our list.  We'll
        // reference it by the window's handle
        mOldWndProc.Value( wnd.Handle ) = oldWndProc
        
        // We'll also save off the interface to call, again, referencing
        // it by the window handle
        mSubClass.Value( wnd.Handle ) = proc
        
      #endif
    End Sub
    Protected Sub Unsubclass(wnd as Window)
      #if TargetWin32 then
        
        // Sanity check
        if wnd = nil then return
        
        // Check to see if we've subclassed this window
        if not mOldWndProc.HasKey( wnd.Handle ) then return
        
        // Get the old window procedure handle
        dim oldWndProc as Integer = mOldWndProc.Value( wnd.Handle )
        
        // We want to restore the old window procedure to the window.  We
        // don't care about the return value either
        Declare Sub SetWindowLongA Lib "User32" ( hwnd as Integer, index as Integer, newValue as Integer )
        
        Const GWL_WNDPROC = -4
        SetWindowLongA( wnd.Handle, GWL_WNDPROC, oldWndProc )
        
        // Now remove this window from our subclass list
        mOldWndProc.Remove( wnd.Handle )
        mSubClass.Remove( wnd.Handle )
        
      #endif
    End Sub
    Private Function WndProc(hwnd as Integer, msg as Integer, wParam as Integer, lParam as Integer) as Integer
      #if targetwin32
        
        Declare Function DefWindowProcA Lib "User32" ( hwnd as Integer, msg as Integer, wParam as Integer, lParam as Integer ) as Integer
        
        // Do a sanity check to see if we've subclassed this window or not.
        if not mSubclass.HasKey( hwnd ) then
          // Something's not right here, so just call the default window procedure
          return DefWindowProcA( hwnd, msg, wParam, lParam )
        end if
        
        // We know that we've got a subclass, so call it's window procedure.
        dim handled as Boolean
        dim subclass as WndProcSubclass = mSubclass.Value( hwnd )
        dim ret as Integer = subclass.WndProc( hwnd, msg, wParam, lParam, handled )
        
        // If the user handled the function, then we want to return
        // with the value they passed us
        if handled then return ret
        
        // Otherwise we want to pass the function along to the old window
        // procedure so it can handle it
        Declare Function CallWindowProcA Lib "User32" ( proc as Integer, hwnd as Integer, msg as Integer, wParam as Integer, lParam as Integer ) as Integer
        
        return CallWindowProcA( mOldWndProc.Value( hwnd ), hwnd, msg, wParam, lParam )
        
      #endif
    End Function

    On a window where I want to detect some messages, I Subclass it once, and unSubClass it when closing

    //first activation #if TargetWin32 then WndProcHelpers.Subclass self,app #endif

    //closing
    #if  TargetWin32 then
      WndProcHelpers.Unsubclass( self )
    #endif

    It has a WndProc method holding code for the stuff I want to catch, here its WM_mousemove

    Public Function WndProc(hWnd as Integer, msg as Integer, wParam as Integer, lParam as Integer, ByRef returnValue as Integer) as Boolean
      // Part of the WndProcSubclass interface.
      dim x as integer
      dim handled as boolean
      Const WM_MOUSEMOVE        = &h0001
      if msg <> WM_MOUSEMOVE then
        handled = false
        return handled
      end if
      
      // Now we know this is our message, so we're handling it
      handled = true
      
    //some message constants
      Const WM_LBUTTONDOWN = &h201
      Const WM_RBUTTONDOWN = &h204
      
      // Check to see what the true message is and call one of our user
      // defined events as appropriate
      select case lParam
      case WM_LBUTTONDOWN
        //stuff
      case WM_RBUTTONDOWN
         //stuff
        
      end select
      
      return handled
      Exception
        writelog "Error in wndproc"
    End Function
  4. Andrew L

    Sep 9 San Francisco, CA, USA

    Locate the HotKeyHelper class in WFS. This class implements a listener that receives WM_HOTKEY messages; it can easily be modified to receive other kinds of window messages.

  5. Garry P

    Sep 9 Pre-Release Testers, Xojo Pro Europe (Torquay, UK)

    I've summarised what I was looking for in this thread . Thanks everybody for chipping in. Lots of useful information.

or Sign Up to reply!