简体   繁体   中英

Animating a SubForm Using Access VBA

I'm attempting to add a bit of flare to my Access database by opening a subform using some animation. I am wanting it to open from the top left of the main form and expand its size by small increments until it reaches the width and height of the main form. The code I have seems to work as intended when I step through it, however when in reality it pauses for the full duration of the loop and only appears to display the form at full size without any appearance of animation. It seems as if it runs the loop in a batch, then executes the adjustments to the subform object. Any recommendations on how to achieve this?

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

DoEvents will give the system the needed pause to redraw.

Instead of Sleep (and making 32 bit kernel calls) I changed your code to from "Sleep 10" to "started = Timer: Do: DoEvents: Loop Until Timer - started >= 0.001" and up top Dim'ed "Dim started As Single" Resulting in:

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM