|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
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 |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |