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 中快速获得稳定、顺滑、可扩展的桌面提醒体验。