限制窗体Resize的最大值

VBScript code




Option Explicit


'以下程式在module1.bas
 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long) 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 Long


 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
 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 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 '设定{BANNED}最佳大Resize的宽度
     maxmin.ptMaxTrackSize.y = 400 '设定{BANNED}最佳大Resize的高度
     'maxmin.ptMinTrackSize.x = 300 '设定{BANNED}最佳大小Resize的宽度
     'maxmin.ptMinTrackSize.y = 300 '设定{BANNED}最佳大小Resize的高度
     CopyMemory ByVal lParam, maxmin, Len(maxmin)
 End If
 '将之送往原来的Window Procedure
 wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
 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