說明

當Form的Position更動或大小改變時，會Send WM_GETMINMAXINFO的訊息，當我們取得這個訊息時，可以更動該訊息內定Windows Resize的值，透過這個便可以設定Form Resize的最大最小範圍

程式

    方法一

'以下程式在module1.bas
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 Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg 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 Const GWL_WNDPROC = (-4)
Public Const WM_GETMINMAXINFO = &H24

Public Type POINTAPI
        x As Long
        y As Long
 End Type

Public Type MINMAXINFO
        ptReserved As POINTAPI
        ptMaxSize As POINTAPI
        ptMaxPosition As POINTAPI
        ptMinTrackSize As POINTAPI
        ptMaxTrackSize As POINTAPI
 End Type
 
Public preWinProc As Long

Public Function wndproc(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
If Msg = WM_GETMINMAXINFO Then
     Dim maxmin As MINMAXINFO
     CopyMemory maxmin, ByVal lParam, Len(maxmin)
     maxmin.ptMaxTrackSize.x = 500 '設定最大Resize的寬度
     maxmin.ptMaxTrackSize.y = 400 '設定最大Resize的高度
     maxmin.ptMinTrackSize.x = 300 '設定最大小Resize的寬度
     maxmin.ptMinTrackSize.y = 300 '設定最大小Resize的高度
     CopyMemory ByVal lParam, maxmin, Len(maxmin)
     wndproc = DefWindowProc(hWnd, uMsg, wParam, lParam)
Else
     '將之送往原來的Window Procedure
     wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End If
End Function
 

---

'以下在Form
Sub Form_Load()
 Dim ret As Long
 '記錄原本的Window Procedure的位址
 preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
 ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
 End Sub

 Private Sub Form_Unload(Cancel As Integer)
 Dim ret As Long
 '取消Message的截取，而使之又只送往原來的Window Procedure
 ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
 End Sub

    方法二

如果不是很在乎視窗外觀 可以考慮這個做法 :
(這樣也比較簡潔)

Private Sub Form_Resize()
Const constMinWidth = 3000, constMaxWidth = 5000 '自定視窗寬高上下限
Const constMinHeight = 2000, constMaxHeight = 6000
Const constEdge = 60
    On Error Resume Next
    If Me.Width < constMinWidth Then Me.Width = constMinWidth
    If Me.Width > constMaxWidth Then Me.Width = constMaxWidth
    If Me.Height < constMinHeight Then Me.Height = constMinHeight
    If Me.Height > constMaxHeight Then Me.Height = constMaxHeight
    '這個Shape控制項 用來展示效果
    Shape1.Shape = 4 'circle
    Shape1.Move constEdge, constEdge, _
        Me.ScaleWidth - 2 * constEdge, Me.ScaleHeight - 2 * constEdge
End Sub

相關資訊

  SetWindowLong

  GetWindowLong

  CallWindowProc

  MoveMemory

  MINMAXINFO

  Q185733 - HOWTO- Limit a Window's Minimum and Maximum Size

文件出處

  cww

  Honey修正方法一最小值部分

  C.K. Tsai

整理時間

  2002'1,26.

如果對本站有任何建議,歡迎來信給Honey,我們會盡快給您答覆