|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
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. |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |