Limit Size of Window
The following is reprinted for archival purposes from Gary Beene's Information Center, with permission from Mr. Beene himself.
Option Explicit
'A demo project showing how to prevent the user from making a window smaller
'or larger than you want them to, through subclassing the WM_GETMINMAXINFO message.
'by Bryan Stafford of New Vision Software?« - newvision@mvps.org
'this demo is released into the Public domain "As Is" without
'warranty Or guaranty of Any kind. In other words, use at
'your own risk.
' See the comments at the end of this Module for a brief explaination of
' what subclassing Is.
Type POINTAPI
X As Long
Y As Long
End Type
' the message we will subclass
Public Const WM_GETMINMAXINFO As Long = &H24&
Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
' this var will hold a pointer to the original message handler so we MUST
' save it so that it can be restored before we exit the app. If we don't
' restore it.... CRASH!!!!
Public g_nProcOld As Long
' declarations of the API functions used
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, _
ByVal cBytes&)
Public Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" ( ByVal lpPrevWndFunc&, _
ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
Public Const GWL_WNDPROC As Long = ( - 4&)
' API Call To alter the class data for a window
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( ByVal hwnd&, _
ByVal nIndex&, ByVal dwNewLong&) As Long
'=====================================================================================
Public Function WindowProc( ByVal hwnd As Long , ByVal iMsg As Long , _
ByVal wParam As Long , ByVal lParam As Long ) As Long
' this Is *our* implimentation 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&, nHeightPixels&
nWidthPixels = Screen.Width \ Screen.TwipsPerPixelX
nHeightPixels = Screen.Height \ Screen.TwipsPerPixelY
' copy the struct to our UDT variable
CopyMemory udtMINMAXINFO, ByVal lParam, Len(udtMINMAXINFO)
With udtMINMAXINFO
' Set the width of the form when it's maximized
.ptMaxSize.X = nWidthPixels '- (nWidthPixels \ 4)
' Set the height of the form when it's maximized
.ptMaxSize.Y = nHeightPixels '- (nHeightPixels \ 4)
' Set the left of the form when it's maximized
.ptMaxPosition.X = 0 'nWidthPixels \ 8
' Set the top of the form when it's maximized
.ptMaxPosition.Y = 0 'nHeightPixels \ 8
' Set the max width that the user can drag the form
.ptMaxTrackSize.X = .ptMaxSize.X
' Set the max height that the user can drag the form
.ptMaxTrackSize.Y = .ptMaxSize.Y
' Set the min Width that the user can drag the form
.ptMinTrackSize.X = 5550 \ Screen.TwipsPerPixelX 'nWidthPixels \ 4
' Set the min width that the user can drag the form
.ptMinTrackSize.Y = 4400 \ Screen.TwipsPerPixelY 'nHeightPixels \ 4
End With
' copy our modified struct back to the Windows struct
CopyMemory ByVal lParam, udtMINMAXINFO, Len(udtMINMAXINFO)
' Return zero indicating that we have acted on this message
WindowProc = 0&
' 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(g_nProcOld, hwnd, iMsg, wParam, lParam)
End Function
'==================================================
Private Sub Form_Unload(Cancel As Integer )
' give message processing control back To VB
' If you don't do this you WILL crash!!!
If UseSubClassing Then Call SetWindowLong(hwnd, GWL_WNDPROC, g_nProcOld)
End Sub
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.