Mininimum limit when resizing

Hi

how to allow the minimum limit of resizing of a form ?

You could do it in the Resize event of the form, but that will cause strange effects.
Better to subclass the form and check for changes:
http://www.vbforums.com/showthread.p...07#post1263307
http://www.vb-helper.com/howto_restrict_form_size.html

Quote:

---

Originally Posted by Arnoutdv

You could do it in the Resize event of the form, but that will cause strange effects.
Better to subclass the form and check for changes:
http://www.vbforums.com/showthread.p...07#post1263307
http://www.vb-helper.com/howto_restrict_form_size.html

---

Very , very Good

But I have a doubt How can I do when I have many forms in the project , How can I to control

Code:

---

Const MIN_WIDTH = 200
Const MAX_WIDTH = 500
Const MIN_HEIGHT = 100
Const MAX_HEIGHT = 300

---

for each form

BTW - How I put this topic with Correct Answer ?

Check the subclass class by the Trick:
http://www.vbforums.com/showthread.p...ws-and-classes

Hi,

here is one simple way of doing it.
make the Form the minimum size you want, and put a Label at the bottom right corner and set it visible=False

place this in the Form

Code:

---

'Here is stored the current size of the form
Public FormOldWidth As Long
Public FormOldHeight As Long

Private Sub Form_Load()
  'Set the size of the form
  'Set the minimal size of the form with the Label
  'in the right bottom corner of the form
  Me.Width = Me.Label1.Left + (Me.Width - Me.ScaleWidth)
  Me.Height = Me.Label1.Top + (Me.Height - Me.ScaleHeight)
  Me.Top = 0
  Me.Left = 0
  Me.FormOldHeight = Me.Height
  Me.FormOldWidth = Me.Width
End Sub

'Auto resize
Private Sub Form_Resize()
  If Not Me.WindowState = vbMinimized Then
    'Does not let it be smaller that the minimum settings
    'this also works if MDI form is on normal view
    If Me.Height < Label1.Top + (Me.Height - Me.ScaleHeight) Or Me.Width < Me.Label1.Left + (Me.Width - Me.ScaleWidth) Then
      Me.Height = Label1.Top + (Me.Height - Me.ScaleHeight)
      Me.Width = Me.Label1.Left + (Me.Width - Me.ScaleWidth)
      Exit Sub
    End If
  End If
End Sub

---

regards
Chris

Yet another subclassing solution:

Code:

---

Option Explicit    'In Module1.bas

Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Sub PutMem8 Lib "msvbvm60.dll" (ByVal Addr As Long, ByVal NewValLo As Long, ByVal NewValHi As Long) '<-- Modified NewVal param from Currency to 2 Longs

Public Function Subclass(ByRef Form As VB.Form, Optional ByVal MinWidth As Integer = -1, _
                                                Optional ByVal MinHeight As Integer = -1, _
                                                Optional ByVal MaxWidth As Integer = -1, _
                                                Optional ByVal MaxHeight As Integer = -1) As Boolean
    Dim uIdSubclass As Long, dwRefData As Long

    If MinWidth = -1 Then MinWidth = Form.Width \ Screen.TwipsPerPixelX
    If MinHeight = -1 Then MinHeight = Form.Height \ Screen.TwipsPerPixelY
    If MaxWidth = -1 Then MaxWidth = Screen.Width \ Screen.TwipsPerPixelX
    If MaxHeight = -1 Then MaxHeight = Screen.Height \ Screen.TwipsPerPixelY

    uIdSubclass = MinHeight * &H10000 Or MinWidth And &HFFFF&
    dwRefData = MaxHeight * &H10000 Or MaxWidth And &HFFFF&

    Subclass = SetWindowSubclass(Form.hWnd, AddressOf SubclassProc, uIdSubclass, dwRefData):    Debug.Assert Subclass
End Function

Private Function SubclassProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, _
                              ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    Const WM_GETMINMAXINFO = &H24&, WM_DESTROY = &H2&, SIGN_BIT = &H80000000

    Select Case uMsg
        Case WM_GETMINMAXINFO
            PutMem8 (lParam Xor SIGN_BIT) + 24& Xor SIGN_BIT, uIdSubclass And &HFFFF&, ((uIdSubclass And &H7FFF0000) \ &H10000) Or ((uIdSubclass And &H80000000) = &H80000000 And &H8000&)
            PutMem8 (lParam Xor SIGN_BIT) + 32& Xor SIGN_BIT, dwRefData And &HFFFF&, ((dwRefData And &H7FFF0000) \ &H10000) Or ((dwRefData And &H80000000) = &H80000000 And &H8000&)
            Exit Function

        Case WM_DESTROY
            SubclassProc = RemoveWindowSubclass(hWnd, AddressOf Module1.SubclassProc, uIdSubclass): Debug.Assert SubclassProc
    End Select

    SubclassProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function

---

Code:

---

Option Explicit    'In a Form

Private Sub Form_Load()
    Const MIN_WIDTH = 200, MIN_HEIGHT = 100
    Const MAX_WIDTH = 500, MAX_HEIGHT = 300

    Subclass Me, MIN_WIDTH, MIN_HEIGHT, MAX_WIDTH, MAX_HEIGHT
End Sub

Private Sub Form_Resize()
    Caption = Name & ": " & (Width \ Screen.TwipsPerPixelX) & " x " & (Height \ Screen.TwipsPerPixelY)
End Sub

---

Here's the subclassing solution I put together for MaxSize. I've never needed MinSize, but it'd be easy to work out from the following code.

Code for BAS module:

Code:

---


Option Explicit
'
Public gbAllowSubclassing As Boolean
'
Private Const WM_DESTROY As Long = &H2&
'
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function GetWindowSubclass Lib "comctl32.dll" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
Dim bSetWhenSubclassing_UsedByIdeStop As Boolean ' Never goes false once set by first subclassing, unless IDE Stop button is clicked.
'
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
'
'**************************************************************************************
' The following MODULE level stuff is specific to individual subclassing needs.
'**************************************************************************************
'
Private Type POINTAPI
    X              As Long
    Y              As Long
End Type
Private Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type
'

'**************************************************************************************
'**************************************************************************************
'**************************************************************************************
'
' Generic subclassing procedures (used in many of the specific subclassing).
'
'**************************************************************************************
'**************************************************************************************
'**************************************************************************************

Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToHook As Long, Optional dwRefData As Long)
    ' This just always uses hWnd for uIdSubclass, as we never have a need to subclass the same window to the same proc.
    ' The uniqueness is pfnSubclass and uIdSubclass (second and third argument below).
    '
    ' This can be called AFTER the initial subclassing to update dwRefData.
    '
    If Not gbAllowSubclassing Then Exit Sub
    '
    bSetWhenSubclassing_UsedByIdeStop = True
    Call SetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, dwRefData)
End Sub

Private Function GetSubclassRefData(hWnd As Long, AddressOf_ProcToHook As Long) As Long
    ' This one is used only to fetch the optional dwRefData you may have specified when calling SubclassSomeWindow.
    ' Typically this would only be used by the hooked procedure, but it is available to anyone.
    Call GetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, GetSubclassRefData)
End Function

Private Function IsSubclassed(hWnd As Long, AddressOf_ProcToHook As Long) As Boolean
    ' This just tells us we're already subclassed.
    Dim dwRefData As Long
    IsSubclassed = GetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, dwRefData) = 1&
End Function

Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToHook As Long)
    ' Only needed if we specifically want to un-subclass before we're closing the form (or control),
    ' otherwise, it's automatically taken care of when the window closes.
    '
    ' Be careful, some subclassing may require additional cleanup that's not done here.
    Call RemoveWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd)
End Sub

Private Function ProcedureAddress(AddressOf_TheProc As Long)
    ' A private "helper" function for writing the AddressOf_... functions (see above notes).
    ProcedureAddress = AddressOf_TheProc
End Function

Private Function DummyProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    ' This could be used to just use comctl32.dll to store data for us in the dwRefData.
    '
    ' Give control to other hooks, if they exist.
    DummyProc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

Private Function IdeStopButtonClicked() As Boolean
    ' The following works because all variables are cleared when the STOP button is clicked,
    ' even though other code may still execute such as Windows calling some of the subclassing procedures below.
    IdeStopButtonClicked = Not bSetWhenSubclassing_UsedByIdeStop
End Function

'**************************************************************************************
'**************************************************************************************
'**************************************************************************************

Public Sub SubclassFormMaxSize(frm As VB.Form, MaxWidth As Long, MaxHeight As Long)
    ' MUST be done in Form_Load event so Windows doesn't resize form on small monitors.
    ' Also, move (such as center) the form after calling so that WM_GETMINMAXINFO is fired.
    ' Can be called repeatedly to change MaxWidth and/or MaxHeight with no harm done.
    SubclassSomeWindow frm.hWnd, AddressOf MaxSize_Proc, CLng(MaxHeight * &H10000 + MaxWidth)
End Sub

Private Function MaxSize_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    If uMsg = WM_DESTROY Then
        UnSubclassSomeWindow hWnd, AddressOf_MaxSize_Proc
        MaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    If IdeStopButtonClicked Then ' Protect the IDE.  Don't execute any specific stuff if we're stopping.  We may run into COM objects or other variables that no longer exist.
        MaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    '
    Dim MaxWidth As Long
    Dim MaxHeight As Long
    Dim MMI As MINMAXINFO
    Const WM_GETMINMAXINFO As Long = &H24&
    '
    Select Case uMsg
    Case WM_GETMINMAXINFO
        MaxWidth = dwRefData And &HFFFF&
        MaxHeight = (dwRefData And &H7FFF0000) \ &H10000
        '
        CopyMemory MMI, ByVal lParam, LenB(MMI)
        MMI.ptMaxTrackSize.X = MaxWidth
        MMI.ptMaxTrackSize.Y = MaxHeight
        CopyMemory ByVal lParam, MMI, LenB(MMI)
        Exit Function ' If we process the message, we must return 0 and not let more hook code execute.
    End Select
    '
    ' Give control to other hooks, if they exist.
    MaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

Private Function AddressOf_MaxSize_Proc() As Long
    AddressOf_MaxSize_Proc = ProcedureAddress(AddressOf MaxSize_Proc)
End Function




---

Test code in Form1:

Code:

---


Option Explicit

Private Sub Form_Load()
    gbAllowSubclassing = True
    SubclassFormMaxSize Me, 300, 300
End Sub



---

Also, your Form1 should be smaller than the max to start with (or you should resize it in Form_Load).

I'm going to eat some breakfast, but I'll work it out for MinSize a bit later.

Enjoy,
Elroy

EDIT1: Also, you get all of my "generic" comctl32 subclassing stuff too. It's "near" IDE safe. Also, for development, you could check to see if you're in the IDE and not set that gbAllowSubclassing flag.

Here it is for MinSize. Also, just as an FYI, this thing is entirely independent per-form. In other words, you can call it for as many forms as you like with different dimensions per form.

The BAS piece:

Code:

---


Option Explicit
'
Public gbAllowSubclassing As Boolean
'
Private Const WM_DESTROY As Long = &H2&
'
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function GetWindowSubclass Lib "comctl32.dll" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
Dim bSetWhenSubclassing_UsedByIdeStop As Boolean ' Never goes false once set by first subclassing, unless IDE Stop button is clicked.
'
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
'
'**************************************************************************************
' The following MODULE level stuff is specific to individual subclassing needs.
'**************************************************************************************
'
Private Type POINTAPI
    X              As Long
    Y              As Long
End Type
Private Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type
'

