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)
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.