让对话框窗口限制在最大和最小尺寸之间

目录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. 声明该通知的专属结构MINMAXINFOPrivate 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 Type3.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 2403.4. 调用RtlMoveMemory函数将修改后的结构信息复制回内存中更改内存中的结构信息 RtlMoveMemory ByVal lParam, mmmm, LenB(mmmm)3.5. 添加返回值防止系统默认处理用户已处理 WindowProcfrmMain Nuptr Exit Function4. 完整源码建议大家在了解实现原理之后亲自动手编写代码实操这样才能提升自身能力。• 代码适配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 Function5. 相关合集关于#32770对话框窗口的专项开发计划