目录

1. 效果演示

2. 功能介绍

3. 实现过程

4. 完整源码

5. 相关合集

1. 效果演示

2. 功能介绍

按住鼠标左键拖动边框，在最大和最小尺寸之间调整窗口大小。

3. 实现过程

之前发布过一篇这样的文章：让对话框窗口支持边框大小调整让对话框窗口支持边框大小调整让对话框窗口支持边框大小调整，用户可以使用鼠标左键任意调整窗口大小。

今天我们再对它进行一个功能拓展，让对话框窗口尺寸永远限制在设定好的最大和最小尺寸之间。这对于VBA列表视图Listview等控件非常友好，可以有效避免窗口尺寸过小导致数据显示不完整的情况发生。

• 灵感！

晚间在搜索Windows通知时，偶然发现了WM_GETMINMAXINFO通知，简介描述的非常有趣：

当窗口的大小或位置即将更改时，发送到窗口。 应用程序可以使用此消息来替代窗口的默认最大大小和位置，或者其默认的最小或最大跟踪大小。

这意味着，我们可以在窗口大小调整时进行手动限制。于是，你现在看的这篇文章诞生了。

• 如何使用WM_GETMINMAXINFO通知？

要知道子类化窗口过程一共有四个参数，分别是hwnd、Msg、wParam和lParam。窗口过程在每次接收到一个通知时，也会接收到这四个参数的信息。其中，wParam和lParam参数因通知而异，比如在接收到WM_GETMINMAXINFO通知时lParam参数包含了专属结构MINMAXINFO的全部信息，而wParam参数却没有用到。

3.1. 声明该通知的专属结构MINMAXINFO

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

3.2. 使用RtlMoveMemory函数从内存中复制出专属结构的信息

'获取专属结构信息 Dim mmmm As MINMAXINFO RtlMoveMemory mmmm, ByVal lParam, LenB(mmmm)

3.3. 修改结构中所需的成员值

这里修改了结构成员ptMinTrackSize（最小跟踪尺寸）和ptMaxTrackSize（最大跟踪尺寸）值，也就是在调整窗口大小时限制的最小尺寸和最大尺寸。

'指定窗口最小尺寸 mmmm.ptMinTrackSize.x = 200 mmmm.ptMinTrackSize.y = 150 '指定窗口最大尺寸 mmmm.ptMaxTrackSize.x = 320 mmmm.ptMaxTrackSize.y = 240

3.4. 调用RtlMoveMemory函数将修改后的结构信息复制回内存中

'更改内存中的结构信息 RtlMoveMemory ByVal lParam, mmmm, LenB(mmmm)

3.5. 添加返回值防止系统默认处理

'用户已处理 WindowProcfrmMain = Nuptr Exit Function

4. 完整源码

建议大家在了解实现原理之后，亲自动手编写代码实操，这样才能提升自身能力。

• 代码适配32与64位系统

• 代码不区分WPS或EXCEL VBA环境

你只需要复制代码到一个新模块中就能运行：

