API实现限制From的大小
Option ExplicitPublic 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 Long
Public 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 = 14820 '设定最大Resize的宽度
maxwin.ptMaxTrackSize.y = 8325 '设定最大Resize的高度
CopyMemory ByVal lParam, maxwin, Len(maxwin)
End If
winsize = CallWindowProc(Prewinsize, hwnd, Msg, wParam, lParam)
End Function
Private Sub Command1_Click()
Dim ret As Long
'为何将Resize的宽度设置为14820和8325就不可以实现?
Prewinsize = GetWindowLong(Me.hwnd, GWL_winsize)
ret = SetWindowLong(Me.hwnd, GWL_winsize, AddressOf winsize)
End Sub