'Module1
Option expedition
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As LongPublic Declare Function SetProp Lib "user32" alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As LongPublic Declare Function RemoveProp Lib "user32" alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As LongPublic Const GWL_WNDPROC = ( -4 &
Public const wm_windowposchanging = & h46 &
PUBLIC TYPOWPOS HWND AS Long HWNDINSERTAFTER AS Long X As Long Y As Long CX As Long Cy As Long Flags As LONGEND TYPE
Public const hwnd_bottom = & h1 &
Public Declare Sub CopyMemory Lib "kernel32" Alias "RTLmoveMemory" (Destination As Any, Source As Any, Byval length As long)
Public Function WinPropBag_ProcAddress (ByVal hwnd As Long, ByVal fStoreValue As Boolean, Optional ByVal lProcAddress As Long = 0, Optional ByVal fRemoveProp As Boolean = False) As Long If fStoreValue Then 'save properties SetProp hwnd, "MY_WINPROP_PROCADDRESS", lProcAddress Else' taken properties WinPropBag_ProcAddress = GetProp (hwnd, "MY_WINPROP_PROCADDRESS") If fRemoveProp Then 'delete attributes RemoveProp hwnd, "MY_WINPROP_PROCADDRESS" End If End If End FunctionPublic Sub Subclassing (ByVal hWndTarget As Long, Optional ByVal fUnsubclassing As Boolean = False) If fUnsubclassing Then WinPropBag_ProcAddress hWndTarget, True, SetWindowLong (hWndTarget, GWL_WNDPROC, AddressOf MyWindowProc) Else SetWindowLong hWndTarget, GWL_WNDPROC, WinPropBag_ProcAddress (hwnd: = hWndTarget, fStoreValue: = False, fRemoveProp: = True) End IfEnd Sub
Public Function MyWindowProc (ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If uMsg = WM_WINDOWPOSCHANGING Then 'can be written Dim ut As WINDOWPOS CopyMemory ut, ByVal lParam, Len (ut) ut .hWndInsertAfter = HWND_BOTTOM CopyMemory ByVal lParam, ut, Len (ut) 'which may be connected to write' CopyMemory ByVal lParam 4, HWND_BOTTOM, 4 End If MyWindowProc = CallWindowProc (WinPropBag_ProcAddress (hwnd, False), hwnd, uMsg, wParam, LPARAM) END FUNCTION
'Form1
Private Sub Form_Load () Subclassing Me.hwnd, Trueend Sub
Private Sub Form_Unload (Cancel As Integer) Subclassing Me.hwnd, Falsend Sub
