Option Explicit
Private Sub Command1_Click()
Me.WindowState = vbMinimized
End Sub
Private Sub Command2_Click()
Me.WindowState = Me.WindowState Xor vbMaximized
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_Load()
FormSizeHook Me.hWnd
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
UnFormSizeHook
End Sub
模块中代码如下:
程序代码:
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private 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
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_GETWORKAREA = 48
Public Const GWL_WNDPROC = (-4)
Public Const WM_GETMINMAXINFO = &H24
Private OldProc&, mhWnd&
'==================================================
'回调
Function FormSizeWinProc&(ByVal hWnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&)
Dim RectVal As RECT
Select Case wMsg&
Case WM_GETMINMAXINFO
Dim MinMax As MINMAXINFO
CopyMemory MinMax, ByVal lParam, Len(MinMax)
SystemParametersInfo SPI_GETWORKAREA, 0, RectVal, 0
MinMax.ptMaxTrackSize.Y = RectVal.Bottom
CopyMemory ByVal lParam, MinMax, Len(MinMax)
FormSizeWinProc& = 1
Exit Function
End Select
FormSizeWinProc& = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)
End Function
'==================================================
'==================================================
'挂钩
Sub FormSizeHook(ByVal nhWnd&)
If OldProc <> 0 Then Exit Sub
mhWnd& = nhWnd&
OldProc = SetWindowLong(nhWnd&, GWL_WNDPROC, AddressOf FormSizeWinProc)
End Sub
'==================================================
'==================================================
'脱钩
Sub UnFormSizeHook()
If OldProc = 0 Then Exit Sub
SetWindowLong mhWnd, GWL_WNDPROC, OldProc
OldProc = 0
End Sub
'==================================================