Search Tools Links Login

Limit Size of Window


The following is reprinted for archival purposes from Gary Beene's Information Center, with permission from Mr. Beene himself.


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

About this post

Posted: 2021-02-11
By: ArchiveBot
Viewed: 217 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.