Effet de transparence

Soyez le premier à donner votre avis sur cette source.

Vue 7 230 fois - Téléchargée 646 fois

Description

Affichage d'une fenêtre avec un effet de transparence

Source / Exemple :


'------------------------- API's -------------------------
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 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
  
Private Declare Function UpdateWindow Lib "user32" _
(ByVal hwnd As Long) As Long

Private Const GWL_EXSTYLE As Long = (-20)
Private Const WS_EX_LAYERED As Long = &H80000
Private Const LWA_ALPHA As Long = &H2

Private OpApplied As Byte     'Opacité appliquée

'------------------------- Events ------------------------

Private Sub Form_Load()

  'Opacité initiale de 0 (100% de transparence)
  'pour éviter un artefact visuel.
  Call SetTransparency(Me.hwnd, 0)
  'Largeur minimum (commande "Print on click")
   If Me.Width < 5160 Then Me.Width = 5160
   
End Sub

Private Sub Form_Activate()

  'Affichage de la feuille avec effet de transparence
  'et une raison de progression (Offset) de 1.
  Call setFadeIn(Me.hwnd, 1)
  
End Sub

Private Sub Command1_Click()

  'Crée un effet de transparence
  Call SetTransparency(Me.hwnd, 127)
  'Affiche le pourcentage de transparence
  Print vbCr & Space(6) & "Pourcentage de transparence : 100 - ((127/255)*100) = 50,2%"
  Command1.Enabled = False
  
End Sub

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

  'Effacement de la feuille avec effet de transparence
  'et une raison de progression (Offset) de 3.
  Call setFadeOut(Me.hwnd, 3)
  
End Sub

'---------------------- Procedures -----------------------

Sub setFadeIn(lngHWnd As Long, Offset As Byte)

  Dim Attrib As Long
  Dim Opacity As Byte
  
  If 255 Mod Offset = 0 Then
    Attrib = GetWindowLong(lngHWnd, GWL_EXSTYLE)
    Call SetWindowLong(lngHWnd, GWL_EXSTYLE, Attrib Or WS_EX_LAYERED)
    Do
      Call SetLayeredWindowAttributes(lngHWnd, RGB(0, 0, 0), Opacity, LWA_ALPHA)
      Call UpdateWindow(lngHWnd)
      Opacity = Opacity + Offset
    Loop While Opacity <= 255 - Offset
  Else
    Call MsgBox(vbCr & "Valeur incorrecte !" & vbCr & vbCr & _
                       "Veuillez choisir un diviseur de 255 (1, 3, 5, 15, 17 etc.)" & Space(12) & vbCr & _
                       "comme raison de la progression arithmétique.", vbExclamation, " Affichage progressif (alpha blending)")
    Call SetLayeredWindowAttributes(lngHWnd, RGB(0, 0, 0), 255, LWA_ALPHA)
  End If
  
End Sub

Sub SetTransparency(lngHWnd As Long, Opacity As Byte)

  Dim Attrib As Long
  Dim RetVal As Boolean

  Attrib = GetWindowLong(lngHWnd, GWL_EXSTYLE)
  Call SetWindowLong(lngHWnd, GWL_EXSTYLE, Attrib Or WS_EX_LAYERED)
  RetVal = SetLayeredWindowAttributes(lngHWnd, RGB(0, 0, 0), Opacity, LWA_ALPHA)
  OpApplied = Opacity
  If Not RetVal Then
    Call MsgBox(vbCr & "Echec fonctionnel !" & vbCr & vbCr & _
                       "Pour information, l'API ""SetLayeredWindowAttributes"" est implémenté" & Space(12) & vbCr & _
                       "depuis la version 2000 de Windows et n'est pas supporté par Win9x/ME.", vbCritical, " Effet de transparence (alpha blending)")
    End
  End If
   
End Sub

Sub setFadeOut(lngHWnd As Long, Offset As Byte)

  Dim Attrib As Long
  Dim Opacity As Byte
  
  If 255 Mod Offset = 0 Then
    Attrib = GetWindowLong(lngHWnd, GWL_EXSTYLE)
    
    Call SetWindowLong(lngHWnd, GWL_EXSTYLE, Attrib Or WS_EX_LAYERED)
    'A cause du bouton "Command1"
    Opacity = IIf(OpApplied > 0, OpApplied - (OpApplied Mod Offset), 255)
    Do
      Call SetLayeredWindowAttributes(lngHWnd, RGB(0, 0, 0), Opacity, LWA_ALPHA)
      Call UpdateWindow(lngHWnd)
      Opacity = Opacity - Offset
    Loop While Opacity > 0
  Else
    Call MsgBox(vbCr & "Valeur incorrecte !" & vbCr & vbCr & _
                       "Veuillez choisir un diviseur de 255 (1, 3, 5, 15, 17 etc.)" & Space(12) & vbCr & _
                       "comme raison de la progression arithmétique.", vbExclamation, " Effacement progressif (alpha blending)")
  End If
  
End Sub

'---------------------------------------------------------

Conclusion :


Tous niveaux

Copier le code source dans une feuille "Form1" comprenant un bouton "Command1".

Codes Sources

A voir également

Ajouter un commentaire Commentaires
PROTEUS91
Messages postés
156
Date d'inscription
mardi 4 novembre 2003
Statut
Membre
Dernière intervention
28 décembre 2010

30 avril 2009 à 13:00
Même si le code est une copie. Le fait de l'avoir mis ici permet a des gens de trouver plus facilement un code précis. Cependant il est clair qu'il reste important de citer les personnes chez qui on a emprunter les dits codes !

Merci pour avoir mis cette source ici je l'ai adapté a mes besoin.

++
FENETRES
Messages postés
196
Date d'inscription
jeudi 15 juillet 2004
Statut
Membre
Dernière intervention
14 avril 2009

19 juil. 2004 à 10:35
Bibliographie : msdn !
cs_sam013
Messages postés
75
Date d'inscription
samedi 27 mars 2004
Statut
Membre
Dernière intervention
4 juillet 2005

17 juil. 2004 à 11:15
copieur ! vous voulez pas le dire ! j'le dit ! nah ! loool
Scalpweb
Messages postés
1467
Date d'inscription
samedi 13 mars 2004
Statut
Membre
Dernière intervention
5 mai 2010
4
16 juil. 2004 à 19:09
C'est clair.... Vraiment dommage.
darthpolor_I
Messages postés
57
Date d'inscription
mercredi 28 avril 2004
Statut
Membre
Dernière intervention
14 juillet 2008

16 juil. 2004 à 18:29
tiens c'est bizarre, ca me rappelle une source que j'avais trouvé sur le net où il avait les memes variables et tout...

dommage...

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.