Dégradé office
Contenu du snippet
Fonction qui vous propose tout les dégradés de Office, çà peut être pratique.
Je sais, je sais elle est très condensée...
Source / Exemple :
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Any) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Enum DegradStyle
grdNone = 0
grdV_1to2 = 1
grdV_2to1 = 2
grdV_1to2to1 = 3
grdV_2to1to2 = 4
grdH_1TO2 = 11
grdH_2TO1 = 12
grdH_1to2to1 = 13
grdH_2to1to2 = 14
grdDiagonalUp_1to2 = 101
grdDiagonalUp_2to1 = 102
grdDiagonalUp_1to2to1 = 103
grdDiagonalUp_2to1to2 = 104
grdDiagonalDown_1to2 = 111
grdDiagonalDown_2to1 = 112
grdDiagonalDown_1to2to1 = 113
grdDiagonalDown_2to1to2 = 114
grdCorner_NO = 201
grdCorner_NE = 202
grdCorner_SE = 203
grdCorner_SO = 204
grdCenter_1Middle = 251
grdCenter_2Middle = 252
End Enum
Public Sub Degrad(PictureBox As Object, X1, Y1, X2, Y2, Couleur1 As Long, Couleur2 As Long, Style As DegradStyle)
Dim point As POINTAPI
If Style = grdV_1to2 Or Style = grdV_2to1 Or Style = grdV_2to1to2 Or Style = grdV_1to2to1 Then
For i = X1 To X2
p = Abs(i - X1) * 100 / Abs(X2 - X1)
PictureBox.ForeColor = Grad(IIf(Style = grdV_1to2 Or Style = grdV_1to2to1, Couleur1, Couleur2), IIf(Style = grdV_1to2 Or Style = grdV_1to2to1, Couleur2, Couleur1), IIf(Style = grdV_1to2to1 Or Style = grdV_2to1to2, IIf(p <= 50, p * 2, (50 - (p - 50)) * 2), p))
MoveToEx PictureBox.hdc, i, Y1, point
LineTo PictureBox.hdc, i, Y2
Next
ElseIf Style = grdH_1TO2 Or Style = grdH_2TO1 Or Style = grdH_2to1to2 Or Style = grdH_1to2to1 Then
For i = Y1 To Y2
p = Abs(i - Y1) * 100 / Abs(Y2 - Y1)
PictureBox.ForeColor = Grad(IIf(Style = grdH_1TO2 Or Style = grdH_1to2to1, Couleur1, Couleur2), IIf(Style = grdH_1TO2 Or Style = grdH_1to2to1, Couleur2, Couleur1), IIf(Style = grdH_1to2to1 Or Style = grdH_2to1to2, IIf(p <= 50, p * 2, (50 - (p - 50)) * 2), p))
MoveToEx PictureBox.hdc, X1, i, point
LineTo PictureBox.hdc, X2, i
Next
ElseIf Style = grdCorner_NO Or Style = grdCorner_SE Then
yl = Abs(Y2 - Y1)
xl = Abs(X2 - X1)
For i = IIf(xl >= yl, X1, Y1) To IIf(xl >= yl, X2 - 1, Y2 - 1)
p = Abs(i - IIf(xl >= yl, X1, Y1)) * 100 / Abs(IIf(xl >= yl, X2, Y2) - IIf(xl >= yl, X1, Y1))
PictureBox.ForeColor = Grad(IIf(Style = grdCorner_NO, Couleur1, Couleur2), IIf(Style = grdCorner_NO, Couleur2, Couleur1), p)
MoveToEx PictureBox.hdc, IIf(xl >= yl, i, X1), IIf(xl >= yl, Y1, i), point
LineTo PictureBox.hdc, IIf(xl >= yl, i, X1 + p * xl / 100 + 0), IIf(xl >= yl, Y1 + p * yl / 100 + 1, i)
MoveToEx PictureBox.hdc, IIf(xl >= yl, X1, X1 + p * xl / 100 + 0), IIf(xl >= yl, Y1 + p * yl / 100 + 0, Y1), point
LineTo PictureBox.hdc, IIf(xl >= yl, i, X1 + p * Abs(X2 - X1) / 100 + 0), IIf(xl >= yl, Y1 + p * yl / 100 + 0, i + 1)
Next
ElseIf Style = grdCorner_SO Or Style = grdCorner_NE Then
yl = Abs(Y2 - Y1)
xl = Abs(X2 - X1)
For i = IIf(xl >= yl, X1, Y1) To IIf(xl >= yl, X2 - 1, Y2 - 1)
p = Abs(i - IIf(xl >= yl, X1, Y1)) * 100 / Abs(IIf(xl >= yl, X2, Y2) - IIf(xl >= yl, X1, Y1))
If xl >= yl Then PictureBox.ForeColor = Grad(IIf(Style = grdCorner_SO, Couleur1, Couleur2), IIf(Style = grdCorner_SO, Couleur2, Couleur1), p)
If xl < yl Then PictureBox.ForeColor = Grad(IIf(Style = grdCorner_SO, Couleur2, Couleur1), IIf(Style = grdCorner_SO, Couleur1, Couleur2), p)
MoveToEx PictureBox.hdc, X1, IIf(xl >= yl, Y2 - p * yl / 100, i), point
LineTo PictureBox.hdc, IIf(xl >= yl, i + 1, X1 + (100 - p) * xl / 100 + 1), IIf(xl >= yl, Y2 - p * yl / 100, i)
MoveToEx PictureBox.hdc, IIf(xl >= yl, i, X1 + (100 - p) * xl / 100), Y2, point
LineTo PictureBox.hdc, IIf(xl >= yl, i, X1 + (100 - p) * xl / 100), IIf(xl >= yl, Y2 - p * yl / 100, i)
Next
ElseIf Style = grdCenter_1Middle Or Style = grdCenter_2Middle Then
yl = Abs(Y2 - Y1)
xl = Abs(X2 - X1)
For i = IIf(xl >= yl, X1, Y1) To IIf(xl >= yl, X2 - 1, Y2 - 1)
p = Abs(i - IIf(xl >= yl, X1, Y1)) * 100 / Abs(IIf(xl >= yl, X2, Y2) - IIf(xl >= yl, X1, Y1))
If xl >= yl Then yi = Y1 + p * (Y2 - Y1) / 100 Else yi = i
PictureBox.ForeColor = Grad(IIf(Style = grdCenter_1Middle, Couleur2, Couleur1), IIf(Style = grdCenter_1Middle, Couleur1, Couleur2), IIf(p <= 50, p * 2, (50 - (p - 50)) * 2))
MoveToEx PictureBox.hdc, IIf(p <= 50, X1 + p * (X2 - X1) / 100, X1 + (100 - p) * (X2 - X1) / 100), yi, point
LineTo PictureBox.hdc, IIf(p <= 50, X2 - p * (X2 - X1) / 100, X2 - (100 - p) * (X2 - X1) / 100) + 1, yi
If xl >= yl Then xi = i Else xi = X1 + p * (X2 - X1) / 100
PictureBox.ForeColor = Grad(IIf(Style = grdCenter_1Middle, Couleur2, Couleur1), IIf(Style = grdCenter_1Middle, Couleur1, Couleur2), IIf(p <= 50, p * 2, (50 - (p - 50)) * 2))
MoveToEx PictureBox.hdc, xi, IIf(p <= 50, Y1 + p * (Y2 - Y1) / 100, Y1 + (100 - p) * (Y2 - Y1) / 100), point
LineTo PictureBox.hdc, xi, IIf(p <= 50, Y2 - p * (Y2 - Y1) / 100, Y2 - (100 - p) * (Y2 - Y1) / 100) + 1
Next
ElseIf Style = grdDiagonalUp_1to2 Or Style = grdDiagonalUp_1to2to1 Or Style = grdDiagonalUp_2to1to2 Or Style = grdDiagonalUp_2to1 Then
yl = Abs(Y2 - Y1)
xl = Abs(X2 - X1)
For i = IIf(xl >= yl, X1, Y1) To IIf(xl >= yl, X2 - 1, Y2 - 1)
p = Abs(i - IIf(xl >= yl, X1, Y1)) * 100 / Abs(IIf(xl >= yl, X2, Y2) - IIf(xl >= yl, X1, Y1))
PictureBox.ForeColor = Grad(IIf(Style = grdDiagonalUp_1to2 Or Style = grdDiagonalUp_1to2to1, Couleur1, Couleur2), IIf(Style = grdDiagonalUp_1to2 Or Style = grdDiagonalUp_1to2to1, Couleur2, Couleur1), IIf(Style = grdDiagonalUp_1to2to1 Or Style = grdDiagonalUp_2to1to2, p, p / 2))
MoveToEx PictureBox.hdc, IIf(xl >= yl, i, X1), IIf(xl >= yl, Y1, i), point
LineTo PictureBox.hdc, IIf(xl >= yl, X1, X1 + p * xl / 100), IIf(xl >= yl, Y1 + p * yl / 100, Y1)
PictureBox.ForeColor = Grad(IIf(Style = grdDiagonalUp_1to2 Or Style = grdDiagonalUp_1to2to1, Couleur1, Couleur2), IIf(Style = grdDiagonalUp_1to2 Or Style = grdDiagonalUp_1to2to1, Couleur2, Couleur1), IIf(Style = grdDiagonalUp_1to2to1 Or Style = grdDiagonalUp_2to1to2, 100 - p, 50 + (p / 2)))
MoveToEx PictureBox.hdc, IIf(xl >= yl, i, X2), IIf(xl >= yl, Y2, i), point
LineTo PictureBox.hdc, IIf(xl >= yl, X2, X1 + p * xl / 100), IIf(xl >= yl, Y1 + p * yl / 100, Y2)
Next
ElseIf Style = grdDiagonalDown_1to2 Or Style = grdDiagonalDown_1to2to1 Or Style = grdDiagonalDown_2to1to2 Or Style = grdDiagonalDown_2to1 Then
yl = Abs(Y2 - Y1)
xl = Abs(X2 - X1)
For i = IIf(xl >= yl, X1, Y1) To IIf(xl >= yl, X2 - 1, Y2 - 1)
p = Abs(i - IIf(xl >= yl, X1, Y1)) * 100 / Abs(IIf(xl >= yl, X2, Y2) - IIf(xl >= yl, X1, Y1))
PictureBox.ForeColor = Grad(IIf(Style = grdDiagonalDown_1to2 Or Style = grdDiagonalDown_1to2to1, Couleur1, Couleur2), IIf(Style = grdDiagonalDown_1to2 Or Style = grdDiagonalDown_1to2to1, Couleur2, Couleur1), IIf(Style = grdDiagonalDown_1to2to1 Or Style = grdDiagonalDown_2to1to2, p, p / 2))
If xl >= yl And (Style = grdDiagonalDown_1to2 Or Style = grdDiagonalDown_2to1) Then PictureBox.ForeColor = Grad(IIf(Style = grdDiagonalDown_1to2 Or Style = grdDiagonalDown_1to2to1, Couleur2, Couleur1), IIf(Style = grdDiagonalDown_1to2 Or Style = grdDiagonalDown_1to2to1, Couleur1, Couleur2), IIf(Style = grdDiagonalDown_1to2to1 Or Style = grdDiagonalDown_2to1to2, p, p / 2))
MoveToEx PictureBox.hdc, IIf(xl >= yl, X2 - (i - X1), X1), IIf(xl >= yl, Y1, Y2 - (i - Y1)), point
LineTo PictureBox.hdc, IIf(xl >= yl, X2, X1 + p * xl / 100), IIf(xl >= yl, Y1 + p * yl / 100, Y2)
PictureBox.ForeColor = Grad(IIf(Style = grdDiagonalDown_1to2 Or Style = grdDiagonalDown_1to2to1, Couleur1, Couleur2), IIf(Style = grdDiagonalDown_1to2 Or Style = grdDiagonalDown_1to2to1, Couleur2, Couleur1), IIf(Style = grdDiagonalDown_1to2to1 Or Style = grdDiagonalDown_2to1to2, 100 - p, 50 + (p / 2)))
If xl >= yl And (Style = grdDiagonalDown_1to2 Or Style = grdDiagonalDown_2to1) Then PictureBox.ForeColor = Grad(IIf(Style = grdDiagonalDown_1to2 Or Style = grdDiagonalDown_1to2to1, Couleur2, Couleur1), IIf(Style = grdDiagonalDown_1to2 Or Style = grdDiagonalDown_1to2to1, Couleur1, Couleur2), IIf(Style = grdDiagonalDown_1to2to1 Or Style = grdDiagonalDown_2to1to2, 100 - p, 50 + (p / 2)))
MoveToEx PictureBox.hdc, IIf(xl >= yl, X1, X1 + p * xl / 100), IIf(xl >= yl, Y1 + p * yl / 100, Y1), point
LineTo PictureBox.hdc, IIf(xl >= yl, X2 - (i - X1), X2), IIf(xl >= yl, Y2, Y2 - (i - Y1))
Next
End If
End Sub
'Fonction qui mélange deux couleurs selon Percent
Function Grad(Couleur1 As Long, Couleur2 As Long, Percent)
r1 = (Couleur1 \ 1&) And &HFF&
r2 = (Couleur2 \ 1&) And &HFF&
v1 = (Couleur1 \ &H100) And &HFF&
v2 = (Couleur2 \ &H100) And &HFF&
b1 = (Couleur1 \ &H10000) And &HFF&
b2 = (Couleur2 \ &H10000) And &HFF&
rd = r2 - r1
vd = v2 - v1
bd = b2 - b1
On Error Resume Next
Grad = RGB(r1 + (Percent * rd / 100), v1 + (Percent * vd / 100), b1 + (Percent * bd / 100))
End Function
Conclusion :
Je sais, je sais elle est très condensée...
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.