Dégradé à n couleurs avec api

Soyez le premier à donner votre avis sur cette source.

Vue 5 163 fois - Téléchargée 483 fois

Télécharger le projet
Commenter

Description

Quand j'ai débuter en vb j'avais du mal avec les dégradé, donc cette source est pour ceux qui on encore du mal.
Rien de bien compliqué.

Source / Exemple : 


'Déclaration des API
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long    'API permettant de déplacer la position du point d'insertion graphique courant (soit le point d'origine d'une ligne)
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long                           'API permettant de dessiner un trait depuis la position courante jusqu'à un point donné
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long       'API permettant de créer un nouveau crayon qui stockeras la couleur
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long                                                   'API permettant de supprimer un objet crée
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long                                'API permettant de sélectionner un objet crée

'Déclaration d'une structure
Private Type POINTAPI
    x As Long
    y As Long
End Type

'Couleur est un tableau contenant toutes les couleurs
'Obj est la surface sur laquel cera appliqué le dégradé comme une forme ou une picturebox
'Longeur est la longeur du dégradé
'Largeur est la largeur du dégradé
'Direction Définit le sens du dégradé :
'   1 -> Vers la droite
'   2 -> Vers le droite
'   3 -> Vers la gauche
'   4 -> Vers le haut
Function Degrade(Couleur() As OLE_COLOR, Obj As Object, Longeur As Integer, Largeur As Integer, Optional Direction As Byte = 1)
    Dim i As Integer, max As Integer
    Dim Var1 As Single, Var2 As Single
    Dim debut As Long, Lg As Long, Deb As Long
    Dim R() As Byte, V() As Byte, B() As Byte
    Dim pt As POINTAPI, Crayon As Long
    
'..:: Je retrouve le nombre de couleurs ::..
    max = UBound(Couleur)
'..:: J'initialise mes tableaux ::..
    ReDim R(1 To max)
    ReDim V(1 To max)
    ReDim B(1 To max)
'..:: Je transforme les couleurs vb en couleurs RGB ::..
    For j = 1 To max
        R(j) = (Couleur(j) Mod 256)
        V(j) = ((Couleur(j) - R(j)) / 256 Mod 256)
        B(j) = Int((Couleur(j) - Couleur(j) Mod 256) / 256 / 256)
    Next j
    'Lg est la longeur d'une cellule
    Lg = Longeur / (max - 1)

    pt.x = 0
    pt.y = 0
    Largeur = Largeur / 15

'..:: Je divise la zone de dégradé en max-1 cellule ::..
    For j = 1 To max - 1
        'debut est la position de départ du dégradé soit le début de chaque cellules
        debut = Lg * (j - 1)
'..:: Le dégradé de cellule par cellules ::..
        For i = 0 To Lg
            Var1 = ((Lg - i) / Lg)
            Var2 = i / Lg
            
'..:: Methode sans API ::..
            'Deb = debut + i
            'Obj.Line (Deb, 0)-(Deb, Largeur), RGB((R(j) * Var1) + (Var2 * R(j + 1)), (V(j) * Var1) + (Var2 * V(j + 1)), (B(j) * Var1) + (Var2 * B(j + 1)))
            
            
'..:: Methode avec API ::..
            Deb = (debut + i) / 15

            Select Case Direction
                Case 1    'Droite
                    'On Crée un nouveau crayon
                    Crayon = CreatePen(0, 1, RGB((R(j) * Var1) + (Var2 * R(j + 1)), (V(j) * Var1) + (Var2 * V(j + 1)), (B(j) * Var1) + (Var2 * B(j + 1))))
                    'On Défini les nlles coordonnées de départ
                    MoveToEx Obj.hdc, Deb, 0, pt
                    'On trace la ligne et on donne les coordonnées de fin
                    LineTo Obj.hdc, Deb, Largeur
                Case 2    'Bas
                    'On Crée un nouveau crayon
                    Crayon = CreatePen(0, 1, RGB((R(j) * Var1) + (Var2 * R(j + 1)), (V(j) * Var1) + (Var2 * V(j + 1)), (B(j) * Var1) + (Var2 * B(j + 1))))
                    'On Défini les nlles coordonnées de départ
                    MoveToEx Obj.hdc, 0, Deb, pt
                    'On trace la ligne et on donne les coordonnées de fin
                    LineTo Obj.hdc, Largeur, Deb
                Case 3    'Gauche
                    'On Crée un nouveau crayon
                    Crayon = CreatePen(0, 1, RGB((R(max - j + 1) * Var1) + (Var2 * R(max - j)), (V(max - j + 1) * Var1) + (Var2 * V(max - j)), (B(max - j + 1) * Var1) + (Var2 * B(max - j))))
                    'On Défini les nlles coordonnées de départ
                    MoveToEx Obj.hdc, Deb, 0, pt
                    'On trace la ligne et on donne les coordonnées de fin
                    LineTo Obj.hdc, Deb, Largeur
                Case 4    'Haut
                    'On Crée un nouveau crayon
                    Crayon = CreatePen(0, 1, RGB((R(max - j + 1) * Var1) + (Var2 * R(max - j)), (V(max - j + 1) * Var1) + (Var2 * V(max - j)), (B(max - j + 1) * Var1) + (Var2 * B(max - j))))
                    'On Défini les nlles coordonnées de départ
                    MoveToEx Obj.hdc, 0, Deb, pt
                    'On trace la ligne et on donne les coordonnées de fin
                    LineTo Obj.hdc, Largeur, Deb
            End Select
            'On supprime le crayon
            DeleteObject SelectObject(Obj.hdc, Crayon)
        Next i
    Next j
