Forcing a form to have a minimum size... 1

[elziko]

I don't want the user to be able to change the size of a form BELOW a predetermined size. At the moment I'm getting the height and width of the window during the Resize event and if its below a certain value I set the width and height TO that value.

It works but there must be a more sensible way?? API perhaps?

Any ideas?

Cheers,

elziko

 

[scorpio66]

Yes, you can use the API. In the form that you want to control the size of, declare the following constants:

' Size is in pixels
Private Const C_MIN_WIDTH = 865
Private Const C_MIN_HEIGHT = 600

In Form_Load add the following

Hook Me.hWnd, C_MIN_WIDTH, C_MIN_HEIGHT

and in Form_QueryUnload add

UnHook Me.hWnd

Create a new class called SubClassInfo and add the following code:

Option Explicit

Private Type SubClassInfo
    hWnd As Long
    minWidth As Integer
    minHeight As Integer
    lpPrevWndProc As Long
End Type

Private SubClassInfo As SubClassInfo

Private Sub Class_Initialize()
    hWnd = 0
    minWidth = 0
    minHeight = 0
    lpPrevWndProc = 0
End Sub

Public Property Get hWnd() As Long
    hWnd = SubClassInfo.hWnd
End Property

Public Property Let hWnd(ByVal hWnd As Long)
    SubClassInfo.hWnd = hWnd
End Property

Public Property Get minWidth() As Integer
    minWidth = SubClassInfo.minWidth
End Property

Public Property Let minWidth(minWidth As Integer)
    SubClassInfo.minWidth = minWidth
End Property

Public Property Get minHeight() As Integer
    minHeight = SubClassInfo.minHeight
End Property

Public Property Let minHeight(minHeight As Integer)
    SubClassInfo.minHeight = minHeight
End Property

Public Property Get lpPrevWndProc() As Long
    lpPrevWndProc = SubClassInfo.lpPrevWndProc
End Property

Public Property Let lpPrevWndProc(lpPrevWndProc As Long)
    SubClassInfo.lpPrevWndProc = lpPrevWndProc
End Property

Now in a module add the following:

Public Type POINTAPI
        X As Long
        Y As Long
End Type

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

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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)


Const WM_GETMINMAXINFO = &H24
Public Const GWL_WNDPROC = -4

Private Windows As Collection

Public Sub Hook(hWnd As Long, minWidth As Integer, minHeight As Integer)
    Dim SubClass As SubClassInfo
    
    If Windows Is Nothing Then Set Windows = New Collection
    
    On Error Resume Next
    Set SubClass = Windows("sc" & hWnd)
    If Err Then
        Err.Clear
        Set SubClass = New SubClassInfo
       
        With SubClass
            .hWnd = hWnd
            .minWidth = minWidth
            .minHeight = minHeight
            .lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
        End With
        
        Windows.Add SubClass, "sc" & hWnd
    End If
 End Sub

Public Sub Unhook(hWnd)
    Dim temp As Long
    Dim SubClass As SubClassInfo
    
    On Error Resume Next
    Set SubClass = Windows("sc" & hWnd)
    If Err = 0 Then
        temp = SetWindowLong(hWnd, GWL_WNDPROC, SubClass.lpPrevWndProc)
        Windows.Remove "sc" & hWnd
    Else
        Err.Clear
    End If
End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim minWidth As Integer
    Dim minHeight As Integer
    Dim SubClass As SubClassInfo
    
    On Error Resume Next
    Set SubClass = Windows("sc" & hw)
    If Err = 0 Then
        minWidth = SubClass.minWidth
        minHeight = SubClass.minHeight
    
        Select Case uMsg
        Case WM_GETMINMAXINFO
            Dim mmiT As MINMAXINFO
    
            ' Copy the parameter lParam to a local variable so that we can play around with it
            CopyMemory mmiT, ByVal lParam, Len(mmiT)
            
            ' Minimium width and height. The API works with pixels instead of twips :-(.
            mmiT.ptMinTrackSize.X = minWidth
            mmiT.ptMinTrackSize.Y = minHeight
            
            ' Copy modified results back to parameter
            CopyMemory ByVal lParam, mmiT, Len(mmiT)
            
            ' In this case we don't want VB to handle resizeing.
            ' We will exit the function without sending the message to VB, forcing the API to deal with it.
            
            Exit Function
       
       End Select
        
        WindowProc = CallWindowProc(SubClass.lpPrevWndProc, hw, uMsg, wParam, lParam)
    Else
        Err.Clear
        
        ' Don't know what to do here - I'm assuming that it is impossible for this
        ' situation to occur (a custom WindowProc running for an unsubclassed window).
    End If
