Ombrer tout les controles d'une feuille en dégradé (mis à jour)

Télécharger le projet
Commenter

Description

Cette petite source permet d'ombrer tout les contrôles contenu dans une feuille très simplement et rapidement. L'effet est assez sympathique avec une ombre dégradé selon la couleur de fond de la feuille.

En plus de cà, vous pouvez régler la largeur de l'ombre, l'intensité de celle-ci (opacité), la position de l'ombre par rapport au contrôle, exclure certains contrôles de la feuille pour ne pas les ombrer et appliquer l'ombre à n'importe quelle feuille dont vous passerez en argument à l'objet de tracé.

Le code a été mis à jour pour rajoutter quelques fonctionnalités, et pour le passage au objet. Je laisse cepandant l'ancien code à ceux qui ne veulent pas s'encombrer d'un module de classe. Cependant, le module de classe du projet permet une plus grande souplesse d'utilisation.

Je mets en ligne ce code bien que certaines propriétés de l'objet ne sont pas exploitées (elles le seront dans les prochaines mise à jour)

Source / Exemple : 


'====================================================================================================
'Nom du Programme : Ombrer controles
'Version : 1.0
'Auteur : Teillet nicolas
'Environnement de développement : Visual basic 6.0 (édition entreprise)
'Résumé : Exemple d'ombrage des contrôles d'une feuille
'====================================================================================================
'====================================================================================================
'Nom du fichier : FRM_PRINCIPALE.frm
'Crée le : 22/04/2004
'Rôle : feuille principale du programme
'====================================================================================================

'déclaration des fonctions API privées
'fonction permettant de déplacer le curseur courant
Private Declare Function MoveToEx Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long, _
lpPoint As POINTAPI) As Long

'fonction permettant de tracer une ligne
Private Declare Function LineTo Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long) As Long

'fonction permettant de créer un crayon
Private Declare Function CreatePen Lib "gdi32" ( _
ByVal nPenStyle As Long, _
ByVal nWidth As Long, _
ByVal crColor As Long) As Long

'fonction permettant de sélectionner un objet
Private Declare Function SelectObject Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal hObject As Long) As Long

'fonction permettant de détruire un objet crée
Private Declare Function DeleteObject Lib "gdi32" ( _
ByVal hObject As Long) As Long

'déclaration des types privés
Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type Couleur
    bleu As Long
    vert As Long
    rouge As Long
End Type

'déclaration des constantes privées
Private Const PS_SOLID = 0 'crayon solide

'déclaration des variables privées
Private LNG_ShadowWidth As Long 'largeur de l'ombre à tracer
Private LNG_ShadowOpacity As Long 'opacité de l'ombre à tracer

Private Function BlueValue(ByVal COL_Couleur As Long) As Integer

'==================================================================
'Permet d'obtenir la valeur bleu d'une couleur RGB spécifiée
'
'COL_Couleur : Couleur de type RGB
'
'Renvoie la valeur bleu de la couleur envoyé sous forme d'un entier
'Renvoie "-1" en cas d'erreur
'===================================================================

'on active la routine de traitement d'erreur
On Error GoTo erreur0

    'on renvoie les bits correspondants à la valeur rouge de la couleur : ceux du milieu
    BlueValue = Int(COL_Couleur / (256 ^ 2))
    
'la fonction est finie
Exit Function

'routine de traitement d'erreur
erreur0:
'Problème : On n'a pas pu retourner la valeur de bleu
'Solution : on renvoie une valeur d'erreur : "-1"

BlueValue = -1

End Function

Private Function GreenValue(ByVal COL_Couleur As Long) As Integer

'===================================================================
'Permet d'obtenir la valeur vert d'une couleur RGB
'
'COL_Couleur : Couleur de type RGB
'
'Renvoie la valeur vert de la couleur envoyé sous forme d'un entier
'Renvoie "-1" en cas d'erreur
'===================================================================

'on active la routine de traitement d'erreur
On Error GoTo erreur0

    'on renvoie les bits correspondants à la valeur rouge de la couleur : ceux du milieu à côté de ceux du bleu
    GreenValue = Int((COL_Couleur - BlueValue(COL_Couleur) * (256 ^ 2)) / 256)
    
'la fonction est finie
Exit Function

'routine de traitement d'erreur
erreur0:
'Problème : On n'a pas pu retourner la valeur de vert
'Solution : on renvoie une valeur d'erreur : "-1"

GreenValue = -1

End Function

Private Function RedValue(ByVal COL_Couleur As Long) As Integer

'===================================================================
'Permet d'obtenir la valeur rouge d'une couleur RGB spécifiée
'
'COL_Couleur : Couleur de type RGB
'
'Revoie la valeur rouge de la couleur envoyé sous forme d'un entier
'Renvoie -1 en cas d'erreur
'====================================================================

'on active la routine de traitement d'erreur
On Error GoTo erreur0

    'on renvoie les bits correspondants à la valeur rouge de la couleur : ceux de droite
    RedValue = Int(COL_Couleur - Val(BlueValue(COL_Couleur)) * (256 ^ 2) - Val(GreenValue(COL_Couleur)) * Val(256))
    
'la fonction est finie
Exit Function

'routine de traitement d'erreur
erreur0:
'Problème : On n'a pas pu retourner la valeur de rouge
'Solution : on renvoie une valeur d'erreur : "-1"

RedValue = -1

End Function

Private Sub PRO_Tracer_Ombre(ByVal LNG_BackColor As Long, ByVal LNG_Left As Long, ByVal LNG_Top As Long, ByVal LNG_Width As Long, ByVal LNG_Height As Long)

