It can be done, but you need to use the API for this.
Try the following. In your form:
Private Const C_MIN_WIDTH = 600
Private Const C_MIN_HEIGHT = 400
Private Sub Form_Load()
Hook Me.hWnd, C_MIN_WIDTH, C_MIN_HEIGHT
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unhook Me.hWnd
End Sub
Then add Resize.bas to your project
'----------------
Option Explicit
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)
Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Const WU_LOGPIXELSX = 88
Const WU_LOGPIXELSY = 90
Public Const GWL_WNDPROC = -4
Private Windows As Collection
' Windows Messages
' Look them up in the API Text Viewer. All Windows Messages are Constants and starts with WM_
Public Const WM_GETMINMAXINFO = &H24
'
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 resizing.
' 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
Function ConvertTwipsToPixels(lngTwips As Long, lngDirection As Long) As Long
'Handle to device
Dim lngDC As Long
Dim lngPixelsPerInch As Long
Const nTwipsPerInch = 1440
lngDC = GetDC(0)
If (lngDirection = 0) Then 'Horizontal
lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)
Else 'Vertical
lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)
End If
lngDC = ReleaseDC(0, lngDC)
ConvertTwipsToPixels = (lngTwips / nTwipsPerInch) * lngPixelsPerInch
End Function
'----------------
Finally, we need a class (which I've called SubclassInfo to store some information about each form which has been subclassed.
'----------------
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
'----------------
That should do it
Chaz