How to programmatically force a WM_SIZING message

[K4CY]

Hi, I have a resizable form that must maintain one of two fixed aspect ratios. Depending on menu selection, the form must be width = height or width = 2 * height. I have subclassed WM_SIZING, and have it working perfectly. Well, almost. I have yet figure out how, when changing menu settings, how to force a WM_SIZING message so that the form automatically adjusts to the new aspect ratio. Currently, I change the menu settings and have to click the mouse on the border of the form to get it to change aspect ratio. How to automate that? I'm sure it's simple, but it escapes me. TIA, Bob.

[wqweto]

how to force a WM_SIZING message so that the form automatically adjusts to the new aspect ratio.

You mean WM_SIZE message probably. Just refactor your WM_SIZE code into a separate function which accepts hWnd, NewWidth and NewHeight as parameters and call it both on WM_SIZE and from your menu settings code.

You cannot force the OS to send WM_SIZE without actually resizing the window with MoveWindow/SetWindowPos functions. For instance if you call SetWindowPos with current width/height the WM_SIZE notification is *not* sent.

Another option would be to manually call SendMessage w/ WM_SIZE and pass current width/height and correct flags in wParam/lParam but that would be considered sloppy practice at best.

cheers,
</wqw>

[Elroy]

I'd probably subclass the form, monitoring for WM_GETMINMAXINFO and then do what I wanted in the subclass procedure.

You could set some global variables about whether the aspect ratio is 1 or 0.5 (which is what you've outlined above). I'd probably also save some static variables (saving the prior width and height). Using those statics, you could figure out whether the user is changing the width or height, and then change the other accordingly. If the user is adjusting from a corner, you'd need to make a decision to pick either width or height as the user-changing dimension.

Here, I'll post some incomplete code that gets close to doing what you're suggesting.

The subclass procedure (and support):

Option Explicit

Private Const WM_DESTROY                As Long = &H2&  ' All other needed constants are declared within the procedures.
'
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
'
Private Type POINTAPI
    x As Long
    Y As Long
End Type
Private Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type
'



Public Sub SubclassForMinMaxInfo(frm As VB.Form)   ' Call this one to get the form subclassed.
    ' MUST be done in Form_Load event so Windows doesn't resize form on small monitors.
    ' Also, move (such as center) the form after calling so that WM_GETMINMAXINFO is fired.
    SubclassSomeWindow frm.hWnd, AddressOf MinMax_Proc
End Sub





Private Function MinMax_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    If uMsg = WM_DESTROY Then
        UnSubclassSomeWindow hWnd, AddressOf_MinMax_Proc, uIdSubclass
        MinMax_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    '
    Dim MMI As MINMAXINFO
    Const WM_GETMINMAXINFO As Long = &H24&
    '
    Select Case uMsg
    Case WM_GETMINMAXINFO
        '
        CopyMemory MMI, ByVal lParam, LenB(MMI)


        ' You can change these herein:

        'MMI.ptMinTrackSize.x = ????
        'MMI.ptMinTrackSize.Y = ????
        'MMI.ptMaxTrackSize.x = ????
        'MMI.ptMaxTrackSize.Y = ????


        ' And then, put it back.
        CopyMemory ByVal lParam, MMI, LenB(MMI)



        Exit Function ' If we process the message, we must return 0 and not let more subclass procedures execute.
    End Select
    '
    ' Give control to other procs, if they exist.
    MinMax_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

Private Function AddressOf_MinMax_Proc() As Long
    AddressOf_MinMax_Proc = ProcedureAddress(AddressOf MinMax_Proc)
End Function

Private Function ProcedureAddress(AddressOf_TheProc As Long) As Long
    ' A private "helper" function for writing the AddressOf_... functions (see above notes).
    ProcedureAddress = AddressOf_TheProc
End Function

Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional dwRefData As Long, Optional uIdSubclass As Long)
    If uIdSubclass = 0& Then uIdSubclass = hWnd
    Call SetWindowSubclass(hWnd, AddressOf_ProcToSubclass, uIdSubclass, dwRefData)
End Sub

Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional uIdSubclass As Long)
    ' Be careful, some subclassing may require additional cleanup that's not done here.
    If uIdSubclass = 0& Then uIdSubclass = hWnd
    Call RemoveWindowSubclass(hWnd, AddressOf_ProcToSubclass, uIdSubclass)