'==========================================================================
'Permet de tracer une ombre aux coordonnées spécifiée
'
'LNG_BackColor : couleur d'arrière plan
'LNG_Left : Coordonnée du bord gauche du contrôle à ombrer
'LNG_Top : Coordonnée du bord droit du contrôle à ombrer
'LNG_Width : Largeur du contrôle à ombrer
'LNG_Height : Hauteur du contrôle à ombrer
'==========================================================================

'on active la routine de traitement d'erreur
On Error Resume Next
'l'erreur etant minime, on continue l'éxécution normalement

'déclaration des variables privées
Dim INT_For1 As Integer 'stocke les valeurs de la boucle For->Next
Dim COL_Composante As Couleur 'stockes les composantes de couleurs d'arrière plan
Dim COL_Couleur As Couleur 'stocke la couleur à appliquer
Dim LNG_Handle_Crayon As Long 'stocke le handle du crayon pour le tracé
Dim PNT_Point As POINTAPI 'stocke les coordonnées du point lors d'un déplacement

    'initialisation des variables
    COL_Composante.bleu = BlueValue(LNG_BackColor)
    COL_Composante.rouge = RedValue(LNG_BackColor)
    COL_Composante.vert = GreenValue(LNG_BackColor)
    
    'on trace l'ombre ligne par ligne
    For INT_For1 = 1 To LNG_ShadowWidth
    
        'on crée un crayon de couleur désirée
        COL_Couleur.rouge = COL_Composante.rouge - Int(LNG_ShadowOpacity / INT_For1)
        COL_Couleur.vert = COL_Composante.vert - Int(LNG_ShadowOpacity / INT_For1)
        COL_Couleur.bleu = COL_Composante.bleu - Int(LNG_ShadowOpacity / INT_For1)
        If COL_Couleur.rouge < 0 Then COL_Couleur.rouge = 0
        If COL_Couleur.vert < 0 Then COL_Couleur.vert = 0
        If COL_Couleur.bleu < 0 Then COL_Couleur.bleu = 0
        If COL_Couleur.rouge > 255 Then COL_Couleur.rouge = 255
        If COL_Couleur.vert > 255 Then COL_Couleur.vert = 255
        If COL_Couleur.bleu > 255 Then COL_Couleur.bleu = 255
        LNG_Handle_Crayon = CreatePen(PS_SOLID, 1, RGB(COL_Couleur.rouge, COL_Couleur.vert, COL_Couleur.bleu))
        Call SelectObject(FRM_PRINCIPALE.hdc, LNG_Handle_Crayon)
        
        'on trace la ligne
        Call MoveToEx(FRM_PRINCIPALE.hdc, LNG_Left + INT_For1 - 1, LNG_Top + LNG_Height + INT_For1 - 1, PNT_Point)
        Call LineTo(FRM_PRINCIPALE.hdc, LNG_Left + LNG_Width + INT_For1 - 1, LNG_Top + LNG_Height + INT_For1 - 1)
        Call MoveToEx(FRM_PRINCIPALE.hdc, LNG_Left + LNG_Width + INT_For1 - 1, LNG_Top + INT_For1 - 1, PNT_Point)
        Call LineTo(FRM_PRINCIPALE.hdc, LNG_Left + LNG_Width + INT_For1 - 1, LNG_Top + LNG_Height + INT_For1)
        
        'on libère les ressources utilisées par le crayon
        DeleteObject (LNG_Handle_Crayon)
    
    Next INT_For1

End Sub

Private Sub PRO_Ombrer_Controles()

'========================================================================================
'Permet de lancer le calcul de l'ombre pour tout les contrôles de la feuille principale
'========================================================================================

'on active la routine de traitement d'erreur
On Error Resume Next
'l'erreur etant minime, on continue l'éxécution normalement

'déclaration des variables privées
Dim OBJ_For1 As Object 'stocke les valeurs de la boucle For->Next
Dim COL_Couleur_Feuille As Long 'stocke la couleur de fond de la feuille

    FRM_PRINCIPALE.Cls
    
    For Each OBJ_For1 In FRM_PRINCIPALE.Controls
    
        Call PRO_Tracer_Ombre(FRM_PRINCIPALE.BackColor, OBJ_For1.Left, OBJ_For1.Top, OBJ_For1.Width, OBJ_For1.Height)
        
    Next
    
    FRM_PRINCIPALE.Refresh

End Sub

Private Sub Form_Load()

'on active la routine de traitement d'erreur
On Error Resume Next
'l'erreur etant minime, on continue l'éxécution normalement

    'initialisation des valeurs initiales
    LNG_ShadowWidth = 5
    SLD_LARGEUR_OMBRE.Value = 5
    LNG_ShadowOpacity = 100
    SLD_OPACITE_OMBRE.Value = 100
    
    'on trace les ombres
    PRO_Ombrer_Controles

End Sub

Private Sub SLD_LARGEUR_OMBRE_Change()

'on active la routine de traitement d'erreur
On Error Resume Next
'l'erreur etant minime, on continue l'éxécution normalement

    'on prend en compte les modifications
    LNG_ShadowWidth = SLD_LARGEUR_OMBRE.Value
    PRO_Ombrer_Controles

End Sub

Private Sub SLD_OPACITE_OMBRE_Click()

'on active la routine de traitement d'erreur
On Error Resume Next
'l'erreur etant minime, on continue l'éxécution normalement

    'on prend en compte les modifications
    LNG_ShadowOpacity = SLD_OPACITE_OMBRE.Value
    PRO_Ombrer_Controles

End Sub

Conclusion :


Je ne pense pas qu'il y ai de bug.
Je ferais sûrement une mise à jour pour intégrer la sélection d'une couleur pour l'ombre ainsi que la gestion d'un fond imagé, une ombre plus arrondie pour une meilleure esthétique et enfin, un degradé d'ombre moins linéaire avec une position de hotspot définissable.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_DARKSIDIOUS)