动态

不用前端、不用 Python，一个 Access 窗体 + 不到 200 行 VBA，就能做出弹幕飞屏、流光换色、呼吸背景的新春动画。

hi，大家新年快乐，马年大吉！ 

先给大家讲个恐怖故事，马上要开工了，大家是不是很开心呀！

今年的春节，朋友圈各种祝福都是短视频、AI视频、AI祝福！我就在想——能不能用最"朴实无华"的工具，做一个最有年味的祝福？

于是我打开了 Access。

最终效果：一匹金色大"马"字在屏幕上奔跑，五彩弹幕漫天飞舞，背景在暗红和暖金之间缓缓呼吸——打开窗体的一瞬间，满屏都是年味。

第一步：搭窗体骨架

在 Access 设计视图中新建一个空白窗体，添加 7 个 Label 控件：

所有标签的背景样式设为"透明"，这样文字才能浮在彩色背景上。

第二步：设计四层动画架构

我把整个动画拆成 4 个独立的子程序，每 60 毫秒（约 16fps）同时执行一轮：

Form_Timer()  ├── AnimBackground()   ← 背景呼吸  ├── AnimHorse()        ← 马字奔跑 + 流光  ├── AnimTitlePulse()   ← 标题脉冲  └── AnimBarrage()      ← 弹幕飞入

这种"分层驱动"的思路让每个效果互不干扰，调试和修改都很方便。

第三步：逐个实现动画效果

奔跑的马 —— 一个 96pt 加粗的"马"字，每帧向右移动 80 缇（Access 的坐标单位），跑到右边缘后从左侧重新出现。每 4 帧上下颠簸一次模拟跃动，每 10 帧切换一次颜色——金色、淡黄、橙色、白色、橙红、亮金——六色流光循环。

金色 → 淡黄 → 橙色 → 白色 → 橙红 → 亮金 → 金色 …

脉冲标题 —— "2026 新春快乐"的字号在 32pt 和 44pt 之间像心跳一样匀速缩放，不是闪烁，是一呼一吸的脉冲。

五彩弹幕 —— 5 条祝福语从右侧飞入，每条都有随机的速度（120~340 缇/帧）、字号（18~32pt）和颜色。祝福语从"马到成功""龙马精神""恭喜发财"等 12 条经典贺词中随机抽取。

为了避免弹幕扎堆在中间，我用了分道制——把窗体高度均分 5 条水平通道，每条弹幕在自己的通道内飞行，从上到下均匀铺满画面。

呼吸背景 —— 背景色的 R 分量在 120~200 之间缓慢摆动，G 分量同步变化，形成暗红 ↔ 暖金红的渐变效果——那种年画上才有的沉稳又温暖的中国红。

整个动画只需要 7 个 Label 控件 + 一段 VBA 代码，没有任何外部依赖。以下是完整的窗体代码模块（复制到窗体的代码模块中即可运行）：

Option Compare Database
Option Explicit
' =================================================================
' 2026 马年春节动画 v3.0
' 效果：超大马字流光 + 标题脉冲 + 五彩弹幕 + 金红呼吸背景
' =================================================================
'--- 全局变量 ---
Private Tick          As Long     ' 全局帧计数
Private BgRed         As Integer  ' 背景 R 分量
Private BgGold        As Integer  ' 背景 G 分量 (黄金感)
Private BgDir         As Integer  ' 背景呼吸方向
Private HorseColorIdx As Integer  ' 马字颜色序号
Private HorseX        As Long     ' 马当前水平位置
Private HorseBaseY    As Long     ' 马的基准垂直位置
Private HorseBounce   As Integer  ' 颠簸方向 (1 或 -1)
Private TitleSize     As Integer  ' 标题字体大小
Private TitleSizeDir  As Integer  ' 标题大小变化方向
Private Type TBarrage
    Name     As String
    Active   As Boolean
    Speed    As Integer