End Sub

EDIT: To force a certain size, just set min and max the same for that dimension. You'd have to remove those restrictions for the dimension you're actually resizing.

[Elroy]

I've been playing with it, and I think subclassing on WM_SIZE would be easier. In fact, now I'm wondering if it all can be done in the Resize event, although that might flicker.

[Elroy]

Here, I did it for a 1-to-1 aspect ratio using WM_GETMINMAXINFO. The nice thing about WM_GETMINMAXINFO is that you get it before the form is resized (so, reduced flickering).

Here's code for a module (BAS):

Option Explicit

Private Const WM_DESTROY                As Long = &H2&  ' All other needed constants are declared within the procedures.
'
Private Type RECT
    Left   As Long
    Top    As Long
    Right  As Long ' This is +1 (right - left = width)
    Bottom As Long ' This is +1 (bottom - top = height)
End Type
'
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
'
Private Type POINTAPI
    x As Long
    Y As Long
End Type
Private Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type
'
Private mlPriorWidth As Long
'



Public Sub SubclassForMinMaxInfo(frm As VB.Form)   ' Call this one to get the form subclassed.
    ' MUST be done in Form_Load event so Windows doesn't resize form on small monitors.
    ' Also, move (such as center) the form after calling so that WM_GETMINMAXINFO is fired.
    SubclassSomeWindow frm.hWnd, AddressOf MinMax_Proc
    mlPriorWidth = WindowWidthInPixels(frm.hWnd)
End Sub

Private Function MinMax_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    If uMsg = WM_DESTROY Then
        UnSubclassSomeWindow hWnd, AddressOf_MinMax_Proc, uIdSubclass
        MinMax_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    '
    Dim MMI As MINMAXINFO
    Const WM_GETMINMAXINFO As Long = &H24&
    '
    Select Case uMsg
    Case WM_GETMINMAXINFO
        '
        CopyMemory MMI, ByVal lParam, LenB(MMI)
        Static iCount  As Long
        If iCount = 0& Then
            iCount = iCount + 1&
            Dim r           As RECT
            GetWindowRect hWnd, r
            If (r.Right - r.Left) <> mlPriorWidth Then
                ' We're trying to change width.
                MMI.ptMinTrackSize.x = 0&
                MMI.ptMaxTrackSize.x = &HFFFFFF
                MMI.ptMinTrackSize.Y = r.Right - r.Left
                MMI.ptMaxTrackSize.Y = r.Right - r.Left
                mlPriorWidth = r.Right - r.Left
                CopyMemory ByVal lParam, MMI, LenB(MMI)
                Exit Function ' If we process the message, we must return 0 and not let more subclass procedures execute.
            Else
                MMI.ptMinTrackSize.x = r.Bottom - r.Top
                MMI.ptMaxTrackSize.x = r.Bottom - r.Top
                MMI.ptMinTrackSize.Y = 0&
                MMI.ptMaxTrackSize.Y = &HFFFFFF
                CopyMemory ByVal lParam, MMI, LenB(MMI)
                Exit Function ' If we process the message, we must return 0 and not let more subclass procedures execute.
            End If
        Else
            iCount = iCount - 1&
        End If
    End Select
    '
    ' Give control to other procs, if they exist.
    MinMax_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

Private Function AddressOf_MinMax_Proc() As Long
    AddressOf_MinMax_Proc = ProcedureAddress(AddressOf MinMax_Proc)
End Function

Private Function ProcedureAddress(AddressOf_TheProc As Long) As Long
    ' A private "helper" function for writing the AddressOf_... functions (see above notes).
    ProcedureAddress = AddressOf_TheProc
End Function

Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional dwRefData As Long, Optional uIdSubclass As Long)
    If uIdSubclass = 0& Then uIdSubclass = hWnd
    Call SetWindowSubclass(hWnd, AddressOf_ProcToSubclass, uIdSubclass, dwRefData)
End Sub

Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional uIdSubclass As Long)
    ' Be careful, some subclassing may require additional cleanup that's not done here.
    If uIdSubclass = 0& Then uIdSubclass = hWnd
    Call RemoveWindowSubclass(hWnd, AddressOf_ProcToSubclass, uIdSubclass)
End Sub

