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

Soyez le premier à donner votre avis sur cette source.

Vue 4 827 fois - Téléchargée 812 fois

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.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
300
Date d'inscription
lundi 17 juillet 2006
Statut
Membre
Dernière intervention
27 mai 2012
3
Bonjour, 10/10
Pour ceux qui connaissent le jeux populous (3D), j'aime bien l'effet ombre sur composants en concidérent le curseur de la souris comme source de lumière.

Je vais essayer d'adapter ce code déjà fort bien fait pour permettre de définir optionnellement un point X,Y source de la lumière avec un taux de luminosité.
Messages postés
23
Date d'inscription
mardi 24 février 2004
Statut
Membre
Dernière intervention
29 mars 2005

Je vais regarder cette source de plus prêt... pfiou... ca fait pas longtemps que j'utilise vbfrance, mais j'ai déjà 3 ou 4 sources de DarkSidious à me mettre sous la dent... et ca a l'air d'être du très bon... et en plus ca a l'air bien bien commenté...

Bon, j'anticipe un petit peu, mais bon, jva te mettre un 10/10, et de une parce que ta source a l'air bien sympa, et de 2 parce tu m'as pas mal aidé et conseillé aujourd'hui... et demain, je fais le tour de tes autres sources...

@ ciao, et bonne prog
Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
121
Oui, ca je connaît, mais comment faire pour faire :

TypeOf(me.Controls(index)) = TypeOf(ControlExclude) par exemple ?

DarK Sidious
Messages postés
129
Date d'inscription
mercredi 24 septembre 2003
Statut
Membre
Dernière intervention
12 février 2009

propriété typeof :
If (TypeOf Me.Controls(indx) Is TextBox) Then...
JM
Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
121
Re jean marc ;-)

Ben l'idéal, ce serait de se baser uniquement sur les propriétés des contrôles sans les modifier : si le programmeur utilise déjà le tag de ces contrôles, il ne faut pas y toucher pour distinguer les contrôles ombrés des contrôles non ombrés ! Il doit bien exister un moyen de connaître le type d'un contrôle tout de même !

DarK Sidious
Afficher les 25 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.