让对话框窗口在鼠标单击时出现醒目标记 1. 效果演示晚间正在做一个完整的CSDN合集针对对话框#32770专门教学如何完善各项功能、如何优化使用体验等内容让大家在写自己的窗口项目时能够有所借鉴。2. 功能介绍鼠标左键按下时出现醒目标记松开时标记消失。3. 实现过程这个功能的本质是在对话框窗口上画圆和擦除操作方法是在鼠标左键按下时画一个圆又在左键松开时擦除圆。仅仅知道在什么时间干什么事还不够因为我们还不清楚怎么在对话框窗口上进行绘制操作。我们先来了解一个叫做hdc绘制环境的工具你可以把它理解为“画板”。其实窗口本身就像是一个画板只不过屏幕上的窗口很多画板也就很多。与画板配套的有很多画画工具比如画笔、画刷和橡皮擦等。在画板上画画也就是在hdc绘制环境中进行绘制绘制的顺序是先找到画板拿起需要的画画工具画画拿起原来的画画工具放回画板。接下来我们按照这个画画顺序来逐步讲解3.1 先找到画板我们使用GetDC函数获取对话框窗口的hdc绘制环境获取对话框绘制环境 Ud.DialogHdc GetDC(Ud.Dialog)3.2 拿起需要的画画工具画画工具需要用户先创建再拿起。我们先使用CreatePen函数创建一个1像素宽的实线画笔然后使用SelectObject函数在Ud.DialogHdc绘制环境中拿起这个画笔。接着我们再使用GetStockObject函数获取系统空画刷然后也在Ud.DialogHdc绘制环境中拿起这个画刷。创建并拿起画笔 Ud.Temp(0) CreatePen(PS_SOLID, 1, RGB(0, 0, 0)) Ud.Temp(1) SelectObject(Ud.DialogHdc, Ud.Temp(0)) 创建并拿起空画刷 Ud.Temp(2) GetStockObject(NULL_BRUSH) Ud.Temp(3) SelectObject(Ud.DialogHdc, Ud.Temp(2))“拿起”操作本身是分两步先放下现有的工具再拿起新的工具。在代码中这样理解SelectObject函数在拿起Ud.Temp(0)之前会先放下Ud.Temp(1)。3.3 画画确定鼠标左键单击位置的坐标我们在这里是拦截的WM_LBUTTONDOWN消息这个消息在发送时参数lParam带有坐标信息我们只需要将其提取出来就行从lParam低位获取鼠标x坐标 Ud.DiglogClick.x CLng(lParam) And HFFFF 从lParam高位获取鼠标y坐标 Ud.DiglogClick.y (CLng(lParam) And HFFFF0000) / H10000在鼠标左键按下的地方画一个黑色轮廓的圆我们来使用Ellipse函数进行画圆它的参数要求我们知道两个坐标一个是左上角坐标另一个是右下角坐标。用这两个坐标围成一个矩形以矩形中点为圆心的内切圆就是Ellipse函数画出的圆。绘制圆有边框、无背景 Ellipse Ud.DialogHdc, Ud.DiglogClick.x - 10, Ud.DiglogClick.y - 10, Ud.DiglogClick.x 10, Ud.DiglogClick.y 10在鼠标左键松开时擦除刚刚绘制的轮廓圆这里要用InvalidateRect函数指定一个即将要重绘的矩形区域。重绘擦除之前的醒目标记 Dim lprc As RECT lprc.Left Ud.DiglogClick.x - 10 lprc.Top Ud.DiglogClick.y - 10 lprc.Right Ud.DiglogClick.x 10 lprc.Bottom Ud.DiglogClick.y 10 InvalidateRect Ud.Dialog, lprc, True3.4 拿起原来的画画工具在画画结束之后由于不再需要使用这个1像素宽的实线画笔Ud.Temp(0)和空画刷Ud.Temp(2)了我们就要放下它们重新拿起之前的工具比如重新拿起之前的画笔Ud.Temp(1)以及重新拿起模前的画刷Ud.Temp(3)。以此让对话框窗口的绘制环境在用户绘制完之后始终保持原始模样。选中之前的画笔和画刷 SelectObject Ud.DialogHdc, Ud.Temp(1) SelectObject Ud.DialogHdc, Ud.Temp(3)此外我们还需要把不需要的画笔销毁掉释放内存。而使用GetStockObject函数获取的对象句柄不需要手动销毁。销毁临时画笔 DeleteObject Ud.Temp(0)3.5 放回画板在所有步骤都结束之后我们需要把当前在用的画板放回去也就是释放hdc绘制环境。释放绘制环境 ReleaseDC Ud.Dialog, Ud.DialogHdc4. 完整源码建议大家在了解实现原理之后亲自动手编写代码实操这样才能提升自身能力。代码适配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 GetDC Lib user32 (ByVal hwnd As LongPtr) As LongPtr Private Declare PtrSafe Function ReleaseDC Lib user32 (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long Private Declare PtrSafe Function CreatePen Lib gdi32 (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As LongPtr Private Declare PtrSafe Function GetStockObject Lib gdi32 (ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function SelectObject Lib gdi32 (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr Private Declare PtrSafe Function Ellipse Lib gdi32 (ByVal hdc As LongPtr, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare PtrSafe Function DeleteObject Lib gdi32 (ByVal hObject As LongPtr) As Long Private Declare PtrSafe Function InvalidateRect Lib user32 (ByVal hwnd As LongPtr, lpRect As RECT, ByVal bErase As Long) As Long #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 GetDC Lib user32 (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib user32 (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function CreatePen Lib gdi32 Alias CreatePen (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long Private Declare Function GetStockObject Lib gdi32 Alias GetStockObject (ByVal nIndex As Long) As Long Private Declare Function SelectObject Lib gdi32 Alias SelectObject (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function Ellipse Lib gdi32 (ByVal hdc As LongPtr, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function DeleteObject Lib gdi32 Alias DeleteObject (ByVal hObject As Long) As Long Private Declare Function InvalidateRect Lib user32 Alias InvalidateRect (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) As Long #End If #If VBA7 And Win64 Then Private Type POINTAPI x As Long y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type #Else Private Type POINTAPI x As Long y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long 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 DialogHdc As LongPtr DiglogClick As POINTAPI Editor As LongPtr EditorState As LongPtr Temp(3) As LongPtr End Type #Else Private Const Nuptr As Long 0 Private Ud As UserDialogType Private Type UserDialogType Dialog As Long DialogProc As Long DialogHdc As Long DiglogClick As POINTAPI Editor As Long EditorState As Long Temp(3) 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 WM_LBUTTONDOWN H201 Private Const WM_LBUTTONUP H202 Private Const PS_SOLID 0 Private Const NULL_BRUSH 5 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) 获取对话框绘制环境 Ud.DialogHdc GetDC(Ud.Dialog) 设置对话框子类化 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 释放绘制环境 ReleaseDC Ud.Dialog, Ud.DialogHdc 销毁窗口 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_LBUTTONDOWN 从lParam低位获取鼠标x坐标 Ud.DiglogClick.x CLng(lParam) And HFFFF 从lParam高位获取鼠标y坐标 Ud.DiglogClick.y (CLng(lParam) And HFFFF0000) / H10000 创建并拿起画笔 Ud.Temp(0) CreatePen(PS_SOLID, 1, RGB(0, 0, 0)) Ud.Temp(1) SelectObject(Ud.DialogHdc, Ud.Temp(0)) 创建并拿起空画刷 Ud.Temp(2) GetStockObject(NULL_BRUSH) Ud.Temp(3) SelectObject(Ud.DialogHdc, Ud.Temp(2)) 绘制圆有边框、无背景 Ellipse Ud.DialogHdc, Ud.DiglogClick.x - 10, Ud.DiglogClick.y - 10, Ud.DiglogClick.x 10, Ud.DiglogClick.y 10 选中之前的画笔和画刷 SelectObject Ud.DialogHdc, Ud.Temp(1) SelectObject Ud.DialogHdc, Ud.Temp(3) 销毁临时画笔 DeleteObject Ud.Temp(0) Case WM_LBUTTONUP 重绘擦除之前的醒目标记 Dim lprc As RECT lprc.Left Ud.DiglogClick.x - 10 lprc.Top Ud.DiglogClick.y - 10 lprc.Right Ud.DiglogClick.x 10 lprc.Bottom Ud.DiglogClick.y 10 InvalidateRect Ud.Dialog, lprc, True End Select 调用默认通知处理 WindowProcUdDialog CallWindowProcA(Ud.DialogProc, hwnd, msg, wParam, lParam) End Function5. 相关合集关于#32770对话框窗口的专项开发计划