Private Function WindowWidthInPixels(hWndOfInterest As Long) As Long
    Dim r As RECT
    GetWindowRect hWndOfInterest, r
    WindowWidthInPixels = r.Right - r.Left ' Not sure why, but the +1 is not needed.
End Function

And here's all I have in my form:

Option Explicit

Private Sub Form_Load()
    SubclassForMinMaxInfo Me
End Sub

EDIT: Ok, I didn't quite have it working. I changed the BAS module code, and it's now "sort of" working, but I've now got a bad flicker. I think I just need to resize rather than forcing it with min/max.

[Elroy]

Here it is, trying to use WM_SIZE, but I still don't have it quite right. I'm hungry though and going to get some lunch:

Option Explicit

Private Const WM_DESTROY                As Long = &H2&  ' All other needed constants are declared within the procedures.
'
Private Type RECT
    Left   As Long
    Top    As Long
    Right  As Long ' This is +1 (right - left = width)
    Bottom As Long ' This is +1 (bottom - top = height)
End Type
'
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, Optional ByVal bRepaint As Long = 1&) As Long
'
Private Type POINTAPI
    x As Long
    Y As Long
End Type
Private Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type
'
Private mlPriorWidth As Long
'



Public Sub SubclassForMinMaxInfo(frm As VB.Form)   ' Call this one to get the form subclassed.
    ' MUST be done in Form_Load event so Windows doesn't resize form on small monitors.
    ' Also, move (such as center) the form after calling so that WM_GETMINMAXINFO is fired.
    SubclassSomeWindow frm.hWnd, AddressOf MinMax_Proc
    mlPriorWidth = WindowWidthInPixels(frm.hWnd)
End Sub

Private Function MinMax_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    If uMsg = WM_DESTROY Then
        UnSubclassSomeWindow hWnd, AddressOf_MinMax_Proc, uIdSubclass
        MinMax_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    '
    Dim MMI As MINMAXINFO
    Const WM_SIZE As Long = &H5&
    '
    Select Case uMsg
    Case WM_SIZE
        Static iCount  As Long
        If iCount = 0& Then
            iCount = iCount + 1&
            Dim r           As RECT
            GetWindowRect hWnd, r
            If (r.Right - r.Left) <> mlPriorWidth Then
                r.Bottom = (r.Right - r.Left) + r.Top
                mlPriorWidth = r.Right - r.Left
            Else
                r.Right = (r.Bottom - r.Top) + r.Left
            End If
            MoveWindow hWnd, r.Left, r.Top, r.Right - r.Left, r.Bottom - r.Top
        Else
            iCount = iCount - 1&
        End If
    End Select
    '
    ' Give control to other procs, if they exist.
    MinMax_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

Private Function AddressOf_MinMax_Proc() As Long
    AddressOf_MinMax_Proc = ProcedureAddress(AddressOf MinMax_Proc)
End Function

Private Function ProcedureAddress(AddressOf_TheProc As Long) As Long
    ' A private "helper" function for writing the AddressOf_... functions (see above notes).
    ProcedureAddress = AddressOf_TheProc
End Function

Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional dwRefData As Long, Optional uIdSubclass As Long)
    If uIdSubclass = 0& Then uIdSubclass = hWnd
    Call SetWindowSubclass(hWnd, AddressOf_ProcToSubclass, uIdSubclass, dwRefData)
End Sub

Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional uIdSubclass As Long)
    ' Be careful, some subclassing may require additional cleanup that's not done here.
    If uIdSubclass = 0& Then uIdSubclass = hWnd
    Call RemoveWindowSubclass(hWnd, AddressOf_ProcToSubclass, uIdSubclass)
End Sub

Private Function WindowWidthInPixels(hWndOfInterest As Long) As Long
    Dim r As RECT
    GetWindowRect hWndOfInterest, r
    WindowWidthInPixels = r.Right - r.Left ' Not sure why, but the +1 is not needed.
End Function

It'd be nice if we could "catch" it and know what the new size is going to be but before it actually changes it.

[jj2007]

It's actually pretty simple: lParam of the WM_SIZING message is the "address of a RECT structure with the screen coordinates of the drag rectangle. To change the size or position of the drag rectangle, an application must change the members of this structure".
So you get the width via rc.right-rc.left, multiply it with your fixed factor to get the height, then add rc.top to the height, and voilà: rc.bottom. Works like a charm