Access开发右下角浮窗提醒

Hi,大家好呀!

感觉又有很长一段时间没有给大家更新内容了,最近一直在忙,给大家承诺的框架、视频教程、直播等等感觉又要跳票了,嘿嘿,但大家还是不要急,莫催我,我会慢慢都更新出来的!大家持续关注我就行!我会一直肝到底!

那今天给大家更新点啥呢?

在桌面应用里,通知既要"被看到",又要"不打扰"。"角落滑入通知"是一种兼顾二者的方案。

效果与交互

  • 位置:屏幕右下角,避开任务栏。

  • 动画:自底向上滑入 → 停留约 3 秒 → 透明度逐步降低并关闭。

  • 打断友好:不抢焦点,不遮挡输入光标区域;可点击交互后延时关闭或保持

0 1、创建窗体

这里,我们要创建一个窗体,我们可以在窗体上放一个标签用于信息的显示,这里就做的简单一些,后期可以自己慢慢调整,如图:

0 2、添加代码

接着,我们就可以添加代码了,具体代码分两块

1、在窗体里面,添加如下代码

vbscript 复制代码
' 功能:窗体加载后贴靠屏幕右下,从底部向上滑动显示,停留约 3 秒后逐步隐藏并关闭。

' 说明:本代码在 Access/表单中使用 twips 单位(1 像素 ≈ 15 twips)。

' 依赖:apiGetDC、GetDeviceCaps、GetSystemHeight、GetTaskbarHeight 为外部/自定义函数。



Dim MyWidth As Long, MyHeight As Long   ' 屏幕分辨率(像素)

Dim D As Long, TranI As Byte            ' D: 停留计数器;TranI: 透明度计数器(0-255)



Private Sub Form_Load()



    Dim Hdc As Long                      ' 屏幕 DC 句柄



    Hdc = apiGetDC(0)                    ' 获取整个屏幕的 DC

    MyWidth = GetDeviceCaps(Hdc, 8)      ' HORZRES = 8,屏幕宽度(像素)

    MyHeight = GetDeviceCaps(Hdc, 10)    ' VERTRES = 10,屏幕高度(像素)



    DoCmd.MoveSize (MyWidth * 15 - Me.WindowWidth), GetSystemHeight * 15

    ' 将窗体移动到屏幕右侧(X=屏幕宽度*15 - 窗体宽度),Y 放在工作区底部(像素转 twips)

   

    Me.OnTimer = "=ShowTimer()"          ' 首先执行滑动显示

    Me.TimerInterval = 10                ' 定时器间隔 10 ms

   

End Sub



Private Function ShowTimer()



    Dim I As Integer

    For I = GetSystemHeight * 15 To (MyHeight * 15 - Me.WindowHeight) - GetTaskbarHeight * 15 Step -1

        ' 从工作区底部开始,逐像素向上滑动到目标位置(避开任务栏)

        DoCmd.MoveSize (MyWidth * 15 - Me.WindowWidth), I

    Next I

    Me.OnTimer = "=DTimer()"             ' 滑动结束,进入停留计时阶段

   

End Function



Private Function DTimer()



    If D >= 300 Then                     ' 约 300*10ms ≈ 3 秒

        Me.OnTimer = "=HidenTimer()"     ' 切换到隐藏阶段

        Exit Function

    End If

    D = D + 1                            ' 增加停留计数

   

End Function



Private Function HidenTimer()



    If TranI = 0 Then

        Me.TimerInterval = 0             ' 停止计时器

        DoCmd.Close acForm, Me.Name      ' 关闭窗体

        Exit Function

    End If

    TranI = TranI - 2                    ' 逐步降低透明度计数(需配合外部绘制/Alpha 逻辑生效)

   

End Function



Private Function ReSetTranI()



    If D <> 150 Then

        D = 150                          ' 将停留计数重置到中间值

        Me.OnTimer = "=DTimer()"         ' 返回到停留计时阶段

    End If

   

End Function

2、添加一个通用模块,在通用模块里添加代码

