Stop Form Resizing
Subclass you form to stop users from resizing below a certain limit! If you hate the generic two-liners "If Me.Height < 400 Then Me.Height = 400" then this code is for you! No more FLASHING!
Original Author: ignis
Assumptions
The lines
MinMax.ptMinTrackSize.X = 100
MinMax.ptMinTrackSize.Y = 100
are in ScaleMode pixel, NOT twip! So these numbers are not equal to Width/Height values! Play with these until you get them to fit correctly. They work for ALL resolutions!
Side Effects
Be careful when naming these procedures, as they may conflict with any other subclassing routines you have.
API Declarations
Option Explicit
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" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
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 Const GWL_WNDPROC = (-4)
Public Const WM_GETMINMAXINFO = &H24
Dim lpPrevWndProc As Long
Public MinWidth As Integer
Public Minheight As Integer
Code
Public Sub Hook(frm As Form)
' HOOK! Place the Call Hook(Me) code in your desired form
lpPrevWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' WINDOWPROC! Does the actual subclassing
If uMsg = WM_GETMINMAXINFO Then
Dim MinMax As MINMAXINFO
CopyMemory MinMax, ByVal lParam, Len(MinMax)
MinMax.ptMinTrackSize.X = 100 ' Set this to the min width in PIXELS (not twip!)
MinMax.ptMinTrackSize.Y = 100 ' Set this to the min height in PIXELS (not twip!)
CopyMemory ByVal lParam, MinMax, Len(MinMax)
Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End If
End Function
Public Sub Unhook(frm As Form)
' UNHOOK! Place the code Call Unhook(Me) in your form's Unload() event
SetWindowLong frm.hwnd, GWL_WNDPROC, lpPrevWndProc
End Sub
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.