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.