Visual Basic Window/Form Routines
SetLayeredWindowAttributes: Fading a Form In/Out
     
Posted:   Monday May 10, 2004
Updated:   Monday December 26, 2011
     
Applies to:   VB4-16, VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   Windows 2000 or later
Author:   VBnet - Randy Birch
     

Related:  

FillRect: Gradient Form Backgrounds
GradientFill: Gradient Form Backgrounds
GradientFill: Triangular Gradient Form Backgrounds
Pure VB: Tile an Image as a Form Background
     
 Prerequisites
Windows 2000 or later.

This is a pretty straightforward method to use SetLayeredWindowAttributes to create a form - ie. a splash screen - that fades in and/or out instead of just appearing on screen.

The method uses a timer on the form to fade in (I'll call it the dialog), as well as a custom sub declared Public allowing the pre-configuration of the effect(s) desired - fade in, fade out, fade in/out, or show normally (no fade).  The code handles both modal or non-modal dialogs.

Before a form can use SetLayeredWindowAttributes it must first change the window style of the form using Get/SetWindowLong. Once the WS_EX_LAYERED style is applied, VB's normal show command will not display the form requiring one or more calls to SetLayeredWindowAttributes to make the form visible.

All the code to cause the transparency for the dialog form is contained in the form itself.  The DialogAction sub, called prior to issuing the show command, accepts a flag indicating the type of fading required and initializes the form as required.

The calling form simply sets the appropriate settings for the dialog's 'DialogAction' sub, then calls the show command specifying modal or non-modal as determined by the checkbox.

Transparency is determined by a Long value passed to SetLayeredWindowAttributes as its alpha parameter, and can range from 0 (totally transparent) to 255 (totally opaque). While the form is in its transition state (any value between 1 and 254) it is responsive to mouse and keyboard action.  This contrasts the behaviour of a form having the WS_EX_TRANSPARENT style bit set.

The timer is responsible for calculating the next appropriate fade value, and applying it via a call to SetLayeredWindowAttributes. Once the upper or lower limit of the alpha member is reached, the timer terminates ensuring the form has reached its final visibility state.

In addition to (or instead of) various transparency stages for the entire form, this API also provides for creating 'knock-outs' of a specific colour by specifying the LWA_COLORKEY flag. The demo illustration here shows a form with several different controls present, simply for effect (they are not required for the demo). One of those controls is the red Shape control; in testing with the LWA_COLORKEY flag applied and with the clrref member of SetLayeredWindowAttributes set to the colour of the shape, the call resulted in a hole where the shape was. Clicking inside this hole activated the window showing through the transparent hole. Note that while you can specify 'LWA_ALPHA Or LWA_COLORKEY' as the dwFlags member of SetLayeredWindowAttributes to achieve a semi-transparent form with a knockout, you can not specify the opacity of the knockout area itself.

 BAS Module Code
None.

 Form 1 Code (control form)
Add a form containing four command buttons (Command1 - Command4) and a checkbox along with the following code:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()

   Command1.Caption = "Show normally"
   Command2.Caption = "Show w/fade in"
   Command3.Caption = "Show w/fade out"
   Command4.Caption = "Show w/fade in/out"
   Check1.Caption = "As modal form"
   
End Sub


Private Sub Command1_Click()

   With Form2
      .DialogAction fadeNone
      .Show Abs(Check1.Value = vbChecked)
   End With
   
End Sub


Private Sub Command2_Click()

   With Form2
      .DialogAction fadeIn
      .Show Abs(Check1.Value = vbChecked)
   End With
   
End Sub


Private Sub Command3_Click()

   With Form2
      .DialogAction fadeOut
      .Show Abs(Check1.Value = vbChecked)
   End With
   
End Sub


Private Sub Command4_Click()

   With Form2
      .DialogAction fadeInOut
      .Show Abs(Check1.Value = vbChecked)
   End With
   
End Sub
 Form2 Code (dialog)
Add the following code to Form2 (the form to which transparency is to be applied). This form requires only a command button (Command1) and a Timer control (Timer1) - the other controls shown in the illustration are for demo purposes only:

Option Explicit
Public Enum dlgShowActions
   fadeNone = 0
   fadeIn = 1
   fadeOut = 2
   fadeInOut = 3
End Enum

Private unloadAction As dlgShowActions
Private fadeMode As dlgShowActions
Private winstyle As Long

Private Const GWL_EXSTYLE As Long = (-20)
Private Const WS_EX_RIGHT As Long = &H1000
Private Const WS_EX_LEFTSCROLLBAR As Long = &H4000
Private Const WS_EX_LAYERED As Long = &H80000
Private Const WS_EX_TRANSPARENT = &H20&
Private Const LWA_COLORKEY As Long = &H1
Private Const LWA_ALPHA As Long = &H2

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 Long, _
   ByVal dwFlags As Long) As Long



Private Sub Form_Load()

   Command1.Caption = "Close"
   
End Sub


Private Sub Command1_Click()

   Unload Me
   
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

  'if the user presses the close button
  'and the 'out' mode is fade, cancel
  'the close and instead invoke the
  'timer to cause the fade.
  '
  'The timer code changes the unloadAction
  'value to prevent this check from executing
  'again when the timer code issues the
  'Unload command.
   If ((UnloadMode = vbFormControlMenu) Or _
       (UnloadMode = vbFormCode)) And _
       (unloadAction = fadeOut) Or _
       (unloadAction = fadeInOut) Then

      Cancel = True

      fadeMode = fadeOut
      Timer1.Interval = 20
      Timer1.Enabled = True

   End If
   
End Sub


Private Sub Timer1_Timer()

   Static fadeValue As Long
   Dim alpha As Long
   
   Select Case fadeMode
   
      Case fadeOut:
      
        'prevents the form's QueryUnload sub
        'from stopping the unloading of the
        'form via code here
         unloadAction = 0
      
         If (fadeValue + (256 * 0.05)) >= 256 Then
             
            'done, so reset the fadeValue to
            'allow for fading out if required
             Timer1.Enabled = False
             fadeValue = 0
             Unload Me
             Exit Sub
         End If
         
         fadeValue = fadeValue + (256 * 0.05)
         alpha = (256 - fadeValue)
      
      Case fadeIn:
      
         If (fadeValue + (256 * 0.05)) >= 256 Then
            'done, but one more call to
            'SetLayeredWindowAttributes is
            'required to set the final opacity to 255
             Timer1.Enabled = False
             fadeValue = 0
             alpha = 255
         Else
            fadeValue = fadeValue + (256 * 0.05)
            alpha = fadeValue
         End If
      
      Case Else
   End Select

   SetLayeredWindowAttributes Me.hwnd, 0&, alpha, LWA_ALPHA
   
End Sub


Private Function AdjustWindowStyle()

   Dim style As Long

  'in order to have transparent windows, the
  'WS_EX_LAYERED window style must be applied
  'to the form
   style = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
   
   If Not (style And WS_EX_LAYERED = WS_EX_LAYERED) Then
      
      style = style Or WS_EX_LAYERED
      SetWindowLong Me.hwnd, GWL_EXSTYLE, style
      
   End If
    
End Function


Public Sub DialogAction(dlgEffectsMethod As dlgShowActions)
   
   Dim alpha As Long

  'alpha=0: window transparent
  'alpha=255: window opaque
 
   Select Case dlgEffectsMethod
   
      Case fadeNone  'show 'normally'
        'nothing to do, so exit and let
        'the calling routine's Show command
        'control the display
         Exit Sub
      
      Case fadeOut 'show normally but prepare for a fade out
      
        'this requires changing the window style
        'and calling SetLayeredWindowAttributes once
        'specifying a value of opaque (255). To
        'cause the form to fade out, an 'unloadAction'
        'flag is set
         unloadAction = dlgEffectsMethod
         Call AdjustWindowStyle
         alpha = 255
         SetLayeredWindowAttributes Me.hwnd, 0&, alpha, LWA_ALPHA
      
      Case fadeIn, fadeInOut 'show form by fading in
      
        'just adjust the window style and
        'use a timer to fade the window in
         Call AdjustWindowStyle
         fadeMode = fadeIn
         Timer1.Interval = 20
         Timer1.Enabled = True
         
        'but ... if the effect mode is
        'to fade in/out, set the unloadAction
        'flag
         If dlgEffectsMethod = fadeInOut Then unloadAction = fadeOut
         
   End Select
   
End Sub
 Comments

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

 

Hit Counter