aniston
asked on
A way to CAPTURE/CHANGE 'Maximize' Event?
I have a MAXIMIZE button in my title bar which when clicked should MAXIMIZE the form window. However, if i want it to ONLY maximize up to a certain X,Y limit. Is there a way to override this windows automatic feature of maximizing and do what i want?
Other Experts here came up with a kind of similar problem i had in restricting the resizing of my form window to only along the y axis. The code is mentioned below. Can any of you add new code to this code that wil give me the ability of restricting my Maximize to a set x,y limit?
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CXFRAME = 32
Public Const SM_CYFRAME = 33
Public Const SM_CXBORDER = 5
Public Const SM_CYBORDER = 6
Public Const SM_CYCAPTION = 4
'Window messages
Public Const WM_SETCURSOR = &H20
Public Const WM_WINDOWPOSCHANGING = &H46
Public Const IDC_ARROW = 32512&
Public Const IDC_SIZENS = 32645&
'Send message
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetCursor Lib "user32" () As Long
Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Any, ByVal cbCopy As Long)
Declare Sub CopyMemoryBack Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal lpvDest As Any, ByRef lpvSource As Any, ByVal cbCopy As Long)
Type POINTAPI
x As Long
y As Long
End Type
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type WINDOWPOS
hWnd As Long
hWndInsertAfter As Long
x As Long
y As Long
cx As Long
cy As Long
flags As Long
End Type
'Hooks
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
'SetWindowLong hook message
Public Const GWL_WNDPROC = -4
'Persistent hook variables
Private lpPrevWndProc As Long
Private gHW As Long
Private hCursorNS As Long
Private hCursorArrow As Long
Private xOffset As Integer
Private yOffset As Integer
Private heightOffset As Integer
'Subclass the window
Public Sub Hook(hWnd As Long)
Dim dwRet As Long
xOffset = GetSystemMetrics(SM_CXFRAM E)
xOffset = xOffset + GetSystemMetrics(SM_CXBORD ER)
yOffset = GetSystemMetrics(SM_CYFRAM E)
yOffset = yOffset + GetSystemMetrics(SM_CYBORD ER)
heightOffset = yOffset + GetSystemMetrics(SM_CYCAPT ION)
gHW = hWnd
hCursorArrow = LoadCursor(0, IDC_ARROW)
hCursorNS = LoadCursor(0, IDC_SIZENS)
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub
'Restrore default message processing
Public Sub Unhook()
Dim temp As Long
temp = SetWindowLong(gHW, GWL_WNDPROC, _
lpPrevWndProc)
End Sub
'Hook procedure
Function WindowProc(ByVal hw As Long, ByVal uMsg As _
Long, ByVal wParam As Long, ByVal lParam As Long) As _
Long
Select Case uMsg
Case WM_SETCURSOR
Dim rct As RECT
Dim pt As POINTAPI
GetCursorPos pt
GetWindowRect hw, rct
If (pt.x < rct.Left + xOffset) Or pt.x > rct.Right - xOffset Then
Exit Function
Else
If ((pt.x < rct.Left + heightOffset) And (pt.y > rct.Bottom - yOffset)) Or _
((pt.x > rct.Right - heightOffset) And (pt.y > rct.Bottom - yOffset)) Or _
((pt.x < rct.Left + heightOffset) And (pt.y < rct.Top + yOffset)) Or _
((pt.x > rct.Right - heightOffset) And (pt.y < rct.Top + yOffset)) Then
SetCursor hCursorNS
Else
WindowProc = CallWindowProc(lpPrevWndPr oc, hw, _
uMsg, wParam, lParam)
End If
End If
Case WM_WINDOWPOSCHANGING
Dim wp As WINDOWPOS
Dim rct2 As RECT
GetWindowRect hw, rct2
CopyMemory wp, lParam, Len(wp)
wp.cx = rct2.Right - rct2.Left
If GetCursor <> hCursorArrow Then
wp.x = rct2.Left
Else
wp.cy = rct2.Bottom - rct2.Top
GetCursorPos pt
If pt.y > rct2.Top + heightOffset Then
wp.x = rct2.Left
End If
End If
CopyMemoryBack lParam, wp, Len(wp)
WindowProc = 0
Exit Function
Case Else
WindowProc = CallWindowProc(lpPrevWndPr oc, hw, _
uMsg, wParam, lParam)
End Select
End Function
Other Experts here came up with a kind of similar problem i had in restricting the resizing of my form window to only along the y axis. The code is mentioned below. Can any of you add new code to this code that wil give me the ability of restricting my Maximize to a set x,y limit?
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CXFRAME = 32
Public Const SM_CYFRAME = 33
Public Const SM_CXBORDER = 5
Public Const SM_CYBORDER = 6
Public Const SM_CYCAPTION = 4
'Window messages
Public Const WM_SETCURSOR = &H20
Public Const WM_WINDOWPOSCHANGING = &H46
Public Const IDC_ARROW = 32512&
Public Const IDC_SIZENS = 32645&
'Send message
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetCursor Lib "user32" () As Long
Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Any, ByVal cbCopy As Long)
Declare Sub CopyMemoryBack Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal lpvDest As Any, ByRef lpvSource As Any, ByVal cbCopy As Long)
Type POINTAPI
x As Long
y As Long
End Type
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type WINDOWPOS
hWnd As Long
hWndInsertAfter As Long
x As Long
y As Long
cx As Long
cy As Long
flags As Long
End Type
'Hooks
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
'SetWindowLong hook message
Public Const GWL_WNDPROC = -4
'Persistent hook variables
Private lpPrevWndProc As Long
Private gHW As Long
Private hCursorNS As Long
Private hCursorArrow As Long
Private xOffset As Integer
Private yOffset As Integer
Private heightOffset As Integer
'Subclass the window
Public Sub Hook(hWnd As Long)
Dim dwRet As Long
xOffset = GetSystemMetrics(SM_CXFRAM
xOffset = xOffset + GetSystemMetrics(SM_CXBORD
yOffset = GetSystemMetrics(SM_CYFRAM
yOffset = yOffset + GetSystemMetrics(SM_CYBORD
heightOffset = yOffset + GetSystemMetrics(SM_CYCAPT
gHW = hWnd
hCursorArrow = LoadCursor(0, IDC_ARROW)
hCursorNS = LoadCursor(0, IDC_SIZENS)
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub
'Restrore default message processing
Public Sub Unhook()
Dim temp As Long
temp = SetWindowLong(gHW, GWL_WNDPROC, _
lpPrevWndProc)
End Sub
'Hook procedure
Function WindowProc(ByVal hw As Long, ByVal uMsg As _
Long, ByVal wParam As Long, ByVal lParam As Long) As _
Long
Select Case uMsg
Case WM_SETCURSOR
Dim rct As RECT
Dim pt As POINTAPI
GetCursorPos pt
GetWindowRect hw, rct
If (pt.x < rct.Left + xOffset) Or pt.x > rct.Right - xOffset Then
Exit Function
Else
If ((pt.x < rct.Left + heightOffset) And (pt.y > rct.Bottom - yOffset)) Or _
((pt.x > rct.Right - heightOffset) And (pt.y > rct.Bottom - yOffset)) Or _
((pt.x < rct.Left + heightOffset) And (pt.y < rct.Top + yOffset)) Or _
((pt.x > rct.Right - heightOffset) And (pt.y < rct.Top + yOffset)) Then
SetCursor hCursorNS
Else
WindowProc = CallWindowProc(lpPrevWndPr
uMsg, wParam, lParam)
End If
End If
Case WM_WINDOWPOSCHANGING
Dim wp As WINDOWPOS
Dim rct2 As RECT
GetWindowRect hw, rct2
CopyMemory wp, lParam, Len(wp)
wp.cx = rct2.Right - rct2.Left
If GetCursor <> hCursorArrow Then
wp.x = rct2.Left
Else
wp.cy = rct2.Bottom - rct2.Top
GetCursorPos pt
If pt.y > rct2.Top + heightOffset Then
wp.x = rct2.Left
End If
End If
CopyMemoryBack lParam, wp, Len(wp)
WindowProc = 0
Exit Function
Case Else
WindowProc = CallWindowProc(lpPrevWndPr
uMsg, wParam, lParam)
End Select
End Function
ASKER
Actually agrillage,
WHen you perform your suggestion inside the Resize event using the special keywords "Height" and "Width" windows auto pops up an errors saying "CANNOT RESIZE or MOVE a Form while being Minimized or Maximized". Try this out and you will see what happens!!
WHen you perform your suggestion inside the Resize event using the special keywords "Height" and "Width" windows auto pops up an errors saying "CANNOT RESIZE or MOVE a Form while being Minimized or Maximized". Try this out and you will see what happens!!
Sorry, I should have checked but it sounded straight forward.
ASKER
no problem...
I believe the 2nd message i just posted has answered my question.
Thanks for all your help agrilage!
I believe the 2nd message i just posted has answered my question.
Thanks for all your help agrilage!
Aniston,
Agrillage's proposed answer isn't as bad as it seems! There is only one thing missing, before you set the Height and Width properties to the required values, you must set the form's windowstate back to a normal state.
The result is a bit flickery, but it's easy and that's worth something?
For example, the code below will not allow the height and the width of the form to exceed 5000. If the form is maximised, it will resize to 5000 x 5000. It also ensures the form remains centred around its original centre unless this would cause the form to be cropped at top or left.
Private Sub Form_Resize()
Dim intHeightDiff As Integer
Dim intWidthDiff As Integer
If Me.WindowState = vbMaximized Then
Me.WindowState = vbNormal
intHeightDiff = Me.Height - 5000
intWidthDiff = Me.Width - 5000
Me.Height = 5000
Me.Width = 5000
Top = Top + (intHeightDiff / 2)
If Top < 0 Then
Top = 0
End If
Left = Left + (intWidthDiff / 2)
If Left < 0 Then
Left = 0
End If
Exit Sub
End If
If Me.Width > 5000 Then
Me.Width = 5000
Exit Sub
End If
If Me.Height > 5000 Then
Me.Height = 5000
Exit Sub
End If
End Sub
If the above works to your satisfaction, ask Agrillage to add a token answer so you can give him or her some points.
Agrillage's proposed answer isn't as bad as it seems! There is only one thing missing, before you set the Height and Width properties to the required values, you must set the form's windowstate back to a normal state.
The result is a bit flickery, but it's easy and that's worth something?
For example, the code below will not allow the height and the width of the form to exceed 5000. If the form is maximised, it will resize to 5000 x 5000. It also ensures the form remains centred around its original centre unless this would cause the form to be cropped at top or left.
Private Sub Form_Resize()
Dim intHeightDiff As Integer
Dim intWidthDiff As Integer
If Me.WindowState = vbMaximized Then
Me.WindowState = vbNormal
intHeightDiff = Me.Height - 5000
intWidthDiff = Me.Width - 5000
Me.Height = 5000
Me.Width = 5000
Top = Top + (intHeightDiff / 2)
If Top < 0 Then
Top = 0
End If
Left = Left + (intWidthDiff / 2)
If Left < 0 Then
Left = 0
End If
Exit Sub
End If
If Me.Width > 5000 Then
Me.Width = 5000
Exit Sub
End If
If Me.Height > 5000 Then
Me.Height = 5000
Exit Sub
End If
End Sub
If the above works to your satisfaction, ask Agrillage to add a token answer so you can give him or her some points.
ASKER
Thanks for the answer guys...I wish i can give you both points but Agrillage if you are out there you can "answer" and i will give you the points
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
if myForm.Width > myMax Then myForm.Width = myMax
and the same for the width.