Link to home
Start Free TrialLog in
Avatar of aniston
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_CXFRAME)
      xOffset = xOffset + GetSystemMetrics(SM_CXBORDER)
      yOffset = GetSystemMetrics(SM_CYFRAME)
      yOffset = yOffset + GetSystemMetrics(SM_CYBORDER)
      heightOffset = yOffset + GetSystemMetrics(SM_CYCAPTION)
         
          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(lpPrevWndProc, 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(lpPrevWndProc, hw, _
          uMsg, wParam, lParam)
          End Select
      End Function

Avatar of agrillage
agrillage

You certainly don't need to go to all this trouble for this one. When you maximize the form, a resize event will occur. Write something like this in the resize event

if myForm.Width > myMax Then myForm.Width = myMax

and the same for the width.
Avatar of aniston

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!!
Sorry, I should have checked but it sounded straight forward.
Avatar of aniston

ASKER

no problem...
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.
Avatar of aniston

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
Avatar of DPickering
DPickering

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial