Fade In Effect when load

Hello, I need to make a code for my app, to fade in when it loads and then fade out when it unloads!

Or something similar to MSN's Messengers Fade in/out!
Can anyone help me?

VB Code:

Option Explicit
 
Const VER_PLATFORM_WIN32s = 0
Const VER_PLATFORM_WIN32_WINDOWS = 1
Const VER_PLATFORM_WIN32_NT = 2
 
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion      As Long
    dwMinorVersion      As Long
    dwBuildNumber       As Long
    dwPlatformId        As Long
    szCSDVersion        As String * 128
End Type
 
 
Private Declare Function GetVersionEx Lib "kernel32" Alias _
    "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
 
'hWnd    - handle to window to layer.
'crKey   - specifies the color key
'bAlpha  - value for the blend function
'dwFlags - action
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 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 Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1&
Private Const LWA_ALPHA = &H2&
 
Private Declare Function GetParent Lib "user32" _
    (ByVal hWnd As Long) As Long
    
Private Declare Function IsWindowVisible Lib "user32" _
    (ByVal hWnd As Long) As Long
 
Private Function fGetOSVersion()
Dim os As OSVERSIONINFO
'
' Returns True if Win98 or Win2000
'
fGetOSVersion = False
With os
    .dwOSVersionInfoSize = Len(os)
    Call GetVersionEx(os)
 
    ' Windows 2000
    If .dwMajorVersion > 4 Then fGetOSVersion = True
 
    If .dwMajorVersion = 4 And _
       .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
       .dwMinorVersion > 0 Then
        fGetOSVersion = True
    End If
End With
End Function
 
Private Function fSetTranslucency(ByVal hWnd As Long, ByVal alpha As Byte) As Boolean
Dim lStyle As Long
 
'
' Layering only works with Win2K or above.
'
If fIsWin2000 Then
    '
    ' Only a top level window can be translucent.
    '
    hWnd = fGetTopLevel(hWnd)
    '
    ' Make the window translucent by setting its
    ' extended style.
    '
    lStyle = GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    If SetWindowLong(hWnd, GWL_EXSTYLE, lStyle) Then
        fSetTranslucency = CBool(SetLayeredWindowAttributes(hWnd, 0, CLng(alpha), LWA_ALPHA))
    End If
End If
End Function
 
Private Function fClearTranslucency(ByVal hWnd As Long) As Boolean
Dim lStyle As Long
 
'
' Layering only works with Win2K or above.
'
If fIsWin2000 Then
    '
    ' Only a top level window can be translucent.
    '
    hWnd = fGetTopLevel(hWnd)
    '
    ' Clear translucency - make the window opaque.
    '
    Call SetLayeredWindowAttributes(hWnd, 0, 255&, LWA_ALPHA)
    '
    ' Clear the extended style bit.
    '
    lStyle = GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_LAYERED
    fClearTranslucency = CBool(SetWindowLong(hWnd, GWL_EXSTYLE, lStyle))
End If
End Function
 
 
Private Function fIsWin2000() As Boolean
Dim os As OSVERSIONINFO
'
' Returns True if Win98 or Win2000
'
fIsWin2000 = False
With os
    .dwOSVersionInfoSize = Len(os)
    Call GetVersionEx(os)
 
    ' Windows 2000
    If .dwPlatformId = VER_PLATFORM_WIN32_NT Then
        fIsWin2000 = (.dwMajorVersion > 4)
    End If
End With
 
End Function
 
Private Function fGetTopLevel(ByVal hChild As Long) As Long
Dim hWnd As Long
 
hWnd = hChild
Do While IsWindowVisible(GetParent(hWnd))
    hWnd = GetParent(hChild)
    hChild = hWnd
Loop
fGetTopLevel = hWnd
End Function

And the next code would go in your form load statement

VB Code:

Private Sub Form_Load()
Dim x As Integer
'Set it to 0 so its transparent.
Call fSetTranslucency(Me.hWnd, 0)
' Try values between 0 (completely invisible)
' to 255 (fully opaque).
'
For x = 0 to 255 
  Call fSetTranslucency(Me.hWnd, x)
Next x
 
End Sub

Try That

Now that is cool! :thumb:
I had to make one change however; move the loop to the form's Activate event and add a DoEvents call

VB Code:

Private Sub Form_Activate()
 Dim X As Long
 Static Activated As Boolean
 If Activated Then Exit Sub
 Activated = True
 For X = 1 To 255 Step 2
  Call fSetTranslucency(Me.hWnd, X)
  DoEvents
 Next X
End Sub

Glad you liked it. You can also do the same in the Unload event of the form. Just step backwards with it. I used a seperate variable for that.

VB Code:

Private Sub Form_Unload()
Dim x As Integer
Dim i As Integer
i = 255
For x = 1 To 255 
  i = i - 1
  Call fSetTranslucency(Me.hWnd, i)
  DoEvents
 Next x
End Sub

Thank you zalez for your code! It works fine! I rated your post , because i liked it a lot!
:) :) :) :) :)

Magnificent.

If there is code in your FORM_LOAD, add the following line at the end of the FORM_LOAD Sub:

Call fSetTranslucency(Me.hwnd, 0)

This will prevent the form from blinking before a fade in

Here's another way:

In a code module

Code:

---

Option Explicit

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 Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
'Requires Windows 2000 or later:
Private Const WS_EX_LAYERED = &H80000

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, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2

Public Sub MakeWindowTransparent(ByVal hWnd As Long, ByVal alphaAmount As Byte)
    Dim lStyle As Long
   
    lStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
    lStyle = lStyle Or WS_EX_LAYERED
    SetWindowLong hWnd, GWL_EXSTYLE, lStyle
    SetLayeredWindowAttributes hWnd, 0, alphaAmount, LWA_ALPHA
End Sub

---

In the form

Code:

---

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Form_Load()
  Dim iX As Long
  For iX = 10 To 255 Step 10
      MakeWindowTransparent Me.hWnd, iX
      Me.Show
      DoEvents
      Sleep 200
  Next

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Dim iX As Long
  For iX = 255 To 0 Step -10
      MakeWindowTransparent Me.hWnd, iX
      DoEvents
      Sleep 200
  Next

End Sub

---