Option Explicit 

 'объявление API-функций и констант 
  Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _ 
                                                                             ByVal nIndex 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 SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, _ 
                                                                   ByVal crKey As Long, _ 
                                                                   ByVal bAlpha As Byte, _ 
                                                                   ByVal dwFlags As Long) As Long 
  Private Declare Function GetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, _ 
                                                                   ByRef crKey As Long, _ 
                                                                   ByRef bAlpha As Byte, _ 
                                                                   ByRef dwFlags As Long) As Long 
  Private Const GWL_STYLE = (- 16 ) 
  Private Const GWL_EXSTYLE = (- 20 ) 
  Private Const LWA_COLORKEY = &H1 
  Private Const LWA_ALPHA = &H2 
  Private Const WS_EX_LAYERED = &H80000 
   
   
  'Создание прозрачности у окна 
  Public Sub SetOpacity(hWnd As Long, opacity As Byte) 
   If opacity <  254  Then 'если значение opacity меньше 254, то добавляем к окну прозрачность 
     Dim lStyle As Long 
     lStyle = GetWindowLong(hWnd, GWL_EXSTYLE) 'стиль окна 
     lStyle = lStyle Or WS_EX_LAYERED 'делаем его слоистым 
     SetWindowLong hWnd, GWL_EXSTYLE, lStyle 'обновляем стиль 
     SetLayeredWindowAttributes hWnd,  0 , opacity, LWA_ALPHA 'устанавливаем прозрачность 
   Else 'в любом другом случае 
     SetWindowLong hWnd, GWL_EXSTYLE,  0  'устанавливаем обычные атрибуты окна 
   End If 
 End Sub 

 'Получение прозрачности окна 
 Public Function GetOpacity(hWnd As Long) As Byte 
   Dim opacity As Byte 
   Dim lStyle As Long 
   lStyle = GetWindowLong(hWnd, GWL_EXSTYLE) 'стиль окна 
   If (lStyle And WS_EX_LAYERED) =  0  Then 'является ли окно слоистым. 
     'Если нет, то возвращаем значение 255 
     lStyle = lStyle Or WS_EX_LAYERED 
     GetOpacity =  255  
   Else 'Если да, то возвращаем его прозрачность 
     Call GetLayeredWindowAttributes(hWnd,  0 , opacity,  0 ) 
     GetOpacity = opacity 
   End If 
 End Function

Option Explicit 
 Private opacity As Byte 'Прозрачность окна 
 Private Const FADING_STEP As Byte =  8  'Скорость изменения прозрачности 

 'Открытие формы 
 Private Sub Form_Initialize() 
   opacity =  0  
   Call ApiModule.SetOpacity(Me.hWnd, opacity) 
   FadingTimer.Tag = "Appear" 
   FadingTimer.Enabled = True 
 End Sub 

 'Закрытие формы 
 Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) 
   opacity =  254  
   FadingTimer.Tag = "Fade" 
   FadingTimer.Enabled = True 
   Cancel = ApiModule.GetOpacity(Me.hWnd) 
 End Sub 

 Private Sub FadingTimer_Timer() 
   Select Case FadingTimer.Tag 
     Case "Fade" 
       Call Fade 
     Case "Appear" 
       Call Appear 
   End Select 
 End Sub 

 'Затухание формы 
 Private Sub Fade() 
   If opacity >= FADING_STEP Then 
     opacity = opacity - FADING_STEP 
   Else 
     opacity =  0  
   End If 
   Call ApiModule.SetOpacity(Me.hWnd, opacity) 
   If opacity =  0  Then Unload Me 
 End Sub 

 'Появление формы 
 Private Sub Appear() 
   If  255  - opacity < FADING_STEP Then 
     opacity =  255  
   Else 
     opacity = opacity + FADING_STEP 
   End If 
   Call ApiModule.SetOpacity(Me.hWnd, opacity) 
   FadingTimer.Enabled = Not (opacity =  255 ) 
 End Sub