VB6 - Rendre une forme transparente

Introduction

• Sur l'ensemble de la forme, contrôles constituants compris, suivant un ratio
• Le fond de la forme invisible et les contrôles constituants suivant un ratio

Restriction

Dans un module

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 Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bDefaut As Byte, ByVal dwFlags As Long) As Long

Private Const GWL_EXSTYLE       As Long = (-20)
Private Const LWA_COLORKEY      As Long = &H1
Private Const LWA_Defaut         As Long = &H2
Private Const WS_EX_LAYERED     As Long = &H80000

'
Public Function Transparence(ByVal hWnd As Long, Optional ByVal Coul As Long = vbBlack, _
    Optional ByVal PcTransp As Byte = 255, Optional ByVal TrMode As Boolean = True) As Boolean
' Retourne : True s'il n'y a pas eu d'erreur.
' hWnd   : hWnd de la fenêtre à rendre transparente
' Coul : Couleur à rendre transparente si TrMode=False
' PcTransp  : 0 à 255 >> 0 = transparent  -:- 255 = Opaque
Dim VoirStyle As Long
    On Error GoTo Sortie
    VoirStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
    If VoirStyle <> (VoirStyle Or WS_EX_LAYERED) Then
        VoirStyle = (VoirStyle Or WS_EX_LAYERED)
        Call SetWindowLong(hWnd, GWL_EXSTYLE, VoirStyle)
    End If
    Transparence = (SetLayeredWindowAttributes(hWnd, Coul, PcTransp, IIf(TrMode, LWA_COLORKEY Or LWA_Defaut, LWA_COLORKEY)) <> 0)
    
Sortie:
    If Not Err.Number = 0 Then Err.Clear
End Function

Public Sub ActiveTransparence(M As Form, d As Boolean, F As Boolean, _
     T_Transparence As Integer, Optional Couleur As Long)
Dim B As Boolean
        If d And F Then
        'Rend la couleur (ici la couleur du fond de la forme) transparente
        'au taux de T_Transparence
            B = Transparence(M.hWnd, Couleur, T_Transparence, False)
        ElseIf d Then
            'Rend toute la forme, y compris les composants, transparente
            'au taux de T_Transparence
            B = Transparence(M.hWnd, 0, T_Transparence, True)
        Else
            'Restaure la forme opaque.
            B = Transparence(M.hWnd, , 255, True)
        End If
End Sub

Exemple dans une forme

Private Sub Form_Load()
Dim i As Integer
    'Ex: tout transparent à 140/255ème
    'ActiveTransparence Me, True, False, 140, Me.BackColor
    'Ex: Forme transparent, composant visible à 140/255ème
    'ActiveTransparence Me, True, True, 140, Me.BackColor
    
    'Exemple d'affichage de la forme par gradation de la transparence
    ActiveTransparence Me, True, False, 0
    Me.Show
    For i = 0 To 255 Step 3
        ActiveTransparence Me, True, False, i
        Me.Refresh
    Next i
End Sub