vbscript 复制代码
Option Explicit



' 像素与缇(twips)转换相关/屏幕参数 -----------------------------------------------------------

' 说明:Access/表单使用缇作为尺寸单位(约 1 像素 ≈ 15 缇)。以下 API 返回的均为像素单位。



' 获取指定窗口(或屏幕)的设备环境句柄(DC);hwnd=0 表示整个屏幕

Public Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long



' 释放通过 GetDC 获取的 DC;必须与 GetDC 成对调用

Public Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal Hdc As Long) As Long



' 获取设备能力参数;常用:8=HORZRES(屏幕宽度像素),10=VERTRES(屏幕高度像素)

Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal Hdc As Long, ByVal nIndex As Long) As Long



' 获取系统度量;nIndex=SM_CXSCREEN/SM_CYSCREEN 分别为屏幕宽/高(像素)

Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long



' 系统度量索引:屏幕宽/高(像素)

Public Const SM_CXSCREEN = 0

Public Const SM_CYSCREEN = 1



' SystemParametersInfo 动作码:获取工作区矩形(不含任务栏)

Public Const SPI_GETWORKAREA = 48



' 屏幕坐标矩形,单位:像素

Type RECT

    Left As Long    ' 左上角 X

    Top As Long     ' 左上角 Y

    Right As Long   ' 右下角 X

    Bottom As Long  ' 右下角 Y

End Type



' 通过 SystemParametersInfo 获取/设置系统参数;

' 当 uAction=SPI_GETWORKAREA 时,lpvParam 需传入 RECT,用于接收不含任务栏的工作区

Public 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



' 取得屏幕高度(像素)

' 注意:返回类型为 Integer;在超高分辨率环境下建议改为 Long 以避免溢出

Public Function GetSystemHeight() As Integer

    GetSystemHeight = GetSystemMetrics(SM_CYSCREEN)

End Function



' 取得任务栏高度(像素)= 屏幕总高 - 工作区 Bottom

' 注意:忽略了 API 返回值 lRes 的错误处理;生产代码可判断非 0 表示成功

' 同样地,返回类型为 Integer;高分屏建议改为 Long

Public Function GetTaskbarHeight() As Integer

    Dim lRes As Long

    Dim RectVal As RECT

    lRes = SystemParametersInfo(SPI_GETWORKAREA, 0, RectVal, 0) ' 填充工作区(不含任务栏)

    GetTaskbarHeight = GetSystemMetrics(SM_CYSCREEN) - RectVal.Bottom

End Function

03、运行测试

代码比较多,大家都要复制正确了。

最后我们就可以运行测试了,双击打开这个窗体后,窗体可以在右下方打开,我们来看看效果怎么样。

注意:我做成GIF,剪辑速度加快了。

小结

"角落滑入通知"用最小打扰传递关键信息。基于简单状态机与少量参数,就能在 Access/VBA 中快速获得稳定、顺滑、可扩展的桌面提醒体验。

相关推荐
sanshanjianke6 小时前
微软开发的Unix系统——Xenix测评
microsoft
LZQqqqqo6 小时前
WinForm 对话框的 Show 与 ShowDialog:阻塞与非阻塞的抉择
服务器·windows·microsoft·winform
FreeBuf_6 小时前
微软披露Exchange Server漏洞:攻击者可静默获取混合部署环境云访问权限
网络·安全·microsoft
AI创世纪7 小时前
微软XBOX游戏部门大裁员
游戏·microsoft·xbox
数据猿视觉8 小时前
宁商平台税务升级之路:合规为纲,服务为本
大数据·人工智能·microsoft
凯子坚持 c9 小时前
手搓MCP全流程指南:从本地开发部署到PyPI公开发布
microsoft
Leinwin1 天前
OpenAI 开源模型 gpt-oss 正式上线微软 Foundry 平台
gpt·microsoft·开源
天庭鸡腿哥1 天前
直连微软,下载速度达18M/S
microsoft
zh73143 天前
laravel在cli模式下输出格式漂亮一些
microsoft·php·laravel