[VB] 限制窗口大小

'/////////////
'* In a form *
'/////////////

Option Explicit

Private Sub Form_Load()
    Call Hook( Me.hWnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call Unhook( Me.hWnd)
End Sub

'////////////////////////
'* In a standard module *
'////////////////////////

Option Explicit

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( ByVal hWnd As Long, _
                                                                            ByVal nIndex As Long, _
                                                                            ByVal dwNewLong As Long) _
                                                                            As Long
Private 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
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" ( ByVal hWnd As Long, _
                                                                            ByVal wMsg As Long, _
                                                                            ByVal wParam As Long, _
                                                                            ByVal lParam As Long) _
                                                                            As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
                                                                     Source As Any, _
                                                                     ByVal Length As Long)
Private Const GWL_WNDPROC = (-4)

Private Const WM_SIZING = &H214

Private Const WMSZ_LEFT = 1
Private Const WMSZ_RIGHT = 2
Private Const WMSZ_TOP = 3
Private Const WMSZ_TOPLEFT = 4
Private Const WMSZ_TOPRIGHT = 5
Private Const WMSZ_BOTTOM = 6
Private Const WMSZ_BOTTOMLEFT = 7
Private Const WMSZ_BOTTOMRIGHT = 8

Private Const MIN_WIDTH = 200  'The minimum width in pixels
Private Const MIN_HEIGHT = 200 'The minimum height in pixels
Private Const MAX_WIDTH = 500  'The maximum width in pixels
Private Const MAX_HEIGHT = 500 'The maximum height in pixels

Private Type RECT
    Left   As Long
    Top    As Long
    RIGHT  As Long
    Bottom As Long
End Type

Private mPrevProc As Long

Public Sub Hook(hWnd As Long)
    mPrevProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf NewWndProc)
End Sub

Public Sub Unhook(hWnd As Long)
   
    Call SetWindowLong(hWnd, GWL_WNDPROC, mPrevProc)
    mPrevProc = 0&
   
End Sub

Public Function NewWndProc( ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next

Dim r As RECT

    If uMsg = WM_SIZING Then
        Call CopyMemory(r, ByVal lParam, Len(r))
   
        'Keep the form only at least as wide as MIN_WIDTH
        If (r.RIGHT - r.Left < MIN_WIDTH) Then
            Select Case wParam
                Case WMSZ_LEFT, WMSZ_BOTTOMLEFT, WMSZ_TOPLEFT
                    r.Left = r.RIGHT - MIN_WIDTH
                Case WMSZ_RIGHT, WMSZ_BOTTOMRIGHT, WMSZ_TOPRIGHT
                    r.RIGHT = r.Left + MIN_WIDTH
            End Select
        End If
       
        'Keep the form only at least as tall as MIN_HEIGHT
        If (r.Bottom - r.Top < MIN_HEIGHT) Then
            Select Case wParam
                Case WMSZ_TOP, WMSZ_TOPLEFT, WMSZ_TOPRIGHT
                    r.Top = r.Bottom - MIN_HEIGHT
                Case WMSZ_BOTTOM, WMSZ_BOTTOMLEFT, WMSZ_BOTTOMRIGHT
                    r.Bottom = r.Top + MIN_HEIGHT
            End Select
        End If
       
        'Keep the form only as wide as MAX_WIDTH
        If (r.RIGHT - r.Left > MAX_WIDTH) Then
            Select Case wParam
                Case WMSZ_LEFT, WMSZ_BOTTOMLEFT, WMSZ_TOPLEFT
                    r.Left = r.RIGHT - MAX_WIDTH
                Case WMSZ_RIGHT, WMSZ_BOTTOMRIGHT, WMSZ_TOPRIGHT
                    r.RIGHT = r.Left + MAX_WIDTH
            End Select
        End If
       
        'Keep the form only as tall as MAX_HEIGHT
        If (r.Bottom - r.Top > MAX_HEIGHT) Then
            Select Case wParam
                Case WMSZ_TOP, WMSZ_TOPLEFT, WMSZ_TOPRIGHT
                    r.Top = r.Bottom - MAX_HEIGHT
                Case WMSZ_BOTTOM, WMSZ_BOTTOMLEFT, WMSZ_BOTTOMRIGHT
                    r.Bottom = r.Top + MAX_HEIGHT
            End Select
        End If
   
        Call CopyMemory( ByVal lParam, r, Len(r))
       
        NewWndProc = 0&
        Exit Function
    End If
   

    If mPrevProc > 0& Then
        NewWndProc = CallWindowProc(mPrevProc, hWnd, uMsg, wParam, lParam)
    Else
        NewWndProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
    End If

End Function