Угасающая анимация - плавное появление и исчезание картинки - VB

Формулировка задачи:

Добрый день всем. Подскажите пример угасающей анимации форма с картинкой плавно появляется и плавно затухает. Нашел вот это, но с привязкой к osenxpsuite2010.ocx. Минус в том, что он платный..

Private Sub Form_Activate()
 
    FadeIn Me.hWnd
    WaitTimes 2000
    FadeOut Me.hWnd
    'WaitTimes 2000
    Unload Me
    
End Sub
 
Private Sub Form_Load()
    
     CreateFormSkin Me, LoadPicture("d:\Dropbox\VB_Project\Project_29\SkyrimLoader\Actaul_TEST_Build ГґГґ\SplashScreen\mynwind2005.bmp"), vbWhite
End Sub
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    MoveForm hWnd, Button
End Sub

пример...https://youtu.be/2BXhSApNjn8

Решение задачи: «Угасающая анимация - плавное появление и исчезание картинки»

textual
                            Листинг программы 
                        

                            Option Explicit
 
Private Declare Function UpdateLayeredWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, ByVal crKey As Long, pblend As Long, ByVal dwFlags As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE As Long = -20
Private Const ULW_ALPHA = &H2
Private Const AB_32Bpp255 = 33488896
 
Dim WithEvents tmrTimer As Timer
 
Private Sub Form_Load()
    Set tmrTimer = Controls.Add("VB.Timer", "tmrTimer")
    tmrTimer.Interval = 32
    SetWindowLong Me.hwnd, GWL_EXSTYLE, GetWindowLong(Me.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
 
End Sub
 
Private Sub tmrTimer_Timer()
    Static sz As Currency, pt As Currency, fr As Long
    
    sz = (Me.ScaleWidth + CCur(Me.ScaleHeight) * 4294967296#) / 10000
    UpdateLayeredWindow Me.hwnd, Me.hDC, pt, sz, Me.hDC, pt, 0, &H1000000 Or fr, ULW_ALPHA
    
    fr = (fr + &H20000) And &HFF0000
    
End Sub
                        