End Function

You can do this in multiple forms in your project. Hope this is useful.

Chaz

 

[elziko]

Thanks for the code. I'm having trouble using it though.

In the module, function:
Public Sub Hook(hWnd As Long, minWidth As Integer, minHeight As Integer)

we have:

Dim SubClass As SubClassInfo and
Set SubClass = New SubClassInfo

..this is creating an instance of the class. So I assume the class should be called SubClassInfo?

But then in the class we have a type definition of the same name:

Private Type SubClassInfo
hWnd As Long
minWidth As Integer
minHeight As Integer
lpPrevWndProc As Long
End Type

I'm now very confused as to whats happening!! Either way, when I use your code exactly as listed i get the error:
User-defined type not defined and the following line in the module is highlighted:
Dim SubClass As SubClassInfo

Can you explain it to me a little more?

Many thanks,

elziko

 

[elziko]

Oh, I've actually got it working now!

Only thing is reagrdless of what width I set the window to be, it is always over 5000 pixels from the left of my screen. I therefore can't see it unless I make my form over 5000 pixels wide.

Then once I can see it I cannot adjust its size. I only want to limit the lower extent of its width and height, not the upper extent.

Can your method be used to do this?

Many thanks,

elziko

 

[scorpio66]

Its perfectly fine to have a Type in a Class with the same name. I use this as a way of encapsulating all of the variables which are used to store the values of Properties.

You're correct - the class should be called SubClassInfo.

I'm surprised that it doesn't work - is the class MultiUse? If it is Public-Not Creatable then this won't work.

I tested the code in a clean project, cutting and pasting into the various files. I'll go over this again, please bear with me ...

OK, start VB
Go to the Code Window of Form1
Option Explicit
Cut and Paste the constants into the file
Add the Form_Load code
Add the Form_QueryUnload code
Add a Class Module
Change the name to SubClassInfo
Paste in code
Add a module
Paste in code
Run

OK, it works fine for me here.

Would you go through the following steps? Also, what version of VB are you using? I'm assuming that its VB6

Chaz

 

[elziko]

Sorry, it looks like our posts crossed!

"Oh, I've actually got it working now!

Only thing is reagrdless of what width I set the window to be, it is always over 5000 pixels from the left of my screen. I therefore can't see it unless I make my form over 5000 pixels wide.

Then once I can see it I cannot adjust its size. I only want to limit the lower extent of its width and height, not the upper extent.

Can your method be used to do this?"


Thanks again,

elziko

 

[scorpio66]

Sorry elziko, I'm not sure that I understand your last post - could you rephrase it, please. I've just had lunch, which may explain my failings...

Thanks

 

[elziko]

Sorry. What I mean is the form does not appear on the screen.

Then if I set:

C_MIN_WIDTH = 5000

then I can just see the right hand edge of the form. So I assume that to start with its on screen but too far left. Is this possible?

Then I dont seem to be able to resize the form. My aim is to stop the form from being resized too small but let it be resized to as big as it wants.

Does that manke any more sense!?!?

'hope u enjoyed your lunch :-9

 

[scorpio66]

The width is in Pixels (use the source, luke) so set the width to be something more reasonable, maybe 400 or so

Chaz

 

[elziko]

I'm sure I tried a more reasonable amount but that just meant I couldn't see the form at all!

Anyway, tried it again and now it works fine.

Thanks for your help,

elziko

 

[elziko]

I've been using this code for a while now, thanks. However, I have noticed I slight quirk!

If I minimise my application by clicking on its entry on the task bar, it actually closes the application down.

I'm sure it is your code as if I remove the:

Hook Me.hWnd, C_MIN_WIDTH, C_MIN_HEIGHT from my Form.Unload event and the
Unhook Me.hWnd from the Form.QueryUnload event it stops doing this.

Any suggestions?

Thanks,

elziko

 

[scorpio66]

Do you have any code in your Form_Resize event? If so, check that it doesn't try to resize the controls with negative values for Width or Height, which it might do when the screen is minimised.

Chaz