'晚间有雨伴人眠202608011619 '原创代码，转载或二创请标明来源 #If VBA7 And Win64 Then Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function CreateWindowExA Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal HwndParent As LongPtr, ByVal hMenu As LongPtr, ByVal Hinstance As LongPtr, lpParam As Any) As LongPtr Private Declare PtrSafe Function SetWindowLongA Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr Private Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As LongPtr) As LongPtr Private Declare PtrSafe Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hwnd As LongPtr) As Long Private Declare PtrSafe Function GetWindowLongA Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As LongPtr) #Else Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function CreateWindowExA Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal HwndParent As Long, ByVal hMenu As Long, ByVal Hinstance As Long, lpParam As Any) As Long Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function CallWindowProcA Lib "user32" (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 DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetWindowLongA Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long) #End If #If VBA7 And Win64 Then 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 #Else 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 #End If #If VBA7 And Win64 Then Private Const Nuptr As LongPtr = 0 Private Ud As UserDialogType Private Type UserDialogType Dialog As LongPtr DialogProc As LongPtr Editor As LongPtr EditorState As LongPtr End Type #Else Private Const Nuptr As Long = 0 Private Ud As UserDialogType Private Type UserDialogType Dialog As Long DialogProc As Long Editor As Long EditorState As Long End Type #End If Private Const SW_SHOW = 5 Private Const SW_HIDE = 0 Private Const WS_VISIBLE = &H10000000 Private Const WS_POPUP = &H80000000 Private Const WS_SYSMENU = &H80000 Private Const WS_CAPTION = &HC00000 Private Const WS_EX_DLGMODALFRAME = &H1 Private Const GWL_WNDPROC = -4 Private Const WM_CLOSE = &H10 Private Const WM_DESTROY = &H2 Private Const GWL_STYLE = -16 Private Const WS_THICKFRAME = &H40000 Private Const WM_GETMINMAXINFO = &H24 Public Sub CreateUserDialog() '对话框窗口若已存在则直接显示 If IsWindow(Ud.Dialog) Then ShowWindow Ud.Dialog, SW_SHOW: Exit Sub '获取编辑器句柄并隐藏 Ud.Editor = FindWindowA("wndclass_desked_gsk", vbNullString) Ud.EditorState = ShowWindow(Ud.Editor, SW_HIDE) '指定对话框初始样式 Dim StyleS&: StyleS = WS_VISIBLE Or WS_POPUP Or WS_SYSMENU Or WS_CAPTION Dim StyleE&: StyleE = WS_EX_DLGMODALFRAME '创建对话框主窗口 Ud.Dialog = CreateWindowExA(StyleE, "#32770", "UserDialog", StyleS, 15, 50, 300, 200, Nuptr, Nuptr, Nuptr, Nuptr) '添加窗口样式 SetWindowLongA Ud.Dialog, GWL_STYLE, GetWindowLongA(Ud.Dialog, GWL_STYLE) Or WS_THICKFRAME '设置对话框子类化 Ud.DialogProc = SetWindowLongA(Ud.Dialog, GWL_WNDPROC, AddressOf WindowProcUdDialog) '设置焦点 SetFocus Ud.Dialog End Sub #If VBA7 And Win64 Then Private Function WindowProcUdDialog(ByVal hwnd As LongPtr, ByVal msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr #Else Private Function WindowProcUdDialog(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long #End If Select Case msg '窗口即将关闭时 Case WM_CLOSE '销毁窗口 DestroyWindow Ud.Dialog '用户已处理 WindowProcUdDialog = Nuptr Exit Function '窗口销毁后 Case WM_DESTROY '取消子类化 SetWindowLongA Ud.Dialog, GWL_WNDPROC, Ud.DialogProc '还原编辑器的显示状态 If Ud.EditorState Then ShowWindow Ud.Editor, SW_SHOW '清理内存 Dim EmptyUd As UserDialogType: Ud = EmptyUd '用户已处理 WindowProcUdDialog = Nuptr Exit Function '限制窗口的最大/最小尺寸 Case WM_GETMINMAXINFO '获取专属结构信息 Dim mmmm As MINMAXINFO RtlMoveMemory mmmm, ByVal lParam, LenB(mmmm) '指定窗口最小尺寸 mmmm.ptMinTrackSize.x = 200 mmmm.ptMinTrackSize.y = 150 '指定窗口最大尺寸 mmmm.ptMaxTrackSize.x = 320 mmmm.ptMaxTrackSize.y = 240 '更改内存中的结构信息 RtlMoveMemory ByVal lParam, mmmm, LenB(mmmm) '用户已处理 WindowProcUdDialog = Nuptr Exit Function End Select '调用默认通知处理 WindowProcUdDialog = CallWindowProcA(Ud.DialogProc, hwnd, msg, wParam, lParam) End Function