Keep form from resizing too small

[steve65]

I am trying to keep my form from being resized below 6000 x 7365. When the user goes below the size I want, the form temporarly get set to the smaller size and then gets reset with the code below. Is there any way to keep the form going smaller then what I want or at least keep the user from seeing the resizing.

Private Sub Form_Resize()

    frmMain.AutoRedraw = False
    Call LockWindowUpdate(frmMain.hWnd)
    
    If (frmMain.Width < 6000) Or (frmMain.Height < 7365) Then
        frmMain.Width = 6000
        frmMain.Height = 7365
        Call LockWindowUpdate(0)
        frmMain.AutoRedraw = True
        Exit Sub
    End If
    
    ' Resize rest of controls here...
    
    Call LockWindowUpdate(0)
    frmMain.AutoRedraw = True

End Sub

[Abu haider]

Subclass the form, Intercept the GETMINMAXINFO Message, give it the dimension you like, the form won't get smaller than that. You can safely remove the above code in that case. I think VBWorld itself has an example of this. If not, take a moment to search the API intensive sites.

Hope it helps.

[da_silvy]

You can disable resizing altogether if you want.

Matthew Gates would probably have a really good answer to this, so i suggest you PM him

[DiGiTaIErRoR]

Yeah, making the form static would probably be best.

[da_silvy]

This would probably be best:

I posted it as a new thread, because I couldn't find this one, but then when I found this thread again, I adjusted the code so that it is perfect for your needs

'In the form's code module
Option Explicit
Private Sub Form_Load()
    'Save handle to the form.
    gHW = Me.hwnd
    'Begin subclassing.
   Hook
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Stop subclassing.
Unhook
End Sub
 
'In a module
Option Explicit
 
      Private Const GWL_WNDPROC = -4
      Private Const WM_GETMINMAXINFO = &H24
 
      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
 
      Global lpPrevWndProc As Long
      Global gHW 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 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 SetWindowLong Lib "user32" Alias _
         "SetWindowLongA" (ByVal hwnd As Long, _
          ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
      Private Declare Sub CopyMemoryToMinMaxInfo Lib "KERNEL32" Alias _
         "RtlMoveMemory" (hpvDest As MINMAXINFO, ByVal hpvSource As Long, _
          ByVal cbCopy As Long)
      Private Declare Sub CopyMemoryFromMinMaxInfo Lib "KERNEL32" Alias _
         "RtlMoveMemory" (ByVal hpvDest As Long, hpvSource As MINMAXINFO, _
          ByVal cbCopy As Long)
 
      Public Sub Hook()
          'Start subclassing.
          lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
             AddressOf WindowProc)
      End Sub
 
      Public Sub Unhook()
          Dim temp As Long
 
          'Cease subclassing.
          temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
      End Sub
 
      Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
         ByVal wParam As Long, ByVal lParam As Long) As Long
          Dim MinMax As MINMAXINFO
 
          'Check for request for min/max window sizes.
          If uMsg = WM_GETMINMAXINFO Then
              'necesary for the caption of an MDI child (when maximized)
              '(Thanks to Marvin Chinchilla for this information)
              WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, _
        wParam, lParam)
              'Retrieve default MinMax settings
              CopyMemoryToMinMaxInfo MinMax, lParam, Len(MinMax)
 
              'Specify new minimum size for window.
              MinMax.ptMinTrackSize.x = (6000 / Screen.TwipsPerPixelX)
              MinMax.ptMinTrackSize.y = (7365 / Screen.TwipsPerPixelY)
 
              'Specify new maximum size for window.
              MinMax.ptMaxTrackSize.x = Screen.Width
              MinMax.ptMaxTrackSize.y = Screen.Height
 
              'Copy local structure back.
              CopyMemoryFromMinMaxInfo lParam, MinMax, Len(MinMax)
 
              WindowProc = DefWindowProc(hw, uMsg, wParam, lParam)
          Else
              WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, _
                 wParam, lParam)
          End If
      End Function

Tell me what you think

[Matthew Gates]

Perhaps this thread will help?

[Arc]

I would change your code to this so you dont have a resize to the width of the form just becasue someone went past the minimun size of the Hieght and vice versa.


If Form1.Width < 6000 Then Form1.Width = 6000
If Form1.Height < 7365 Then Form1.Height = 7365

[steve65]

Mathew,
I tried your suggestion from the other thread but one of the problems I had was the form did not seem to redraw right away during the form's mouse_move event. I think some of the problem with this is the mouse_move event for the other controls on my form were firing instead of the form's mouse_move event.

da_silvy,
I was able to subclass the form and keep it from resizing but when I did this I lost my status bar at the bottom of the form and a couple of my other controls did not look right.

Thanks for the help!

[da_silvy]

perhaps on the form resize event, reset the control sizes?

just a thought

[Steve Stunning]

da_silvy...


Thanks for that code.. Works great!!

[da_silvy]

No problems

been a while since i posted on the board and that snippet was from a while ago

[bnkrazy]

Just in case someone wants non api code...

Put this in the FORM_Resize event and change the form name and sizes of course...

If frmMDI.Width < 9000 Then
frmMDI.Enabled = False
frmMDI.Width = 9000
frmMDI.Enabled = True
ElseIf frmMDI.Height < 5300 Then
frmMDI.Enabled = False
frmMDI.Height = 5300
frmMDI.Enabled = True
End If

When you disable the form, it won't continue to slide smaller...

Chris

[da_silvy]

Although the api code is longer, it should work more effectively.

It will not allow them to resize below a predefined size.

Also, why did you revive a thread that was satisfactorily answered 6 months ago