End Type
Private Bar(1 To 5) As TBarrage
Private Msgs         As Variant   ' 弹幕祝福语库
' ---------------------------------------------------------------
Private Sub Form_Load()
    Me.Caption = "2026 丙午马年  新春大吉"
    Me.TimerInterval = 60           ' 约 16fps，流畅不卡顿
    Me.ScrollBars = 0
    Me.RecordSelectors = False
    Me.NavigationButtons = False
  
    '--- 初始参数 ---
    Tick = 0
    BgRed = 160
    BgGold = 30
    BgDir = 3
    HorseColorIdx = 0
    HorseX = 0
    HorseBaseY = 0       ' 将在 AnimHorse 首次运行时按窗体高度初始化
    HorseBounce = 1
    TitleSize = 36
    TitleSizeDir = 1
    '--- 弹幕祝福语库 ---
    Msgs = Array( _
        "新春快乐", "马到成功", "万事如意", "恭喜发财", _
        "岁岁平安", "阖家欢乐", "龙马精神", "事业腾飞", _
        "吉祥如意", "财源广进", "步步高升", "心想事成")
    '--- 初始化 5 条弹幕 ---
    Dim i As Integer
    For i = 1 To 5
        Bar(i).Name = "lblBarrage" & i
        Bar(i).Active = False
        Bar(i).Speed = 0
        On Error Resume Next
        Me.Controls(Bar(i).Name).Visible = False
        On Error GoTo 0
    Next i
    '--- 马字和标题初始样式 ---
    On Error Resume Next
    With Me.lblHorse
        .ForeColor = RGB(255, 215, 0)   ' 初始金色
        .FontBold = True
        .FontSize = 96
        .BackStyle = 0                  ' 透明背景
    End With
    With Me.lblTitle
        .ForeColor = RGB(255, 255, 255)
        .FontBold = True
        .FontSize = 36
        .BackStyle = 0
    End With
    On Error GoTo 0
End Sub
' ---------------------------------------------------------------
Private Sub Form_Timer()
    AnimBackground   ' 背景金红呼吸
    AnimHorse        ' 马字奔跑 + 流光换色
    AnimTitlePulse   ' 标题脉冲缩放
    AnimBarrage      ' 弹幕飞入
    Tick = Tick + 1
    If Tick > 100000 Then Tick = 0
End Sub
' ---------------------------------------------------------------
' 背景：在暗红与暖金红之间平滑呼吸
Private Sub AnimBackground()
    BgRed = BgRed + BgDir
    BgGold = BgGold + BgDir * 2
    If BgRed >= 200 Then
        BgRed = 200: BgGold = 80: BgDir = -3
    ElseIf BgRed <= 120 Then
        BgRed = 120: BgGold = 10: BgDir = 3
    End If
    ' 强制限制分量在合法范围内，防止 RGB() 参数越界报错
    If BgRed < 0 Then BgRed = 0
    If BgRed > 255 Then BgRed = 255
    If BgGold < 0 Then BgGold = 0
    If BgGold > 255 Then BgGold = 255
    Me.Section(0).BackColor = RGB(BgRed, BgGold, 0)
End Sub
' ---------------------------------------------------------------
' 马字：向右奔跑 + 上下颠簸 + 流光换色
Private Sub AnimHorse()
    Dim h         As Control
    Dim wWidth    As Long
    Dim bounceAmp As Long   ' 颠簸幅度 (twips)
    Dim Colors(0 To 5) As Long
    On Error Resume Next
    Set h = Me.lblHorse
    If Err.Number <> 0 Then Err.Clear: Exit Sub
    On Error GoTo 0
    wWidth = Me.InsideWidth
    bounceAmp = 80   ' 上下颠簸幅度，可调大/小
    ' 首次运行时记录基准 Y（取控件当前 Top）
    If HorseBaseY = 0 Then HorseBaseY = h.Top
    ' --- 水平移动：每帧向右移 80 twips ---
    HorseX = HorseX + 80
    ' 跑到右边缘后从最左边重新出现
    If HorseX + h.Width > wWidth Then HorseX = 0
    ' --- 垂直颠簸：每4帧换一次方向 ---
    If Tick Mod 4 = 0 Then
        HorseBounce = -HorseBounce
    End If
    Dim newTop As Long
    newTop = HorseBaseY + HorseBounce * bounceAmp
    If newTop < 0 Then newTop = 0
    h.Left = HorseX
    h.Top = newTop
    ' --- 流光换色：每 10 帧换一次 ---
    If Tick Mod 10 = 0 Then
        Colors(0) = RGB(255, 215, 0)    ' 金色
        Colors(1) = RGB(255, 255, 180)  ' 淡黄
        Colors(2) = RGB(255, 140, 0)    ' 橙色
        Colors(3) = RGB(255, 255, 255)  ' 白色
        Colors(4) = RGB(255, 100, 50)   ' 橙红
        Colors(5) = RGB(255, 200, 0)    ' 亮金
        HorseColorIdx = (HorseColorIdx + 1) Mod 6
        h.ForeColor = Colors(HorseColorIdx)
    End If
End Sub
' ---------------------------------------------------------------
' 标题：字体大小在 32~44pt 之间脉冲，像心跳
Private Sub AnimTitlePulse()
    If Tick Mod 3 <> 0 Then Exit Sub
    TitleSize = TitleSize + TitleSizeDir
    If TitleSize >= 44 Then
        TitleSize = 44
        TitleSizeDir = -1
    ElseIf TitleSize <= 32 Then
        TitleSize = 32
        TitleSizeDir = 1
    End If
    On Error Resume Next
    Me.lblTitle.FontSize = TitleSize
    On Error GoTo 0
