AnimateWindow broken post-XP?

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:

Attachment 147935


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:

Attachment 147937

Surely there is a better alternative though? The gyrations I'm going through seem beyond unnecessary.

The "AnimateWindow Broken" project doesn't work on my Win7 32bit either.
I get the same black window in on the form.

Looks broken for me on XP SP3? Tried in Classic style and XP style, but I get the black UC.

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.

Well that is useful feedback.

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.

Quote:

---

Originally Posted by jpbro

Minimizing/Restoring also redraws the UC on both XP and 10.

---

That works because at that point the UserControl is Visible = True, and restoring does a fresh paint request to the control.

The AnimateWindows is a fancy version of Visible = False/True.

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.

I'm not sure there is a real fix.

It seems as if a PictureBox, UserControl, and probably others simply always give a "black rectangle" when the get WM_PRINT when they are not visible.

A TextBox, etc. are different in the way they respond to WM_PRINT.


Here is one more, same as 4 more or less with most of its problems. But it saves as PNG which means the compiled EXE is at least a bit smaller.

Basically AnimateWindow is pretty useless in VB6 programs. Sort of a goofy thing anyway.

If you really want this action then rely on "fix 2" and render your entire UI.

Ok, taking that idea I'll just use the controls on the UserControl to hold things. For example positions, colors, and aux images.

Here's a result that works, is dynamic (new Caption property can change at run time), and shows off another weird effect.

Ahh, my crusty, trusty Drawing class! ;)

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:
http://vbRichClient.com/Downloads/Easing.png

HTH

Olaf

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):

https://web.archive.org/web/20050205...tewindow.shtml

Add this to the very lengthy list of "UI challenges faced by VB6 developers"...

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.

I forget what else forwarding WM_PRINT to WM_PAINT fixes...

Quote:

---

Originally Posted by dilettante

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 -----------------

---

WIth that in place, you can extend the Easing-Functions also to that Property...
(I've shown a complete Animation-example in a new CodeBank-Entry):
http://www.vbforums.com/showthread.p...AnimateWindow)

Olaf