EFFETS DE FONDU ANIMÉS (TRANSPARENCE/OPACITÉ) SUR LES FENÊTRES

' MODULE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Option Explicit

' L'instruction Sleep pour faire une pause dans le prog
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

' Pour la transparence de la fenêtre
Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Boolean
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Const WS_EX_LAYERED = &H80000
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2
'renvoie les styles de la fenêtre
Public Const GWL_STYLE As Long = -16
'renvoie les styles étendus de la fenêtre
Public Const GWL_EXSTYLE As Long = -20
'renvoie la fenêtre propriétaire de la fenêtre
Public Const GWL_HWNDPARENT As Long = -8

' Active la transparence
Public Function ActiveTransparence(Fenêtre As Form, ByVal AlphaInit As Byte)
    On Error GoTo Err
    SetWindowLong Fenêtre.hWnd, GWL_EXSTYLE, GetWindowLong(Fenêtre.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    ChangeTransparence Fenêtre, AlphaInit
    Exit Function
Err:
End Function

' Change la transparence
Public Function ChangeTransparence(Fenêtre As Form, ByVal Alpha As Byte)
    On Error GoTo Err
    If Alpha = 0 Then DesactiveTransparence (Fenêtre): Exit Function
    SetLayeredWindowAttributes Fenêtre.hWnd, 0, Alpha, LWA_ALPHA
    Exit Function
Err:
End Function

' Supprime la transparence
Public Function DesactiveTransparence(Fenêtre As Form)
    On Error Resume Next
    SetWindowLong Fenêtre.hWnd, GWL_EXSTYLE, GetWindowLong(Fenêtre.hWnd, GWL_EXSTYLE) - WS_EX_LAYERED
End Function

' Fait un fondu de la fenêtre pour la faire disparaître
' Unload détermine si on décharge la fenêtre ou si on la cache juste
Public Function FonduHide(Fen As Form, ByVal UnloadInEnd As Boolean, ByVal AlphaInit As Integer)
    On Error GoTo PasXP
    Dim T As Integer
    ' Sinon on active la transparence
    ActiveTransparence Fen, AlphaInit
    ' Puis on augmente a chaque fois sa transparence
    For T = AlphaInit To 1 Step -5
        ChangeTransparence Fen, T
        Sleep 1
        DoEvents
    Next T
    If UnloadInEnd = True Then Unload Fen
    Exit Function
    ' Si on a pas XP
PasXP:
    If UnloadInEnd = True Then
        Unload Fen
    Else
        Fen.Visible = False
    End If
End Function

' Fait un fondu de la fenêtre pour la faire montrer
Public Function FonduShow(Fen As Form, ByVal AlphaFin As Integer)
    On Error GoTo PasXP
    Dim T As Integer
    ' Sinon on active la transparence mais la fenêtre est transparente a fond (donc invisible)
    ActiveTransparence Fen, 1
    Fen.Visible = True
    ' Puis on réduit a chaque fois sa transparence
    For T = 1 To AlphaFin Step 5
        ChangeTransparence Fen, T
        Sleep 1
        DoEvents
    Next T
    ' Puis si en final la fenêtre n'est plus transparente du tout (transparence à 255/255)
    ' alors on désactive la transparence
    If AlphaFin = 255 Then DesactiveTransparence Fen
    Exit Function
    ' Si on a pas XP
PasXP:
    Fen.Visible = True
End Function

' Change la transparence de la fenetre en faisant un fondu
Public Function FonduChange(Fen As Form, ByVal AlphaInit As Byte, ByVal AlphaFin As Byte)
    On Error GoTo PasXP
    Dim T As Long
    Dim Delta As Long
    Delta = IIf(AlphaInit - AlphaFin < 0, 5, -5)
    ' On active la transparence
    Fen.Visible = True
    ActiveTransparence Fen, AlphaInit
    ' Puis on réduit ou augmente a chaque fois sa transparence
    For T = AlphaInit To AlphaFin Step Delta
        ChangeTransparence Fen, T
        Sleep 1
        DoEvents
    Next T
    ' Si la fenêtre n'est plus transparente, on la désactive
    If AlphaFin = 255 Then DesactiveTransparence Fen
    ' Si on a pas XP
PasXP:
End Function

Télécharger le zip

22 novembre 2005 18:29:28 :

Ajout des mots clés

09 août 2006 15:30:52 :

ajout de l'api "AnimateWindow"