如何才能让窗口的大小保持在某个范围之间?

Question

如何才能让窗口的大小保持在某个范围之间?有源码吗?

Answer 1

'模块代码
Option Explicit
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
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" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Public Const GWL_winsize = (-4)
Public Const WM_GETMINMAXINFO = &H24
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
Public Prewinsize As LongPublic Function winsize(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim lwd As Long, hwd As Long
    Dim maxwin As MINMAXINFO
    If Msg = WM_GETMINMAXINFO Then
        CopyMemory maxwin, ByVal lParam, Len(maxwin)
        maxwin.ptMaxTrackSize.x = 400 '设定最大Resize的宽度
        maxwin.ptMaxTrackSize.y = 400 '设定最大Resize的高度
        maxwin.ptMinTrackSize.x = 500 '设定最小Resize的宽度
        maxwin.ptMinTrackSize.y = 500 '设定最小Resize的高度
        CopyMemory ByVal lParam, maxwin, Len(maxwin)
        winsize = 1
        Exit Function
    End If
    winsize = CallWindowProc(Prewinsize, hwnd, Msg, wParam, lParam)
 End Function
'窗体代码
Private Sub Command1_Click()
    Dim ret As Long
    '记录初始窗体状态
    Prewinsize = GetWindowLong(Me.hwnd, GWL_winsize)
    ret = SetWindowLong(Me.hwnd, GWL_winsize, AddressOf winsize)
End Sub

Answer 2

Private Sub Form_Resize()
    If Width > 5000 Then
        Width = 5000
      Else
        If Width < 4000 Then
            Width = 4000
        End If
    End If
End Sub

Answer 3

'=================在窗口中===============
Option ExplicitPrivate Sub Command1_Click()
    Form2.Show
End SubPrivate Sub Form_Load()
    'w = 200: h = 100
    OldWindowProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
    Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Call SetWindowLong(Me.hwnd, GWL_WNDPROC, OldWindowProc)
End Sub
'=================在模块中===============
Option ExplicitDeclare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
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 LongPublic Const GWL_WNDPROC = (-4)
Public Const WM_GETMINMAXINFO = &H24
Public OldWindowProc As LongType POINTAPI
     x As Long
     y As Long
End TypeType MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End TypePublic Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
    If Msg = WM_GETMINMAXINFO Then
        Dim MinMax As MINMAXINFO
        
        CopyMemory MinMax, ByVal lp, Len(MinMax)
        
        MinMax.ptMinTrackSize.x = 300
        MinMax.ptMinTrackSize.y = 200
        
        MinMax.ptMaxTrackSize.x = 640
        MinMax.ptMaxTrackSize.y = 480
        
        CopyMemory ByVal lp, MinMax, Len(MinMax)
        
        WndProc = 1
        Exit Function
    End If
    WndProc = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)
End Function

Answer 4

简单点的在form_load中定义好高度和宽度（这两个要全局变量）
然后在form_resize里
    on error goto err'错误陷阱，防止最小化时抱错
      form1.width=宽度
      form1.height=高度
err:
   if len(error)<>0 then exit sub