End Function

Conclusion :


La mise a jour inclut differentes direction du dégradé et une optimisation (moins de calculs et passage par API)
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
cs_Steff
Messages postés
34
Date d'inscription
vendredi 9 novembre 2001
Statut
Membre
Dernière intervention
29 mars 2007
 -
Salut supra dolph,

Ton code m'a bien aidé. J'y ai apporté des modifications. Notemaent dans le passage du tableau couleur.
Je le passe en Long et non plus en OLE_COULEUR.
Je commence mon tableau à 0, ce qui est plus "propre" en dev. Il s'agit juste de décaler ensuite les valeurs du tableau lors du tracé.
J'ai aussi rajouter en fin de fonction Obj.ForeColor = RGB(0, 0, 0) pour réinitialiser la couleur. En effet, si après la création d'un dégradé dans un picture box je traçais des segment en rouge, il apparaissaient des fois noir, des fois rouge foncé et des fois rouge vif.
Cela vient peut-être du fait que la picturebox dans laquelle je trace à des scalewidth et scaleheight différente de ses width et height. J'ai pas tester autrement.
Je recolle la source :
'-------------------------------------------------------
'Couleur est un tableau contenant toutes les couleurs
'Obj est la surface sur laquel cera appliqué le dégradé comme une forme ou une picturebox
'Hauteur est la longeur du dégradé dans le cas 2
'Largeur est la largeur du dégradé dans le cas 2
'Direction Définit le sens du dégradé :
' 1 -> Vers la droite
' 2 -> Vers le bas
' 3 -> Vers la gauche
' 4 -> Vers le haut
Function Degrade(Couleur() As Long, Obj As Object, Hauteur As Long, Largeur As Long, Optional Direction As Byte = 1)
Dim i As Integer
Dim j As Integer
Dim Max As Integer
Dim Var1 As Single
Dim Var2 As Single
Dim Debut As Long
Dim Lg As Long
Dim Deb As Long
Dim R() As Single
Dim V() As Single
Dim B() As Single
Dim pt As POINTAPI
Dim Crayon As Long

On Error GoTo trap
'..:: Je retrouve le nombre de couleurs ::..
Max = UBound(Couleur)
'..:: J'initialise mes tableaux ::..
ReDim R(Max)
ReDim V(Max)
ReDim B(Max)
'..:: Je transforme les couleurs vb en couleurs RGB ::..
For j = 0 To Max
ConvertDecToRgb Couleur(j), R(j), V(j), B(j)
Next j
'Lg est la longeur d'une cellule
Lg = Hauteur / (Max)

pt.X = 0
pt.Y = 0
Largeur = Largeur / 15

'..:: Je divise la zone de dégradé en max-1 cellule ::..
For j = 0 To Max - 1
'debut est la position de départ du dégradé soit le début de chaque cellules
Debut = Lg * (j)
'..:: Le dégradé de cellule par cellules ::..
For i = 0 To Lg
Var1 = ((Lg - i) / Lg)
Var2 = i / Lg

'..:: Methode sans API ::..
'Deb = Debut + i
'Obj.Line (Deb, 0)-(Deb, Largeur), RGB((R(j) * Var1) + (Var2 * R(j + 1)), (V(j) * Var1) + (Var2 * V(j + 1)), (B(j) * Var1) + (Var2 * B(j + 1)))

