Stop Form Resizing

Posted: 2002-06-01
By: ArchiveBot
Viewed: 67

Filed Under:

VB6 Code Cache

No attachments for this post

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

Comments on this post

No comments have been added for this post.

You must be logged in to make a comment.