Prevent Form Resize Below Specific Size

[abazabam]

How can I restrict a form from getting any smaller than a certain size? I've been using:

Option Explicit

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const GWL_WNDPROC = (-4)

Private Const WM_SIZING = &H214

Private Const WMSZ_LEFT = 1
Private Const WMSZ_RIGHT = 2
Private Const WMSZ_TOP = 3
Private Const WMSZ_TOPLEFT = 4
Private Const WMSZ_TOPRIGHT = 5
Private Const WMSZ_BOTTOM = 6
Private Const WMSZ_BOTTOMLEFT = 7
Private Const WMSZ_BOTTOMRIGHT = 8

Private MIN_WIDTH As Long  'The minimum width in pixels
Private MIN_HEIGHT As Long  'The minimum height in pixels
Private MAX_WIDTH As Long   'The maximum width in pixels
Private MAX_HEIGHT As Long  'The maximum height in pixels

Private Type RECT
    Left   As Long
    Top    As Long
    RIGHT  As Long
    Bottom As Long
End Type

Private mPrevProc As Long

Public Sub Hook(hWnd As Long)
    mPrevProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf NewWndProc)
End Sub

Public Sub Unhook(hWnd As Long)
    Call SetWindowLong(hWnd, GWL_WNDPROC, mPrevProc)
    mPrevProc = 0&
End Sub

Public Function NewWndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next

MIN_WIDTH = 200
MIN_HEIGHT = 200
MAX_WIDTH = Screen.Width
MAX_HEIGHT = Screen.Height

Dim r As RECT

    If uMsg = WM_SIZING Then
        Call CopyMemory(r, ByVal lParam, Len(r))
    
        'Keep the form only at least as wide as MIN_WIDTH
        If (r.RIGHT - r.Left < MIN_WIDTH) Then
            Select Case wParam
                Case WMSZ_LEFT, WMSZ_BOTTOMLEFT, WMSZ_TOPLEFT
                    r.Left = r.RIGHT - MIN_WIDTH
                Case WMSZ_RIGHT, WMSZ_BOTTOMRIGHT, WMSZ_TOPRIGHT
                    r.RIGHT = r.Left + MIN_WIDTH
            End Select
        End If
        
        'Keep the form only at least as tall as MIN_HEIGHT
        If (r.Bottom - r.Top < MIN_HEIGHT) Then
            Select Case wParam
                Case WMSZ_TOP, WMSZ_TOPLEFT, WMSZ_TOPRIGHT
                    r.Top = r.Bottom - MIN_HEIGHT
                Case WMSZ_BOTTOM, WMSZ_BOTTOMLEFT, WMSZ_BOTTOMRIGHT
                    r.Bottom = r.Top + MIN_HEIGHT
            End Select
        End If
        
        'Keep the form only as wide as MAX_WIDTH
        If (r.RIGHT - r.Left > MAX_WIDTH) Then
            Select Case wParam
                Case WMSZ_LEFT, WMSZ_BOTTOMLEFT, WMSZ_TOPLEFT
                    r.Left = r.RIGHT - MAX_WIDTH
                Case WMSZ_RIGHT, WMSZ_BOTTOMRIGHT, WMSZ_TOPRIGHT
                    r.RIGHT = r.Left + MAX_WIDTH
            End Select
        End If
        
        'Keep the form only as tall as MAX_HEIGHT
        If (r.Bottom - r.Top > MAX_HEIGHT) Then
            Select Case wParam
                Case WMSZ_TOP, WMSZ_TOPLEFT, WMSZ_TOPRIGHT
                    r.Top = r.Bottom - MAX_HEIGHT
                Case WMSZ_BOTTOM, WMSZ_BOTTOMLEFT, WMSZ_BOTTOMRIGHT
                    r.Bottom = r.Top + MAX_HEIGHT
            End Select
        End If
    
        Call CopyMemory(ByVal lParam, r, Len(r))
        
        NewWndProc = 0&
        Exit Function
    End If
    

    If mPrevProc > 0& Then
        NewWndProc = CallWindowProc(mPrevProc, hWnd, uMsg, wParam, lParam)
    Else
        NewWndProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
    End If

End Function

but for some reason, when I unload the form and reload it, the window stops responding to anything. I use the "Call Unhook(Me.hWnd)" function when I unload the form but the form still stops responding when I load it, unload it, and load it again.

[Mxjerrett]

couldn't you just do something like:

Private Sub Form_Resize()
If Me.Width < 2000 Then
Me.Width = 2000
ElseIf Me.Height < 2000 Then
Me.Height = 2000
End If
End Sub

it worked on my computer just fine.

[Joacim Andersson]

The way this code is designed you can only use it at one Form at the time, are you using for more then one Form?

[RobDog888]

couldn't you just do something like:

Private Sub Form_Resize()
If Me.Width < 2000 Then
Me.Width = 2000
ElseIf Me.Height < 2000 Then
Me.Height = 2000
End If
End Sub

it worked on my computer just fine.

You could use something like tht but it creates allot of flickering. With subclassing its flicker-free since it handles it before it draws the form changes.