Visual Basic Subclassing Routines
WM_GETMINMAXINFO: Restrict Form Resizing
Posted:   Wednesday July 1, 1998
Updated:   Monday December 26, 2011
Applies to:   VB5, VB6
Developed with:   VB6, Windows 98
OS restrictions:   None
Author:   VBnet - Randy Birch


WM_SIZING: Maintain Form Aspect Ratio During Resizing
VB5 or VB6.

Preventing user resizing of a form is not easily accomplished without subclassing the form. Attempting to test the form's width and height properties in the resize event will work, but only after the form has been resized, forcing the form to pop back to its restricted size.

Using a subclassed form, a VB app can trap the WM_GETMINMAXINFO message Windows sends when sizing is initiated and throughout the resize action. Trapping this message provides the opportunity to set the MINMAXINFO structure members to our own pre-determined values enforce restrict form resizing.

This example is based on source gathered from Karl E. Peterson and  Domenico Statuto, Tom Hare's example, and postings to the vb newsgroups by vinh and Mike Riley.

 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
Public minX As Long
Public minY As Long
Public maxX As Long
Public maxY As Long

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

Public Type POINTAPI
    x As Long
    y As Long
End Type

    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 frmMain.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 Else
                  'this takes care of all the other messages
                  'coming to the form and not specifically 
                  'handled above.
                   WindowProc = CallWindowProc(defWindowProc, _
                                               hwnd, _
                                               uMsg, _
                                               wParam, _
          End Select
   End Select
End Function
 Form Code
To a form, add three option buttons in a control array (option1(0) - Option1(2)) and a command button (Command1). Name the form 'frmMain', and add the following code:

Option Explicit

Private StartupHeight As Long
Private StartupWidth As Long
Private TwipsX As Integer
Private TwipsY As Integer

Private Sub Command1_Click()

   Unload Me
End Sub

Private Sub Form_Load()

  'saves re-referencing the Screen 
  'properties in the option button event 
   TwipsX = Screen.TwipsPerPixelX
   TwipsY = Screen.TwipsPerPixelY
   StartupWidth = Me.Width \ TwipsX
   StartupHeight = Me.Height \ TwipsY
   Option1(0).Value = True
   Set Me.Icon = Nothing
   Call SubClass(frmMain.hwnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)

    Call UnSubClass(Me.hwnd)

End Sub

Private Sub Option1_Click(Index As Integer)

   Select Case Index
      Case 0  'Never Larger than Startup Size
         minX = 0
         minY = 0
         maxX = StartupWidth
         maxY = StartupHeight

      Case 1  'Never Smaller than Startup Size
         minX = StartupWidth
         minY = StartupHeight
         maxX = Screen.Width \ TwipsX
         maxY = Screen.Height \ TwipsY
      Case 2  'Stop All Resizing
         minX = Me.Width \ TwipsX
         minY = Me.Height \ TwipsY
         maxX = Me.Width \ TwipsX
         maxY = Me.Height \ TwipsY
   End Select
End Sub
Save then run the project  using Start with Full Compile. 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, try to change the form size. It will be limited by the option selected.


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