'**************************************************************************************
'**************************************************************************************
'**************************************************************************************
'
' Generic subclassing procedures (used in many of the specific subclassing).
'
'**************************************************************************************
'**************************************************************************************
'**************************************************************************************

Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToHook As Long, Optional dwRefData As Long)
    ' This just always uses hWnd for uIdSubclass, as we never have a need to subclass the same window to the same proc.
    ' The uniqueness is pfnSubclass and uIdSubclass (second and third argument below).
    '
    ' This can be called AFTER the initial subclassing to update dwRefData.
    '
    If Not gbAllowSubclassing Then Exit Sub
    '
    bSetWhenSubclassing_UsedByIdeStop = True
    Call SetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, dwRefData)
End Sub

Private Function GetSubclassRefData(hWnd As Long, AddressOf_ProcToHook As Long) As Long
    ' This one is used only to fetch the optional dwRefData you may have specified when calling SubclassSomeWindow.
    ' Typically this would only be used by the hooked procedure, but it is available to anyone.
    Call GetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, GetSubclassRefData)
End Function

Private Function IsSubclassed(hWnd As Long, AddressOf_ProcToHook As Long) As Boolean
    ' This just tells us we're already subclassed.
    Dim dwRefData As Long
    IsSubclassed = GetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, dwRefData) = 1&
End Function

Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToHook As Long)
    ' Only needed if we specifically want to un-subclass before we're closing the form (or control),
    ' otherwise, it's automatically taken care of when the window closes.
    '
    ' Be careful, some subclassing may require additional cleanup that's not done here.
    Call RemoveWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd)
End Sub

Private Function ProcedureAddress(AddressOf_TheProc As Long)
    ' A private "helper" function for writing the AddressOf_... functions (see above notes).
    ProcedureAddress = AddressOf_TheProc
End Function

Private Function DummyProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    ' This could be used to just use comctl32.dll to store data for us in the dwRefData.
    '
    ' Give control to other hooks, if they exist.
    DummyProc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

Private Function IdeStopButtonClicked() As Boolean
    ' The following works because all variables are cleared when the STOP button is clicked,
    ' even though other code may still execute such as Windows calling some of the subclassing procedures below.
    IdeStopButtonClicked = Not bSetWhenSubclassing_UsedByIdeStop
End Function

'**************************************************************************************
'**************************************************************************************
'**************************************************************************************

Public Sub SubclassFormMinSize(frm As VB.Form, MinWidth As Long, MinHeight As Long)
    ' MUST be done in Form_Load event so Windows doesn't resize form on small monitors.
    ' Also, move (such as center) the form after calling so that WM_GETMINMAXINFO is fired.
    ' Can be called repeatedly to change MinWidth and/or MinHeight with no harm done.
    SubclassSomeWindow frm.hWnd, AddressOf MinSize_Proc, CLng(MinHeight * &H10000 + MinWidth)
End Sub

Private Function MinSize_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    If uMsg = WM_DESTROY Then
        UnSubclassSomeWindow hWnd, AddressOf_MinSize_Proc
        MinSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    If IdeStopButtonClicked Then ' Protect the IDE.  Don't execute any specific stuff if we're stopping.  We may run into COM objects or other variables that no longer exist.
        MinSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    '
    Dim MinWidth As Long
    Dim MinHeight As Long
    Dim MMI As MINMAXINFO
    Const WM_GETMINMAXINFO As Long = &H24&
    '
    Select Case uMsg
    Case WM_GETMINMAXINFO
        MinWidth = dwRefData And &HFFFF&
        MinHeight = (dwRefData And &H7FFF0000) \ &H10000
        '
        CopyMemory MMI, ByVal lParam, LenB(MMI)
        MMI.ptMinTrackSize.X = MinWidth
        MMI.ptMinTrackSize.Y = MinHeight
        CopyMemory ByVal lParam, MMI, LenB(MMI)
        Exit Function ' If we process the message, we must return 0 and not let more hook code execute.
    End Select
    '
    ' Give control to other hooks, if they exist.
    MinSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