End Sub
' ---------------------------------------------------------------
' 弹幕：5条祝福语随机速度/字号/高度从右侧飞入
Private Sub AnimBarrage()
 Dim i       As Integer
    Dim ctrl    As Control
    Dim wWidth  As Long
    Dim wHeight As Long
    ' InsideWidth = 窗体客户区宽度（不含边框），与控件坐标系一致
    wWidth = Me.InsideWidth
    wHeight = Me.Section(0).Height
    For i = 1 To 5
        On Error Resume Next
        Set ctrl = Me.Controls(Bar(i).Name)
        If Err.Number <> 0 Then Err.Clear: GoTo NextBar
        On Error GoTo 0
        If Bar(i).Active Then
            Dim newLeft As Long
            newLeft = ctrl.Left - Bar(i).Speed
            If newLeft <= 0 Then
                ' 即将越出左边界，直接回收，不赋负值
                Bar(i).Active = False
                ctrl.Visible = False
                ctrl.Left = 0
            Else
                ctrl.Left = newLeft
            End If
        Else
            If Rnd() < 0.08 Then    ' 每帧约 8% 概率激活
                Bar(i).Active = True
                Bar(i).Speed = 120 + Int(Rnd() * 220)     ' 速度 120~340 twips/tick
                ctrl.Caption = Msgs(Int(Rnd() * (UBound(Msgs) + 1)))
                ctrl.FontSize = 18 + Int(Rnd() * 14)      ' 大小 18~32pt
                ' 金/白/浅橙/浅青，在红色背景上均清晰可读
                Select Case Int(Rnd() * 4)
                    Case 0: ctrl.ForeColor = RGB(255, 215, 0)    ' 金色
                    Case 1: ctrl.ForeColor = RGB(255, 255, 255)  ' 白色
                    Case 2: ctrl.ForeColor = RGB(255, 200, 100)  ' 浅橙
                    Case 3: ctrl.ForeColor = RGB(180, 255, 255)  ' 浅青
                End Select
                ' 先隐藏再移位，避免闪烁；起始位置 = 右边缘，不超出 Section 边界
                ctrl.Visible = False
                ctrl.Left = wWidth - ctrl.Width
                ' 分道制：把窗体高度均分 5 条水平通道，每条弹幕在自己的通道内随机偏移
                ' 这样弹幕从上到下均匀分布，不会扎堆在中间
                Dim laneH As Long
                Dim topMargin As Long
                topMargin = 200                              ' 上边距 (twips)
                laneH = (wHeight - topMargin * 2)  5        ' 每条通道高度
                If laneH < 400 Then laneH = 400              ' 最小通道高度保护
                Dim laneTop As Long
                laneTop = topMargin + (i - 1) * laneH + Int(Rnd() * (laneH - 500))
                If laneTop < 0 Then laneTop = 0
                If laneTop + 600 > wHeight Then laneTop = wHeight - 600
                ctrl.Top = laneTop
                ctrl.Visible = True
            End If
        End If
NextBar:
    Next i
End Sub

1. 打开 Access → 新建空白窗体（设计视图）

2. 添加 7 个标签控件，命名为 lblHorse、lblTitle、lblBarrage1 ~ lblBarrage5

3. 所有标签的"背景样式"设为"透明"

1. 打开窗体代码模块（Alt+F11），粘贴上面的完整代码

2. 切换到窗体视图 → 动画自动开始

有人说 Access 过时了。但我觉得，任何工具都值得被认真对待。当你足够了解它的能力边界，就能在最意想不到的地方，做出最有趣的东西。

这个小动画没有华丽的前端框架，没有复杂的图形引擎——它只是一个 Access 窗体、7 个标签控件、和不到 200 行 VBA 代码。

但每次打开它，看到那个金色的"马"字从屏幕左边跑到右边，弹幕飘满整个画面，背景像呼吸一样缓缓变化——这就是属于程序员的"花开富贵"。

马年大吉，祝大家马到成功、龙马精神、万事如意！

Access 开发」 专注于 Microsoft Access 开发与企业级应用，提供以下服务：

📚 技术培训

• Access VBA 从入门到精通（线上/线下）

• Access + SQL Server 企业级开发实战

• Access 系统性能优化与架构设计

💼 定制开发

• 企业 ERP/CRM/进销存等系统开发

• 旧系统升级与性能优化

🔧 技术支持

• 代码审查与重构建议

• 疑难问题远程诊断

• 一对一技术辅导

联系方式：

• 公众号后台留言

• 邮箱：will.miao@edonsoft.com

• 微信：edonsoft

  

技术改变业务，专注创造价值。