相关新闻

最新新闻

幻兽帕鲁存档解析终极指南:3种方法解锁游戏数据编辑新境界

幻兽帕鲁存档解析终极指南:3种方法解锁游戏数据编辑新境界

幻兽帕鲁存档解析终极指南:3种方法解锁游戏数据编辑新境界 【免费下载链接】palworld-save-tools Tools for converting Palworld .sav files to JSON and back 项目地址: https://gitcode.com/gh_mirrors/pa/palworld-save-tools 你是否曾经对《幻兽帕鲁》的…

2026/8/4 8:25:37
转换器设计评估与实现:从策略模式到MapStruct的高质量代码实践

转换器设计评估与实现:从策略模式到MapStruct的高质量代码实践

1. 项目概述:为什么“转换器”值得你花时间评估与设计?“转换器”这个词听起来可能有点宽泛,但在我们日常的开发、运维乃至产品设计中,它几乎无处不在。从数据格式转换(比如JSON转XML)、单位换算&#xff0…

2026/8/4 8:25:37
培训机构教务系统开发痛点|智能排课模块冲突问题解决方案

培训机构教务系统开发痛点|智能排课模块冲突问题解决方案

一、前言 近期接触不少准备自研或者二次开发培训机构教务系统的技术从业者,排课模块是开发中最容易踩坑的模块。很多自研教务系统上线后频繁出现时间冲突、教室重复占用、老师撞课等问题,严重影响校区正常运营。 本文结合教培真实业务场景,梳…