Private Function AddressOf_MinSize_Proc() As Long
    AddressOf_MinSize_Proc = ProcedureAddress(AddressOf MinSize_Proc)
End Function




---

A test Form1 piece:

Code:

---


Option Explicit

Private Sub Form_Load()
    gbAllowSubclassing = True
    SubclassFormMinSize Me, 300, 300
End Sub



---

Also, it makes sense to me to put this all together into one subclassing procedure. I'll post that momentarily.

Enjoy,
Elroy

Here it is all put together, MinWidth, MinHeight, MaxWidth, MaxHeight, or any combination.

The BAS piece:

Code:

---


Option Explicit
'
Public gbAllowSubclassing As Boolean
'
Private Const WM_DESTROY As Long = &H2&
'
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function GetWindowSubclass Lib "comctl32.dll" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
Dim bSetWhenSubclassing_UsedByIdeStop As Boolean ' Never goes false once set by first subclassing, unless IDE Stop button is clicked.
'
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
'
'**************************************************************************************
' The following MODULE level stuff is specific to individual subclassing needs.
'**************************************************************************************
'
Private Type POINTAPI
    X              As Long
    Y              As Long
End Type
Private Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type
'

'**************************************************************************************
'**************************************************************************************
'**************************************************************************************
'
' Generic subclassing procedures (used in many of the specific subclassing).
'
'**************************************************************************************
'**************************************************************************************
'**************************************************************************************

Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToHook As Long, Optional dwRefData As Long)
    ' This just always uses hWnd for uIdSubclass, as we never have a need to subclass the same window to the same proc.
    ' The uniqueness is pfnSubclass and uIdSubclass (second and third argument below).
    '
    ' This can be called AFTER the initial subclassing to update dwRefData.
    '
    If Not gbAllowSubclassing Then Exit Sub
    '
    bSetWhenSubclassing_UsedByIdeStop = True
    Call SetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, dwRefData)
End Sub

Private Sub SubclassSomeWindowToDummy(hWnd As Long, ID As Long, dwRefData As Long)
    ' This is used solely to store extra data.  Be sure ID is different from hWnd.
    '
    If Not gbAllowSubclassing Then Exit Sub
    '
    bSetWhenSubclassing_UsedByIdeStop = True
    Call SetWindowSubclass(hWnd, AddressOf DummyProc, ID, dwRefData)
End Sub

Private Function GetSubclassRefData(hWnd As Long, AddressOf_ProcToHook As Long) As Long
    ' This one is used only to fetch the optional dwRefData you may have specified when calling SubclassSomeWindow.
    ' Typically this would only be used by the hooked procedure, but it is available to anyone.
    Call GetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, GetSubclassRefData)
End Function

Private Function GetSubclassRefDataDummy(hWnd As Long, ID As Long) As Long
    Call GetWindowSubclass(hWnd, AddressOf DummyProc, ID, GetSubclassRefDataDummy)
End Function

Private Function IsSubclassed(hWnd As Long, AddressOf_ProcToHook As Long) As Boolean
    ' This just tells us we're already subclassed.
    Dim dwRefData As Long
    IsSubclassed = GetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, dwRefData) = 1&
End Function

Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToHook As Long)
    ' Only needed if we specifically want to un-subclass before we're closing the form (or control),
    ' otherwise, it's automatically taken care of when the window closes.
    '
    ' Be careful, some subclassing may require additional cleanup that's not done here.
    Call RemoveWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd)
End Sub

Private Sub UnSubclassSomeWindowFromDummy(hWnd As Long, ID As Long)
    Call RemoveWindowSubclass(hWnd, AddressOf DummyProc, ID)
End Sub

Private Function ProcedureAddress(AddressOf_TheProc As Long)
    ' A private "helper" function for writing the AddressOf_... functions (see above notes).
    ProcedureAddress = AddressOf_TheProc
End Function

Private Function DummyProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    ' This could be used to just use comctl32.dll to store data for us in the dwRefData.
    '
    ' Give control to other hooks, if they exist.
    DummyProc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