Deb = (Debut + i) / 15

Select Case Direction
Case 1 'Droite
'On Crée un nouveau crayon
Crayon = CreatePen(0, 1, RGB((R(j) * Var1) + (Var2 * R(j + 1)), _
(V(j) * Var1) + (Var2 * V(j + 1)), _
(B(j) * Var1) + (Var2 * B(j + 1))))
'On Défini les nlles coordonnées de départ
MoveToEx Obj.hdc, Deb, 0, pt
'On trace la ligne et on donne les coordonnées de fin
LineTo Obj.hdc, Deb, Largeur
Case 2 'Bas
'On Crée un nouveau crayon
Crayon = CreatePen(0, 1, RGB((R(j) * Var1) + (Var2 * R(j + 1)), _
(V(j) * Var1) + (Var2 * V(j + 1)), _
(B(j) * Var1) + (Var2 * B(j + 1))))
'On Défini les nlles coordonnées de départ
MoveToEx Obj.hdc, 0, Deb, pt
'On trace la ligne et on donne les coordonnées de fin
LineTo Obj.hdc, Largeur, Deb
Case 3 'Gauche
'On Crée un nouveau crayon
Crayon = CreatePen(0, 1, RGB((R(Max - j + 1) * Var1) + (Var2 * R(Max - j)), _
(V(Max - j + 1) * Var1) + (Var2 * V(Max - j)), _
(B(Max - j + 1) * Var1) + (Var2 * B(Max - j))))
'On Défini les nlles coordonnées de départ
MoveToEx Obj.hdc, Deb, 0, pt
'On trace la ligne et on donne les coordonnées de fin
LineTo Obj.hdc, Deb, Largeur
Case 4 'Haut
'On Crée un nouveau crayon
Crayon = CreatePen(0, 1, RGB((R(Max - j + 1) * Var1) + (Var2 * R(Max - j)), _
(V(Max - j + 1) * Var1) + (Var2 * V(Max - j)), _
(B(Max - j + 1) * Var1) + (Var2 * B(Max - j))))
'On Défini les nlles coordonnées de départ
MoveToEx Obj.hdc, 0, Deb, pt
'On trace la ligne et on donne les coordonnées de fin
LineTo Obj.hdc, Largeur, Deb
End Select
'On supprime le crayon
DeleteObject SelectObject(Obj.hdc, Crayon)

Next i
Next j

Degrade = 1

'réinitialisation couleur noir pour eviter le changement de couleur après du au createpen
Obj.ForeColor = RGB(0, 0, 0)

Exit Function

trap:
Dim Ierr As Integer
Ierr = ErrorExec(Err, "Creation degrade dans GrxTool")
Degrade = 0

End Function
'------------------------------------------------

voila si ça peut aidé un peu. Tu remarquera aussi que pour R, V et B j'utilise des Single et non plus des byte.
ConvertDecToRgb Couleur(j), R(j), V(j), B(j) converti la couleur en valeur Long vers les valeur Rouge Vert et Bleu. J'ai mis une fonction car j'utilise beaucoup cette conversion dans mon appli.
le Ierr = ErrorExec(Err, "Creation degrade dans GrxTool")
permet de trapper les erreurs éventuel et d'éviter les plantages.
Signaler
SupraDolph
Messages postés
196
Date d'inscription
samedi 12 janvier 2002
Statut
Membre
Dernière intervention
1 septembre 2008
 1 -
Désoler que tu ne puisse pa ouvrir mon fichier zip car je viens de le downloader et je peu l'ouvrir sans aucun problème. Essaye d'autres zip c'est peu être un problème avec winzip (ou autre prog que tu utilise)
Signaler
cs_DARKSIDIOUS
Messages postés
15815
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
 83 -
Arghhh, j'ai un problème avec ton fichier zip : impossible de l'ouvrir : erreur de CRC !

DarK Sidious
Signaler
SupraDolph
Messages postés
196
Date d'inscription
samedi 12 janvier 2002
Statut
Membre
Dernière intervention
1 septembre 2008
 1 -
merci
Signaler
cs_DARKSIDIOUS
Messages postés
15815
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
 83 -
Ben il s'agit de la fonction API : LineTo qui doit être combinée à la fonction MoveToEx... Tu pourras les trouver sur le site : www.ProgOtoP.com
Ainsi que dans ma source de gestion des couleurs... ;-)

DarK Sidious
Afficher les 7 commentaires
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 (SupraDolph)