This example prevents form being resized beyond a specified size, using subclassing
Add the following code to a form
Option Explicit
'// form_load event. Catch all those messages!
Private Sub Form_Load()
Dim lhSysMenu As Long, lRet As Long
On Error Resume Next
'// saves the previous window message handler. Always restore
this value
'// AddressOf command sends the address of the WindowProc
procedure
'// to windows
ProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf
WindowProc)
Show
End Sub
'// form_queryunload event. Return control to windows/vb
Private Sub Form_Unload(Cancel As Integer)
'// give message processing control back to VB
'// if you don'//t do this you WILL crash!!!
Call SetWindowLong(hWnd, GWL_WNDPROC, ProcOld)
End Sub
and then add the code below to a module...
Option Explicit
' windows api constants
' variable that stores the previous message handler
Public ProcOld As Long
' extra type declarations
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
' the message we will subclass
Public Const WM_GETMINMAXINFO As Long = &H24
Public Const GWL_WNDPROC = (-4)
' Windows API Call for catching messages
Public Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal
dwNewLong As Long) As Long
' Windows API call for calling window procedures
Public 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
Public Declare Sub CopyMemory Lib "kernel32" Alias
"RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As
Long)
' use this WindowProc procedure
Public Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
' ----WARNING----
' do not attempt to debug this procedure!!
' ----WARNING----
' this is our implementation of the message handling routine
' determine which message was recieved
Select Case iMsg
Case WM_GETMINMAXINFO
' dimention a variable to hold the
structure passed from Windows in lParam
Dim udtMINMAXINFO As MINMAXINFO
Dim nWidthPixels As Long,
nHeightPixels As Long
nWidthPixels = Screen.Width * Screen.TwipsPerPixelX
nHeightPixels = Screen.Height * Screen.TwipsPerPixelY
' copy the struct to our UDT variable
CopyMemory udtMINMAXINFO, ByVal
lParam, 40&
With udtMINMAXINFO
' set the
width of the form when it's maximized
.ptMaxSize.x
= 500
' set the
height of the form when it's maximized
.ptMaxSize.y
= 500
' Debug.Print
nWidthPixels
' set the
Left of the form when it's maximized
.ptMaxPosition.x = nWidthPixels * 8
' set the Top
of the form when it's maximized
.ptMaxPosition.y = nHeightPixels * 8
' set the max
width that the user can size the form
.ptMaxTrackSize.x = 500
' set the max
height that the user can size the form
.ptMaxTrackSize.y = 500
' set the min
width that the user can size the form
.ptMinTrackSize.x = 300
' set the min
height that the user can size the form
.ptMinTrackSize.y = 200
End With
' copy our modified struct back to
the Windows struct
CopyMemory ByVal lParam,
udtMINMAXINFO, 40&
' return zero indicating that we have
acted on this message
WindowProc = False
' exit the function without letting
VB get it's grubby little hands on the message
Exit Function
End Select
' pass all messages on to VB and then return the value to
windows
WindowProc = CallWindowProc(ProcOld, hWnd, iMsg, wParam,
lParam)
End Function
Comments