Question

我试图通过使用一些动画打开一个子窗体来为我的Access数据库添加一些耀斑。我希望它从主窗体的左上角打开，并以小的增量扩展它的大小，直到它达到主窗体的宽度和高度。当我单步执行它时，我所拥有的代码似乎按预期工作，但实际上它暂停了整个循环的持续时间，并且只显示完整大小的表单而没有任何动画外观。好像它在批处理中运行循环，然后执行对子窗体对象的调整。有关如何实现这一目标的任何建议吗？

Option Compare Database
Option Explicit

Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)

Public Sub AnimateOpenForm(SubForm As String, maxWidth As Long, maxHeight As Long)
    Dim sbf As SubForm
    Dim parentForm As String
    Dim incrementX As Double
    Dim incrementY As Double

    parentForm = "frmHome"

    Set sbf = Forms(parentForm).Controls("sbfPopUp")
    sbf.SourceObject = SubForm

    sbf.Width = 0
    sbf.Height = 0

    sbf.Visible = True

    incrementX = maxWidth / 1000
    incrementY = maxHeight / 1000

    Do While sbf.Width < maxWidth And sbf.Height < maxHeight

        sbf.Width = sbf.Width + incrementX
        sbf.Height = sbf.Height + incrementY

        Sleep 10

    Loop

End Sub

Answer 1

DoEvents将为系统提供重绘所需的暂停。

而不是睡眠（并进行32位内核调用）我将代码更改为＆＃34; Sleep 10＆＃34; to＆＃34; started = Timer：Do：DoEvents：Loop Until Timer - started＆gt; = 0.001＆＃34; Dim＆＃34; Dim开始单身＆＃34;导致：



 Public Sub AnimateOpenForm(SubForm As String, maxWidth As Long, maxHeight As Long)
    Dim sbf As SubForm
    Dim parentForm As String
    Dim incrementX As Double
    Dim incrementY As Double
    Dim started As Single

    parentForm = "frmHome"

    Set sbf = Forms(parentForm).Controls("sbfPopUp")
    sbf.SourceObject = SubForm

    sbf.Width = 0
    sbf.Height = 0

    sbf.Visible = True

    incrementX = maxWidth / 1000
    incrementY = maxHeight / 1000

    Do While sbf.Width < maxWidth And sbf.Height $lt; maxHeight

        sbf.Width = sbf.Width + incrementX
        sbf.Height = sbf.Height + incrementY

        started = Timer: Do: DoEvents: Loop Until Timer - started >= 0.001

    Loop

End Sub

使用Access VBA动画化子窗体

1 个答案: