Set Maximum/Minimum form size

This example prevents form being resized beyond a specified size, using subclassing

Add the following code to a form


Option Explicit

'// form_load event. Catch all those messages!
Private Sub Form_Load()
    Dim lhSysMenu As Long, lRet As Long
    On Error Resume Next
    '// saves the previous window message handler. Always restore this value
    '// AddressOf command sends the address of the WindowProc procedure
    '// to windows
    ProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
    Show
End Sub

'// form_queryunload event. Return control to windows/vb
Private Sub Form_Unload(Cancel As Integer)
    '// give message processing control back to VB
    '// if you don'//t do this you WILL crash!!!
    Call SetWindowLong(hWnd, GWL_WNDPROC, ProcOld)
End Sub

and then add the code below to a module...

Option Explicit
' windows api constants
' variable that stores the previous message handler
Public ProcOld As Long

' extra type declarations
Type POINTAPI
    x As Long
    y As Long
End Type

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

' the message we will subclass
Public Const WM_GETMINMAXINFO As Long = &H24
Public Const GWL_WNDPROC = (-4)
' Windows API Call for catching messages
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
' Windows API call for calling window procedures
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
' use this WindowProc procedure
Public Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
    ' ----WARNING----
    ' do not attempt to debug this procedure!!
    ' ----WARNING----

    ' this is our implementation of the message handling routine
    ' determine which message was recieved
    Select Case iMsg
    Case WM_GETMINMAXINFO
        ' dimention a variable to hold the structure passed from Windows in lParam
        Dim udtMINMAXINFO As MINMAXINFO
        Dim nWidthPixels As Long, nHeightPixels As Long
       
        nWidthPixels = Screen.Width * Screen.TwipsPerPixelX
        nHeightPixels = Screen.Height * Screen.TwipsPerPixelY
       
        ' copy the struct to our UDT variable
        CopyMemory udtMINMAXINFO, ByVal lParam, 40&
       
        With udtMINMAXINFO
            ' set the width of the form when it's maximized
            .ptMaxSize.x = 500
            ' set the height of the form when it's maximized
            .ptMaxSize.y = 500
           ' Debug.Print nWidthPixels
            ' set the Left of the form when it's maximized
            .ptMaxPosition.x = nWidthPixels * 8
            ' set the Top of the form when it's maximized
            .ptMaxPosition.y = nHeightPixels * 8
           
            ' set the max width that the user can size the form
            .ptMaxTrackSize.x = 500
            ' set the max height that the user can size the form
            .ptMaxTrackSize.y = 500
           
            ' set the min width that the user can size the form
            .ptMinTrackSize.x = 300
            ' set the min height that the user can size the form
            .ptMinTrackSize.y = 200
        End With
       
        ' copy our modified struct back to the Windows struct
        CopyMemory ByVal lParam, udtMINMAXINFO, 40&
       
        ' return zero indicating that we have acted on this message
        WindowProc = False
       
        ' exit the function without letting VB get it's grubby little hands on the message
        Exit Function
    End Select
    ' pass all messages on to VB and then return the value to windows
    WindowProc = CallWindowProc(ProcOld, hWnd, iMsg, wParam, lParam)
End Function

You might also like...

Comments

James Crowley James first started this website when learning Visual Basic back in 1999 whilst studying his GCSEs. The site grew steadily over the years while being run as a hobby - to a regular monthly audience ...

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“PHP is a minor evil perpetrated and created by incompetent amateurs, whereas Perl is a great and insidious evil perpetrated by skilled but perverted professionals.” - Jon Ribbens