Preventing
user resizing of a form is not easily accomplished without subclassing the form. Attempting to test the form's width and height properties in
the resize event will work, but only after the form has been resized, forcing the form to pop back to its restricted size.
Using a subclassed form, a VB app can trap the WM_GETMINMAXINFO
message Windows sends when sizing is initiated and throughout the resize
action. Trapping this message provides the opportunity to set the MINMAXINFO structure members to
our own pre-determined values enforce restrict form resizing.
This example is based on source gathered from Karl E. Peterson
and Domenico Statuto, Tom Hare's example, and postings to the vb newsgroups by vinh and Mike Riley. |
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public defWindowProc As Long
Public minX As Long
Public minY As Long
Public maxX As Long
Public maxY As Long
Public Const GWL_WNDPROC As Long = (-4)
Public Const WM_GETMINMAXINFO As Long = &H24
Public Type POINTAPI
x As Long
y As Long
End Type
Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
Public Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(hpvDest As Any, _
hpvSource As Any, _
ByVal cbCopy As Long)
Public Sub SubClass(hwnd As Long)
'assign our own window message
'procedure (WindowProc)
On Error Resume Next
defWindowProc = SetWindowLong(hwnd, _
GWL_WNDPROC, _
AddressOf WindowProc)
End Sub
Public Sub UnSubClass(hwnd As Long)
'restore the default message handling
'before exiting
If defWindowProc Then
SetWindowLong hwnd, GWL_WNDPROC, defWindowProc
defWindowProc = 0
End If
End Sub
Public Function WindowProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'window message procedure
On Error Resume Next
Select Case hwnd
'If the handle returned is to our form,
'perform form-specific message handling
'to deal with the notifications. If it
'is a general system message, pass it
'on to the default window procedure.
Case frmMain.hwnd
On Error Resume Next
'form-specific handler
Select Case uMsg
Case WM_GETMINMAXINFO
Dim MMI As MINMAXINFO
CopyMemory MMI, ByVal lParam, LenB(MMI)
'set the MINMAXINFO data to the
'minimum and maximum values set
'by the option choice
With MMI
.ptMinTrackSize.x = minX
.ptMinTrackSize.y = minY
.ptMaxTrackSize.x = maxX
.ptMaxTrackSize.y = maxY
End With
CopyMemory ByVal lParam, MMI, LenB(MMI)
'the MSDN tells us that if we process
'the message, to return 0
WindowProc = 0
Case Else
'this takes care of all the other messages
'coming to the form and not specifically
'handled above.
WindowProc = CallWindowProc(defWindowProc, _
hwnd, _
uMsg, _
wParam, _
lParam)
End Select
End Select
End Function |