Quand setlayeredwindowattributes rencontre timer...

Soyez le premier à donner votre avis sur cette source.

Vue 7 341 fois - Téléchargée 448 fois

Description

On sait gérer la transparence des formulaires: avec la fonction SetLayeredWindowAttributes().
Associé à un Timer, on obtient un effet d'animation que l'on retrouve sur XP lors d'introductions.

-Copiez le code ci-dessous et enregistrez-le sous FrmTranspa.frm
-double-cliquez dessus,
-Dans VB, appuyez sur F5!

Source / Exemple :


VERSION 5.00
Begin VB.Form FrmTranspa 
   BackColor       =   &H00404040&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "FrmTranspa"
   ClientHeight    =   4710
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6975
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4710
   ScaleWidth      =   6975
   StartUpPosition =   2  'CenterScreen
   Begin VB.ListBox List2 
      BackColor       =   &H00404040&
      ForeColor       =   &H00E0E0E0&
      Height          =   3570
      Left            =   4920
      TabIndex        =   6
      Top             =   360
      Width           =   1455
   End
   Begin VB.ListBox List1 
      BackColor       =   &H00404040&
      ForeColor       =   &H00E0E0E0&
      Height          =   3570
      Left            =   3360
      TabIndex        =   5
      Top             =   360
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Quitter"
      Height          =   375
      Left            =   480
      TabIndex        =   0
      Top             =   3360
      Width           =   1575
   End
   Begin VB.Timer TimerStart 
      Enabled         =   0   'False
      Interval        =   20
      Left            =   480
      Top             =   2400
   End
   Begin VB.Timer TimerQuit 
      Enabled         =   0   'False
      Interval        =   20
      Left            =   960
      Top             =   2400
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      ForeColor       =   &H00008000&
      Height          =   255
      Index           =   3
      Left            =   480
      TabIndex        =   4
      Top             =   1440
      Width           =   1335
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      ForeColor       =   &H00008000&
      Height          =   255
      Index           =   2
      Left            =   480
      TabIndex        =   3
      Top             =   1080
      Width           =   1335
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      ForeColor       =   &H00008000&
      Height          =   255
      Index           =   1
      Left            =   480
      TabIndex        =   2
      Top             =   720
      Width           =   1335
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      ForeColor       =   &H00008000&
      Height          =   255
      Index           =   0
      Left            =   480
      TabIndex        =   1
      Top             =   360
      Width           =   1335
   End
   Begin VB.Shape Shape3 
      Height          =   2055
      Left            =   120
      Shape           =   4  'Rounded Rectangle
      Top             =   2280
      Width           =   2655
   End
   Begin VB.Shape Shape2 
      BackColor       =   &H00404040&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H0080C0FF&
      Height          =   4215
      Left            =   2880
      Shape           =   4  'Rounded Rectangle
      Top             =   120
      Width           =   3975
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H00000000&
      BackStyle       =   1  'Opaque
      Height          =   2055
      Left            =   120
      Shape           =   4  'Rounded Rectangle
      Top             =   120
      Width           =   2655
   End
End
Attribute VB_Name = "FrmTranspa"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 Byte, ByVal dwFlags As Long) As Long

Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Const LWA_COLORKEY = &H1&
Const LWA_ALPHA = &H2&
Dim nx As Byte

Private Sub SetTransparence(hWnd As Long, Alpha As Byte)
    Dim Param As Long
    Param = GetWindowLong(hWnd, GWL_EXSTYLE)
    Call SetWindowLong(hWnd, GWL_EXSTYLE, Param Or WS_EX_LAYERED)
    Call SetLayeredWindowAttributes(hWnd, 0, Alpha, LWA_ALPHA)
End Sub

Private Sub Form_Load()
    Call SetTransparence(Me.hWnd, 0)
    nx = 0: TimerStart.Enabled = True
End Sub
Private Sub TimerStart_Timer()
    If nx <= 250 Then
        nx = nx + 5
        Call SetTransparence(Me.hWnd, nx)
    Else: TimerStart.Enabled = False
    End If
End Sub

Private Sub Command1_Click()
    nx = 255: TimerQuit.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
nx = 255: TimerQuit.Enabled = True
Cancel = 1
End Sub
Private Sub TimerQuit_Timer()
    If nx <= 37 Then
        End
    Else
        nx = nx - 5
        Call SetTransparence(Me.hWnd, nx)
    End If
End Sub

Conclusion :


Le byte Alpha dans SetTransparence() varie de 0 à 255 (255= opaque).

Pour changer la rapidité de la transition: modifier la propriété Interval du contrôle Timer.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
19
Date d'inscription
samedi 12 juin 2004
Statut
Membre
Dernière intervention
3 décembre 2007

Excellent code. Cela va bien me servir.

Merci .
Messages postés
126
Date d'inscription
samedi 24 avril 2004
Statut
Membre
Dernière intervention
6 janvier 2008

RATALA,
Mais si, mais si, c'est bien du VB6. Mais pas celui que tu connait, celui que le logiciel VB6 utilise pour coder ses Form. Donc tu ne panique pas, deux solution :
1) Demare le bloc-note, copie y le code de la form et enregistre le comme FrmTranspa.frm
2) Télécharge la source et decompresse la.
Dans les deux cas, tu peut utiliser ta form. Et sa marche.
Merci mythic_kruger!

Bonne prog a tous
Colin CHARGY
Messages postés
248
Date d'inscription
jeudi 3 février 2005
Statut
Membre
Dernière intervention
22 juin 2008

Heu c'est quoi comme langage ?
"Begin VB.Shape Shape2" ??? c'est quoi ca ??
En VB6 ca marche pas...
Messages postés
517
Date d'inscription
samedi 3 février 2001
Statut
Modérateur
Dernière intervention
24 octobre 2006
1
GUILLETO>
C simple, remplace tous les Call SetTransparence(Me.hWnd, nx) par Call SetTransparence(Picture1.hWnd, nx) ...
Messages postés
242
Date d'inscription
jeudi 8 janvier 2004
Statut
Membre
Dernière intervention
10 novembre 2005

Salut, le code est loin d'être parfait (pourquoi 2 contrôle Timer là ou un seul ferait l'affaire, de plus ce contrôle devrait être chargé dynamiquement dans le code, passons).
Guilleto c'est possible mais pas avec cette fonction. Il faut faire un recherche dans Codes & Forum sur le mot transition.
Afficher les 10 commentaires

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.