个窗体,一个模块:
窗体上两个按钮,窗体的BorderStyle属性为0,窗体代码如下:
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Sub Command1_Click()
Me.WindowState = 2
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim hTaskBar As Long
hTaskBar = FindWindow("Shell_TrayWnd", vbNullString)
Debug.Print hTaskBar
Dim RC As RECT
Dim i As Long
i = GetWindowRect(hTaskBar, RC)
Dim taskheight As Long
taskheight = RC.Bottom - RC.Top '任务栏高度
i = GetWindowRect(GetDesktopWindow, RC)
Dim maxwidth As Long
Dim maxheight As Long
maxwidth = RC.Right - RC.Left '获取屏幕宽度
maxheight = RC.Bottom - RC.Top - taskheight '屏幕高度-任务栏高度
LockWindow Me.hwnd, , , maxwidth, maxheight
End Sub
模块代码:
Option Explicit
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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_GETMINMAXINFO = &H24
Public Const GWL_WNDPROC = -4
Global lpPrevWndProc As Long
Public procOld As Long
Public udtMMI As MINMAXINFO
Public Function WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_GETMINMAXINFO
Dim udtMINMAXINFO As MINMAXINFO
CopyMemory udtMINMAXINFO, ByVal lParam, 40&
With udtMINMAXINFO
.ptMaxSize.x = udtMMI.ptMaxSize.x
.ptMaxSize.y = udtMMI.ptMaxSize.y
.ptMaxPosition.x = 0
.ptMaxPosition.y = 0
.ptMaxTrackSize.x = .ptMaxSize.x
.ptMaxTrackSize.y = .ptMaxSize.y
.ptMinTrackSize.x = udtMMI.ptMinTrackSize.x
.ptMinTrackSize.y = udtMMI.ptMinTrackSize.y
Debug.Print .ptMaxSize.x & "," & .ptMaxSize.y
End With
CopyMemory ByVal lParam, udtMINMAXINFO, 40&
WindowProc = False
Exit Function
End Select
WindowProc = CallWindowProc(procOld, hwnd, iMsg, wParam, lParam)
End Function
Public Function LockWindow(hwnd As Long, Optional MinWidth As Long, Optional MinHeight As Long, Optional maxwidth As Long, Optional maxheight As Long) As Boolean
With udtMMI
'指定窗体最小宽度
If MinWidth = 0 Then .ptMinTrackSize.x = 0 Else .ptMinTrackSize.x = MinWidth
'指定窗体最小高度
If MinHeight = 0 Then .ptMinTrackSize.y = 0 Else .ptMinTrackSize.y = MinHeight
'指定窗体最大宽度
If maxwidth = 0 Then .ptMaxSize.x = Screen.Width / Screen.TwipsPerPixelX Else .ptMaxSize.x = maxwidth
'指定窗体最大高度
If maxheight = 0 Then .ptMaxSize.y = Screen.Width / Screen.TwipsPerPixelX Else .ptMaxSize.y = maxheight
End With
procOld = SetWindowLong(hwnd, -4, AddressOf WindowProc)
End Function