Add Disappearing Effect To Your Forms

I use it on my startup forms. This code demonstrates the use of SetLayeredWindowAttributes, GetWindowLong & SetWindowLong API calls. You need a timer on the form called "Timer1". Timer1 is enabled by default, so with the Load Event of the form it'll start ticking....

It'll make the form more transparent with each tick. 255 means no transparency, 0 means 100% transparent. When the form is 100% transparent Timer1 will unload it and load the "Main" form (I assume frmMain is the Main Form or any form you want to show after unloading it).

The only problem with this code is that Windows98 & ME does not support SetLayeredWindowAttributes API, so it won't work on these Operating Systems. You can use GetVersionEx API to determine the OS Version....

Copy the code below in the form you want to add the effect to.

Option Explicit

Dim Trans As Integer
Private Const LWA_COLORKEY = 1
Private Const LWA_ALPHA = 2
Private Const LWA_BOTH = 3
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = -20

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 _
	"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
	ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
	"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Sub SetTrans(hwnd As Long, Trans As Integer)
   Dim Tcall As Long
   Tcall = GetWindowLong(hwnd, GWL_EXSTYLE)
   SetWindowLong hwnd, GWL_EXSTYLE, Tcall Or WS_EX_LAYERED
   SetLayeredWindowAttributes hwnd, RGB(255, 255, 0), Trans, LWA_ALPHA
   Exit Sub
End Sub

Private Sub Form_Load()
   frmMain.Show
   frmMain.Enabled = False
   Timer1.Interval = 1
   Trans = 255
   SetTrans Me.hwnd, Trans
End Sub

Private Sub Timer1_Timer()
   If Trans <> 0 Then
       Trans = Trans - 1
   End If
   SetTrans Me.hwnd, Trans
   If Trans = 0 Then
   frmMain.Enabled = True
       Unload Me
   End If
End Sub