如何限制窗体的最大改变量

限制Form Resize的最大值

来源:cww

 

当Form的Position更动或大小改变时，会Send WM_GETMINMAXINFO的讯息，当我们取得这

个讯息时，可以更动该讯息内定Windows Resize的值，不过本人目前只有测出如何限定

其最大的Size，而最小的Size目前没有测出来，知道可者告诉我

 

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 '设定最大Resize的宽度

     maxmin.ptMaxTrackSize.y = 400 '设定最大Resize的高度

     'maxmin.ptMinTrackSize.x = 300 '设定最大小Resize的宽度

     'maxmin.ptMinTrackSize.y = 300 '设定最大小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