2026/8/4 8:25:37
从文档到智能体:基于向量检索与大模型的Book-to-Skill实践指南

从文档到智能体:基于向量检索与大模型的Book-to-Skill实践指南

在实际技术项目中,我们常常需要将结构化的知识或文档转化为可执行、可交互的自动化流程或智能体(Agent)的能力,这通常被称为“Skill”。一个典型的场景是:你有一本技术手册、一份API文档或一套操作指南,你希…

2026/8/4 8:25:37
OpenAI与Anthropic API实战:从基础调用到工具调用完整指南

OpenAI与Anthropic API实战:从基础调用到工具调用完整指南

最近在对接 OpenAI 和 Anthropic 的 API 时,不少开发者反馈遇到了各种网络连接、配置兼容和模型调用的问题,从基础的“无法连接到服务”到复杂的工具调用(Tool Calling)协议适配,每一步都可能踩坑。本文将系统梳理这两…

2026/8/4 8:25:37
UEViewer终极指南:快速掌握虚幻引擎资源查看与导出技巧

UEViewer终极指南:快速掌握虚幻引擎资源查看与导出技巧

UEViewer终极指南:快速掌握虚幻引擎资源查看与导出技巧 【免费下载链接】UEViewer Viewer and exporter for Unreal Engine 1-4 assets (UE Viewer). 项目地址: https://gitcode.com/gh_mirrors/ue/UEViewer UEViewer(又称umodel)是一…

2026/8/4 8:20:37