Visual Basic Subclassing Routines
WM_SIZING: Maintain Form Aspect Ratio During Resizing
     
Posted:   Friday January 25, 2002
Updated:   Monday December 26, 2011
     
Applies to:   VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

WM_GETMINMAXINFO: Restrict Form Resizing
     
 Prerequisites
VB5 or VB6.

WM_GETMINMAXINFO: Restrict Form Resizing showed how to use subclassing to intercept the form's WM_GETMINMAXINFO message and how to change the message's RECT data into coordinates that would prohibit form resizing. The key to the WM_GETMINMAXINFO technique is the fact that this message is sent to a window when the size or position of the window is about to change, providing the opportunity to set the minimum or maximum allowable size of the window.

Along with the WM_GETMINMAXINFO, the WM_SIZING message is also sent to the WindowProc during a resize event. And although this message also passes a RECT structure as part of the message parameters, it differs from WM_GETMINMAXINFO in that it is sent to a window that the user is currently resizing. By processing this message we can not only monitor the size and position of the window's drag rectangle, we can also change the drag rectangle's size or position by adjusting the values in the RECT structure passed.  By calculating the size of the form in one direction as the window is sized we can set this same size into the RECT structure's other dimension, thereby causing the window to resize while retaining its aspect ratio.

To keep things simple, the demo shows maintaining a square aspect ratio. The demo requires only a command button - the other labels shown in the illustration are informative and explained below.

In addition to the RECT passed as lParam to the WindowProc with the WM_SIZING message, wParam contains a value (the grey labels) that indicate which of the eight possible resizing areas is being used to perform the resizing. With this information we can code to have the aspect-maintaining equation resize so as to nail the form at a particular corner of interest. The large red numbers indicate the four possible 'nail' points during a resize, while the green labels show which corner will be nailed during the resizing in this demo.

 BAS Module Code
Place the following code into the general declarations area of a bas module:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public defWindowProc As Long
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_DESTROY = &H2
Private Const WM_SIZING = &H214

'wParam for WM_SIZING message
Private Const WMSZ_LEFT = 1
Private Const WMSZ_RIGHT = 2
Private Const WMSZ_TOP = 3
Private Const WMSZ_TOPLEFT = 4
Private Const WMSZ_TOPRIGHT = 5
Private Const WMSZ_BOTTOM = 6
Private Const WMSZ_BOTTOMLEFT = 7
Private Const WMSZ_BOTTOMRIGHT = 8

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Declare Function GetWindowLong Lib "user32" _
    Alias "GetWindowLongA" _
   (ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long
    
Private Declare Function SetWindowLong Lib "user32" _
    Alias "SetWindowLongA" _
   (ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
   
Private 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

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



Public Sub Unhook(fhwnd As Long)
    
   If defWindowProc Then
      Call SetWindowLong(fhwnd, GWL_WNDPROC, defWindowProc)
      defWindowProc = 0
   End If

End Sub


Public Sub Hook(fhwnd As Long)
    
   defWindowProc = SetWindowLong(fhwnd, _
                                 GWL_WNDPROC, _
                                 AddressOf WindowProc)
                                  
   
End Sub


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

   Dim rc As RECT
   
   Select Case uMsg
   
      Case WM_SIZING
      
        'copy the RECT pointed to in
        'lParam into a RECT structure
         CopyMemory rc, ByVal lParam, LenB(rc)
      
        'wParam tells which one of the eight
        'possible resizing handles is being used.
        'Set the appropriate RECT member to the
        'size required to maintain aspect ratio,
        'and copy back into the RECT struct for
        'processing by Windows.
         Select Case wParam
         
            Case WMSZ_LEFT
               rc.Bottom = (rc.Right - rc.Left) + rc.Top
               CopyMemory ByVal lParam, rc, LenB(rc)
               WindowProc = 1
   
            Case WMSZ_RIGHT
               rc.Bottom = (rc.Right - rc.Left) + rc.Top
               CopyMemory ByVal lParam, rc, LenB(rc)
               WindowProc = 1
   
            Case WMSZ_TOP
               rc.Right = (rc.Bottom - rc.Top) + rc.Left
               CopyMemory ByVal lParam, rc, LenB(rc)
               WindowProc = 1
   
            Case WMSZ_BOTTOM
               rc.Right = (rc.Bottom - rc.Top) + rc.Left
               CopyMemory ByVal lParam, rc, LenB(rc)
               WindowProc = 1
   
            Case WMSZ_TOPLEFT
               rc.Left = (rc.Top - rc.Bottom) + (rc.Right)
               CopyMemory ByVal lParam, rc, LenB(rc)
               WindowProc = 1
               
            Case WMSZ_TOPRIGHT
               rc.Right = (rc.Bottom - rc.Top) + rc.Left
               CopyMemory ByVal lParam, rc, LenB(rc)
               WindowProc = 1
   
            Case WMSZ_BOTTOMLEFT
               rc.Bottom = (rc.Right - rc.Left) + (rc.Top)
               CopyMemory ByVal lParam, rc, LenB(rc)
               WindowProc = 1
               
            Case WMSZ_BOTTOMRIGHT
               rc.Bottom = (rc.Right - rc.Left) + rc.Top
               CopyMemory ByVal lParam, rc, LenB(rc)
               WindowProc = 1
   
            End Select
      
         Case WM_DESTROY:
           'kill subclassing if active
            If defWindowProc <> 0 Then
               Call Unhook(form1.hwnd)
            End If
      
    End Select
    
  'process windows messages
   WindowProc = CallWindowProc(defWindowProc, _
                               hwnd, _
                               uMsg, _
                               wParam, _
                               lParam)

End Function
 Form Code
To a form (Form1), add a command button (Command1) and the following code:

Option Explicit

Private Sub Form_Load()

   With form1
      
      .Width = 6000
      .Height = 6000
      Call Hook(.hwnd)
   
   End With
   
End Sub


Private Sub Command1_Click()

   Unload Me
   
End Sub


Private Sub Form_Unload(Cancel As Integer)

    Call Unhook(Me.hwnd)

End Sub
 Comments
Save then run the project using Run / Start with Full Compile to check for errors. This is also recommended when changing the controls or code on the form as once the form becomes subclassed, you can not edit the code should an error occur. Once running resize the form. It will maintain a square aspect ratio throughout the resizing action.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter