I'm not sure when AnimateWindow quit working. I was sure it was working Ok even for a simple PictureBox in the past. But I can't get it working right for a UserControl either.
Something like a simple TextBox seems Ok yet, but I'm sure the issues necessary were addressed within common system controls like the one inside a TextBox.
This is broken on Windows 10 though it might work yet on something earlier:
I have two fixes but one has an awful flicker on Form Load (it has to make the UserControl visible to do a capture on it), here is the second one that works as desired:
Surely there is a better alternative though? The gyrations I'm going through seem beyond unnecessary.
Seems to be a problem with painting/refreshing the window. On XP, the UC appears black until I move another window over the UC and off again (forcing a paint). On Windows 10 that doesn't help, but moving the parent form so the black UC is off the side of the monitor and back forces the repaint...strange.
Minimizing/Restoring also redraws the UC on both XP and 10.
Perhaps this has always been an issue for controls like PictureBox and UserControl. I thought it used to work with no fiddling, but maybe I just remembered incorrectly. Desktop Composition seems to be a factor here but not the entire story.
My first "fix" attempt tries to BitBlt from GetWindowRect(hWnd, RECT) but it also gets a black rectangle of the correct size if the UserControl is hidden.
Ok, I took my "fix 2" and did something very weird to it.
This seems goofy and it has a cost (the EXE is larger). This is because I now capture the UserControl at design-time!
It works, but as I said before... there must be a better answer. This answer is too static. The others were also static but that could be alleviated, this one can only be static.
I'm not sure what's going on (and to be honest - I'm not sure I care enough to continue!). I just tried putting the UC on a separate form and calling AnimateWindow against the second form hWnd. No luck, everything was still black.
Ummhh, do I see that right - about 500 lines of code, just to move a Control-container-around?
Or is this API useful for more purposes than just "slide-in, slide-out" stuff?
(never used this API so far...)
What about writing your own little Animation-Routine in significantly less code
(without SubClassing or API-acrobatics).
There's nice "Easing-functions" which are now considered a Standard in the Web-World: http://easings.net/en
...and building a little Class around the most important ones of the bunch took me 100 lines.
Into a Class, named cEasing
Code:
Option Explicit 'Olaf Schmidt 2017 (see http://easings.net/en for a good explanation)
Public Enum eEaseFunction
easeQuad
easeCubic
easeQuint
easeBounce
easeElastic
End Enum
Public Enum eEaseMode
easeIn
easeOut
easeInOut
End Enum
Private mCtl As Object, WithEvents mTmr As Timer
Private mDistance, mDuration, mStartT, mEaseFunc As eEaseFunction, mEaseMode As eEaseMode
Public Sub Animate(Ctl As Object, Tmr As Timer, Distance, Duration, _
ByVal EaseFunction As eEaseFunction, Optional ByVal EaseMode As eEaseMode)
Set mCtl = Ctl
mDistance = Distance
mDuration = Duration
mStartT = Timer
mEaseFunc = EaseFunction
mEaseMode = EaseMode
Set mTmr = Tmr: mTmr.Enabled = True: mTmr.Interval = 10
End Sub
Private Sub mTmr_Timer()
On Error Resume Next
Dim dT: dT = (Timer - mStartT) / mDuration
If dT <= 1 Then
mCtl.Move mCtl.Left, mDistance * Ease(dT, mEaseFunc, mEaseMode)
Else
mCtl.Move mCtl.Left, mDistance 'set the final endpoint
mTmr.Enabled = False: Set mTmr = Nothing
End If
End Sub
Public Function Ease(dT, ByVal EaseFunction As eEaseFunction, Optional ByVal EaseMode As eEaseMode)
Dim sEaseMode As String
sEaseMode = Choose(EaseMode + 1, "In", "Out", "InOut")
Select Case EaseFunction
Case easeQuad: Ease = CallByName(Me, "Quad" & sEaseMode, VbMethod, dT)
Case easeCubic: Ease = CallByName(Me, "Cubic" & sEaseMode, VbMethod, dT)
Case easeQuint: Ease = CallByName(Me, "Quint" & sEaseMode, VbMethod, dT)
Case easeBounce: Ease = CallByName(Me, "Bounce" & sEaseMode, VbMethod, dT)
Case easeElastic: Ease = CallByName(Me, "Elastic" & sEaseMode, VbMethod, dT)
End Select
End Function
Function QuadIn(t)
QuadIn = t ^ 2
End Function
Function QuadOut(t)
QuadOut = 1 - QuadIn(1 - t)
End Function
Function QuadInOut(t)
If t < 0.5 Then QuadInOut = QuadIn(t * 2) / 2 Else QuadInOut = (QuadOut(t * 2 - 1) + 1) / 2
End Function
Function CubicIn(t)
CubicIn = t ^ 3
End Function
Function CubicOut(t)
CubicOut = 1 - CubicIn(1 - t)
End Function
Function CubicInOut(t)
If t < 0.5 Then CubicInOut = CubicIn(t * 2) / 2 Else CubicInOut = (CubicOut(t * 2 - 1) + 1) / 2
End Function
Function QuintIn(t)
QuintIn = t ^ 5
End Function
Function QuintOut(t)
QuintOut = 1 - QuintIn(1 - t)
End Function
Function QuintInOut(t)
If t < 0.5 Then QuintInOut = QuintIn(t * 2) / 2 Else QuintInOut = (QuintOut(t * 2 - 1) + 1) / 2
End Function
Function ElasticIn(t)
ElasticIn = 1 - ElasticOut(1 - t)
End Function
Function ElasticOut(t)
ElasticOut = 2 ^ (-10 * t) * Sin((t - 0.3 / 4) * (6.28318530717959) / 0.3) + 1
End Function
Function ElasticInOut(t)
If t < 0.5 Then ElasticInOut = ElasticIn(t * 2) / 2 Else ElasticInOut = (ElasticOut(t * 2 - 1) + 1) / 2
End Function
Function BounceIn(t)
BounceIn = 1 - BounceOut(1 - t)
End Function
Function BounceOut(t)
If (t < (1 / 2.75)) Then BounceOut = 7.5625 * t ^ 2: Exit Function
If (t < (2 / 2.75)) Then t = t - 1.5 / 2.75: BounceOut = 7.5625 * t ^ 2 + 0.75: Exit Function
If (t < (2.5 / 2.75)) Then t = t - 2.25 / 2.75: BounceOut = 7.5625 * t ^ 2 + 0.9375: Exit Function
t = t - 2.625 / 2.75: BounceOut = 7.5625 * t ^ 2 + 0.984375
End Function
Function BounceInOut(t)
If t < 0.5 Then BounceInOut = BounceIn(t * 2) / 2 Else BounceInOut = (BounceOut(t * 2 - 1) + 1) / 2
End Function
Ok, with the above Class in place, here's some Form-Code how to use it
(Form needs: List1, List2, Timer1 and Picture1)
Code:
Option Explicit
Private Easing As New cEasing
Private Sub Form_Load()
Caption = "Click the Form to repeat"
List1.AddItem "easeQuad"
List1.AddItem "easeCubic"
List1.AddItem "easeQuint"
List1.AddItem "easeBounce"
List1.AddItem "easeElastic"
List2.AddItem "easeIn"
List2.AddItem "easeOut"
List2.AddItem "easeInOut"
List1.ListIndex = 3
List2.ListIndex = 1
End Sub
Private Sub Form_Click()
ScaleMode = vbPixels: AutoRedraw = True: DrawWidth = 2
Cls
Const d = 200
Dim i, x, y
For i = 0 To d
x = i / d * ScaleWidth
y = ScaleHeight * Easing.Ease(i / d, List1.ListIndex, List2.ListIndex)
Line -(x, y), vbRed
Next
Easing.Animate Picture1, Timer1, ScaleHeight - Picture1.Height, 2, List1.ListIndex, List2.ListIndex
End Sub
Private Sub List1_Click()
If List2.ListIndex < 0 Then Exit Sub Else Form_Click
End Sub
Private Sub List2_Click()
If List1.ListIndex < 0 Then Exit Sub Else Form_Click
End Sub
Then producing Animations according to the selections in the List-Boxes:
Using a simple API call you could get an animated version of Visible = True/False...
Obviously that was a huge fail. I was hoping for some simple call or property setting to make a PictureBox or UserControl behave properly but we don't have that.
So yes, until somebody can provide such an answer the entire thing is pointless.
By my reckoning, AnimateWindow has never worked for VB UserControls, since VB doesn't automatically respond to WM_PRINTCLIENT messages. Many 3rd-party OCXs have the same problem, alas.
Eduardo Morcillo provided a sample workaround way back in the day, and I imagine any modern workaround has to rely on the same tricks (e.g. subclassing, same as your example(s), dilettante):
Odd because I thought this worked fine in the past.
Either my memory fails me (likely enough) or I had only tried it with things like a TextBox or maybe RichTextBox that handle WM_PRINT as desired for such a case.
I wouldn't worry too much. It's a sort of cheap effect, in appearance if not in implementation cost. For the rare cases you might want it you can always do any such animation yourself anyway, as suggested above... or just toggle Visible True/False and dispense with the gaucherie.
So at least anyone doing a search on AnimateWindow with VB6 in the future has another discussion and examples to find.
Using a simple API call you could get an animated version of Visible = True/False...
Ahh, I see - there's some kind of "blending-effect" in there...
But since Win8 the layered Alpha-Effects are available also for Child-Windows -
so it'd be quite easy to enhance any userdefined Control about a Property as shown below:
Code:
'------------------ Start of Alpha-Handling-Block -------------------
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal Color As Long, ByVal X As Byte, ByVal Alpha As Long) As Boolean
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd&, ByVal hWndInsertAfter&, ByVal X&, ByVal Y&, ByVal cx&, ByVal cy&, ByVal wFlags&) As Long
Private mAlpha As Double
Public Property Get Alpha() As Double
Alpha = mAlpha
End Property
Public Property Let Alpha(ByVal RHS As Double)
If RHS < 0 Then RHS = 0 Else If RHS > 1 Then RHS = 1
If mAlpha = RHS Then Exit Property Else mAlpha = RHS
Const GWL_EXSTYLE = -20, WS_EX_LAYERED = &H80000, LWA_ALPHA = 2
SetWindowLong hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes hWnd, RGB(255, 255, 0), mAlpha * 255, LWA_ALPHA
Const SWP_NOSIZE = 1, SWP_NOMOVE = 2, SWP_NOZORDER = 4, SWP_FRAMECHANGED = &H20
SetWindowPos hWnd, 0, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_FRAMECHANGED
End Property
'------------------ End of Alpha-Handling-Block -----------------