Limit Size of Window

Option Explicit
'A demo project showing how to prevent the user from making a window smaller
'or larger than you want them to, through subclassing the WM_GETMINMAXINFO message.
'by Bryan Stafford of New Vision Software® - newvision@mvps.org
'this demo is released into the Public domain "As Is" without
'warranty Or guaranty of Any kind.  In other words, use at
'your own risk.
 
' See the comments at the end of this Module for a brief explaination of
' what subclassing Is.
 
  Type POINTAPI
   X As Long
   Y As Long
 End Type

  ' the message we will subclass
  Public Const WM_GETMINMAXINFO As Long = &H24&

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


  ' this var will hold a pointer to the original message handler so we MUST
  ' save it so that it can be restored before we exit the app.  If we don't
  ' restore it.... CRASH!!!!
  Public g_nProcOld As Long
 
  ' declarations of the API functions used
  Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, _
                                                                                          ByVal cBytes&)
                                                                                         
  Public Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" ( ByVal lpPrevWndFunc&, _
                                                    ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
 
  Public Const GWL_WNDPROC As Long = ( - 4&)
   
  ' API Call To alter the class data for a window
  Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( ByVal hwnd&, _
                                                              ByVal nIndex&, ByVal dwNewLong&) As Long

'=====================================================================================

Public Function  WindowProc( ByVal hwnd As Long , ByVal iMsg As Long , _
                                              ByVal wParam As Long , ByVal lParam As Long ) As Long
   
  ' this Is *our* implimentation 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&, nHeightPixels&
     
     nWidthPixels = Screen.Width \ Screen.TwipsPerPixelX
     nHeightPixels = Screen.Height \ Screen.TwipsPerPixelY
     
      ' copy the struct to our UDT variable
     CopyMemory udtMINMAXINFO, ByVal lParam, Len(udtMINMAXINFO)
          
      With udtMINMAXINFO
        ' Set the width of the form when it's maximized
       .ptMaxSize.X = nWidthPixels '- (nWidthPixels \ 4)
        ' Set the height of the form when it's maximized
       .ptMaxSize.Y = nHeightPixels '- (nHeightPixels \ 4)
       
        ' Set the left of the form when it's maximized
       .ptMaxPosition.X = 0   'nWidthPixels \ 8
        ' Set the top of the form when it's maximized
       .ptMaxPosition.Y = 0   'nHeightPixels \ 8
       
        ' Set the max width that the user can drag the form
       .ptMaxTrackSize.X = .ptMaxSize.X
        ' Set the max height that the user can drag the form
       .ptMaxTrackSize.Y = .ptMaxSize.Y
       
        ' Set the min Width that the user can drag the form
       .ptMinTrackSize.X = 5550 \ Screen.TwipsPerPixelX   'nWidthPixels \ 4
        ' Set the min width that the user can drag the form
       .ptMinTrackSize.Y = 4400 \ Screen.TwipsPerPixelY   'nHeightPixels \ 4
      End With
          
      ' copy our modified struct back to the Windows struct
     CopyMemory ByVal lParam, udtMINMAXINFO, Len(udtMINMAXINFO)
 
      ' Return zero indicating that we have acted on this message
     WindowProc = 0&
     
      ' 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(g_nProcOld, hwnd, iMsg, wParam, lParam)

End Function

'==================================================
Private Sub  Form_Unload(Cancel As Integer )
 
  ' give message processing control back To VB
  ' If you don't do this you WILL crash!!!
If UseSubClassing Then Call SetWindowLong(hwnd, GWL_WNDPROC, g_nProcOld)

End Sub