|
|
![]() |
|
||
|
|
|||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||
| Visual Basic Subclassing Routines WM_GETMINMAXINFO: Restrict Form Resizing |
||
| Posted: | Wednesday July 1, 1998 | |
| Updated: | Monday December 26, 2011 | |
| Applies to: | VB5, VB6 | |
| Developed with: | VB6, Windows 98 | |
| OS restrictions: | None | |
| Author: | VBnet - Randy Birch | |
|
Related: |
WM_SIZING: Maintain Form Aspect Ratio During Resizing | |
| Prerequisites |
| VB5 or VB6. |
|
|
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. |
| BAS Module Code |
|
|
| Place the following code into the general declarations area of a bas module: |
|
|
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 |
| Form Code |
|
|
| To a form, add three option buttons in a control array (option1(0) - Option1(2)) and a command button (Command1). Name the form 'frmMain', and add the following code: |
|
|
Option Explicit
Private StartupHeight As Long
Private StartupWidth As Long
Private TwipsX As Integer
Private TwipsY As Integer
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
'saves re-referencing the Screen
'properties in the option button event
TwipsX = Screen.TwipsPerPixelX
TwipsY = Screen.TwipsPerPixelY
StartupWidth = Me.Width \ TwipsX
StartupHeight = Me.Height \ TwipsY
Option1(0).Value = True
Set Me.Icon = Nothing
Call SubClass(frmMain.hwnd)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call UnSubClass(Me.hwnd)
End Sub
Private Sub Option1_Click(Index As Integer)
Select Case Index
Case 0 'Never Larger than Startup Size
minX = 0
minY = 0
maxX = StartupWidth
maxY = StartupHeight
Case 1 'Never Smaller than Startup Size
minX = StartupWidth
minY = StartupHeight
maxX = Screen.Width \ TwipsX
maxY = Screen.Height \ TwipsY
Case 2 'Stop All Resizing
minX = Me.Width \ TwipsX
minY = Me.Height \ TwipsY
maxX = Me.Width \ TwipsX
maxY = Me.Height \ TwipsY
End Select
End Sub |
| Comments |
| Save then run the project using Start with Full Compile. This is also recommended when changing the controls or code on the form as once the form becomes subclassed, you can not edit the code should an error occur. Once running, try to change the form size. It will be limited by the option selected. |
|
|
|
|
|
|||||
|
|||||
|
|
|||||
|
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |
![]() |