How to utilise wm_entersizemove, wm_exitsizemove for window resizing in .accdb (1 Viewer)

EonsTimE

Registered User.
Local time
Today, 00:18
Joined
May 8, 2016
Messages
13
Hi,
For a while now I've been researching for a way to precisely capture Form resizing (to do actions when user starts or finishes resizing).
I know of the workaround with Form_Resize() and Form_Timer(), but I'm not a fan of looping events at 100-200ms intervals to capture resizing status of a form.

There are some useful window messages sent to the window/form when resizing: wm_entersizemove, wm_exitsizemove, wm_sizing, wm_nccalcsize. I've found some examples how to capture them in Visual Basic, but when I port them to Access, I have partial success. The code utilises subclassing.

What works: Form window entering and exiting Move mode is getting detected.

What's wrong:
1) Moving Form few times causes the Form to randomly freeze and seems to cause a lot of CPU/RAM activity for a bit. Alt-Tabbing out of Access restores that.
2) Mouse over some controls (ie. a Button) on Form freezes the form until cursor leaves the button. Clicking a button freezes the form until Alt-Tabbed
3) Placing cursor on Form border to resize freezes form.
4) Weirdest thing: example code I've scrambled for this post works fine if I save it as .mdb compatible with Access 2002-2003 (I'm using Access 2016). If I save it as .accdb native for Access 2016, code shows problems 1)-3) as described above.

Anyone would be able to check the attached files and play with the Form called [Move or Resize Form].
The code uses 3 API calls and no extra module References.
Any advice how to make it compatible for Access 2016?

Form code:
Code:
Option Compare Database
Option Explicit

'Private Sub cmdEnd_Click()
'==============================================================================
'Unload Me
'End Sub

Private Sub Form_Load()
'==============================================================================
minX = 0
minY = 0
maxX = 700
maxY = 700

'Set Me.Icon = Nothing
Call SubClass(Me.hwnd)

End Sub

Private Sub Form_Unload(Cancel As Integer)
'==============================================================================
Call UnSubClass(Me.hwnd)
End Sub
Module code:
Code:
Option Compare Database
Option Explicit

Public defWindowProc As Long
Public minX As Long
Public minY As Long
Public maxX As Long
Public maxY As Long

Public StartupHeight As Long
Public StartupWidth As Long
Public TwipsX As Integer
Public TwipsY As Integer
Public mWFactor As Double
Public mHFactor As Double

Public Const GWL_WNDPROC As Long = (-4)
Public Const WM_GETMINMAXINFO As Long = &H24
Public Const WM_EXITSIZEMOVE As Long = &H232

Public Type POINTAPI
    x As Long
    y As Long
End Type

Public Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public 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 Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)


Public Sub SubClass(hwnd As Long)
'==============================================================================
'assign our own window message
'procedure (WindowProc)
On Error Resume Next
defWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnSubClass(hwnd As Long)
'==============================================================================
'restore the default message handling
'before exiting
If defWindowProc Then
SetWindowLong hwnd, GWL_WNDPROC, defWindowProc
defWindowProc = 0
End If
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'==============================================================================

'window message procedure
On Error Resume Next

Select Case hwnd
    'If the handle returned is to our form,
    'perform form-specific message handling
    'to deal with the notifications. If it
    'is a general system message, pass it
    'on to the default window procedure.
    'Case Form1.hwnd
    Case hwnd
        On Error Resume Next
        'form-specific handler
        Select Case uMsg
            Case WM_GETMINMAXINFO
                Dim MMI As MINMAXINFO
                CopyMemory MMI, ByVal lParam, LenB(MMI)
                'set the MINMAXINFO data to the
                'minimum and maximum values set
                'by the option choice
                With MMI
                    .ptMinTrackSize.x = minX
                    .ptMinTrackSize.y = minY
                    .ptMaxTrackSize.x = maxX
                    .ptMaxTrackSize.y = maxY
                End With
                CopyMemory ByVal lParam, MMI, LenB(MMI)
                'the MSDN tells us that if we process
                'the message, to return 0
                WindowProc = 0
            Case WM_EXITSIZEMOVE
                '-----here is the end of resizing--------------
                MsgBox "End of Resize event"
                '-------------------
            Case Else
                'this takes care of all the other messages
                'coming to the form and not specifically
                'handled above.
                WindowProc = CallWindowProc(defWindowProc, hwnd, uMsg, wParam, lParam)
            End Select
End Select
End Function
Code above adopted to quickly showcase the issue from https://www.experts-exchange.com/questions/20264992/After-Resize-Event-of-Form.html
 

Attachments

  • Resize demo.zip
    51 KB · Views: 248

Users who are viewing this thread

Top Bottom