Private Function IdeStopButtonClicked() As Boolean
    ' The following works because all variables are cleared when the STOP button is clicked,
    ' even though other code may still execute such as Windows calling some of the subclassing procedures below.
    IdeStopButtonClicked = Not bSetWhenSubclassing_UsedByIdeStop
End Function

'**************************************************************************************
'**************************************************************************************
'**************************************************************************************

Public Sub SubclassFormMinMaxSize(frm As VB.Form, Optional ByVal MinWidth As Long, Optional ByVal MinHeight As Long, Optional ByVal MaxWidth As Long, Optional ByVal MaxHeight As Long)
    ' MUST be done in Form_Load event so Windows doesn't resize form on small monitors.
    ' Also, move (such as center) the form after calling so that WM_GETMINMAXINFO is fired.
    ' Can be called repeatedly to change MinWidth, MinHeight, MaxWidth, and MaxHeight with no harm done.
    ' Although, all must be supplied that you wish to maintain.
    '
    ' Not supplying an argument (i.e., leaving it zero) will cause it to be ignored.
    '
    ' Some validation before subclassing.
    If MinWidth > MaxWidth And MaxWidth <> 0 Then MaxWidth = MinWidth
    If MinHeight > MaxHeight And MaxHeight <> 0 Then MaxHeight = MinHeight
    '
    SubclassSomeWindow frm.hWnd, AddressOf MinMaxSize_Proc, CLng(MinHeight * &H10000 + MinWidth)
    SubclassSomeWindowToDummy frm.hWnd, frm.hWnd + 1, CLng(MaxHeight * &H10000 + MaxWidth)
End Sub

Private Function MinMaxSize_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    If uMsg = WM_DESTROY Then
        UnSubclassSomeWindowFromDummy hWnd, hWnd + 1
        UnSubclassSomeWindow hWnd, AddressOf_MinMaxSize_Proc
        MinMaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    If IdeStopButtonClicked Then ' Protect the IDE.  Don't execute any specific stuff if we're stopping.  We may run into COM objects or other variables that no longer exist.
        MinMaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    '
    Dim MinWidth As Long
    Dim MinHeight As Long
    Dim MaxWidth As Long
    Dim MaxHeight As Long
    Dim MMI As MINMAXINFO
    Const WM_GETMINMAXINFO As Long = &H24&
    '
    Select Case uMsg
    Case WM_GETMINMAXINFO
        MinWidth = dwRefData And &HFFFF&
        MinHeight = (dwRefData And &H7FFF0000) \ &H10000
        dwRefData = GetSubclassRefDataDummy(hWnd, hWnd + 1)
        MaxWidth = dwRefData And &HFFFF&
        MaxHeight = (dwRefData And &H7FFF0000) \ &H10000
        '
        CopyMemory MMI, ByVal lParam, LenB(MMI)
        If MinWidth <> 0 Then MMI.ptMinTrackSize.X = MinWidth
        If MinHeight <> 0 Then MMI.ptMinTrackSize.Y = MinHeight
        If MaxWidth <> 0 Then MMI.ptMaxTrackSize.X = MaxWidth
        If MaxHeight <> 0 Then MMI.ptMaxTrackSize.Y = MaxHeight
        CopyMemory ByVal lParam, MMI, LenB(MMI)
        Exit Function ' If we process the message, we must return 0 and not let more hook code execute.
    End Select
    '
    ' Give control to other hooks, if they exist.
    MinMaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

Private Function AddressOf_MinMaxSize_Proc() As Long
    AddressOf_MinMaxSize_Proc = ProcedureAddress(AddressOf MinMaxSize_Proc)
End Function




---

A piece for Form1 testing:

Code:

---


Option Explicit

Private Sub Form_Load()
    gbAllowSubclassing = True
    SubclassFormMinMaxSize Me, 300, 300, 400, 0
End Sub



---

Enjoy,
Elroy