Members

Technology Zones

IBM Learning Center

Articles

Hosted By

MaximumASP

Info

Rated
Read 30,600 times

Related Categories

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

James first started writing tutorials on Visual Basic in 1999 whilst starting this website (then known as VB Web). Since then, the site has grown rapidly, and James has written numerous tutorials, articles and reviews on VB, PHP, ASP and C#. In October 2003, James formed the company Developer Fusion Ltd, which owns this website, and also offers various development services. In his spare time, he's a 3rd year undergraduate studying Computer Science in the UK. He's also a Visual Basic MVP.

Comments

  • Mr. Crowley copies source code!

    Posted by alpine on 08 Aug 2003

    Hummmm..... This code looks surprisingly like the code in the GETMINMAXINFO example at http://www.mvps.org/vbvision/ Right down to the *exact* same comments! Coincidence? You be the judge!

  • It works very well :-)

    Posted by cwbs on 05 Jan 2003

    This code works fine for me. Thank you. That's all that I need for my Picture Viewer project.

  • errors in code

    Posted by Stevesoft on 05 Oct 2002

    i was using this code to try to learn subclassing, but there seems to be some errors in the syntax

    [code]
    nWidthPixels = Screen.Width Screen.TwipsPerPixelX
    nHeightPixels = Screen....

  • Posted by James Crowley on 02 Apr 2002

    What error do you get?

  • error

    Posted by ChAdWiCk on 02 Apr 2002

    i got an error message when i tried to run the code. entered it like i said, with a module and from code

    chad