Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Ce site au démarrage

begin process at 2012 02 16 03:42:20

Accueil Codes Tutoriels Forum Livres Emploi Services Connexion

Trouver un code source :

dans

[ Dernières recherches ]

Accueil >

DÉGRADÉ OFFICE

Information sur la source

Note :

10,00 / 10

Catégorie :Graphique Niveau :Débutant Date de création :06/06/2003 Date de mise à jour :06/06/2003 09:18:55 Vu :2 554

Auteur : VBSpirit

Ecrire un message privé

Commentaire sur cette source (8)

Ajouter un commentaire et/ou une note

Description

Cliquez pour voir la capture en taille normale

Fonction qui vous propose tout les dégradés de Office, çà peut être pratique.

Source

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

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

Sources du même auteur

VIDEOCONFERENCE : CONVERSATION WEBCAM

COMMENT FAIRE UN OCX + EXEMPLE : FLATBUTTON

INCRUSTATION D'IMAGE GRÂCE À UN FOND BLEU OU VERT

DÉFILEMENT FLUIDE - API SCROLLDC

DESSINER DU TEXTE RTF

Toutes les sources de VBSpirit

Sources de la même categorie

VB10 - CRÉER VOS PROPRES CALQUES SUR UNE IMAGE par Duke49

CREER UN GIF ANIMÉ par Le Pivert

GRAPH PHP COURBE DE CHARGE par s.defaye

BOULE DE CRISTAL par BLUEBIBUBBLE

VB6 - DÉPLACEMENT D'UN CONTRÔLE SUR UN SEGMENT DE DROITE DÉL... par ucfoutu

Toutes les sources de la catégorie Graphique

Commentaires et avis

Commentaire de Renfield le 06/06/2003 09:03:44 administrateur CS

on se fiche de savoir si ca prend ou pas de la place dans le code !!!!
ce n'est pas un motif valable......

parle d'un temps d'execution accru, ca c'est bon, mais la place dans le code........
on fait un module , on y met ton code, et voila !!!!!

et tout cas chapeau, c'est beaucoup de boulot

un zip & une capture ( pour un truc graphique, c'est mieux !! )

Commentaire de fts le 06/06/2003 10:13:59

chapeau!
qqun de charitable pourrait il expliquer au newbie que je suis comment utiliser cette fonction svp ?
d'avance merci !
(j'ai fait un copier coller ds 1 form vide en supprimant form load mais ça le fait pas...)

Commentaire de VBSpirit le 06/06/2003 11:15:12

Pour utliser la fonction, voici un exemple :
Dans une Form appelé Form1, Ajouter un bouton et appeller la fonction Degrad comme ceci :
Degrad (Form1, 0, 0, 50, 50, vbred, RGB(255,255,0),grd1to2)
où Form1 est l'objet qui doit être une Form ou un PictureBox,
X1, Y1, X2, Y2 sont les coordonnées du rectangle dans lequel le dégradé sera effectué, style étant le type de dégradé (utiliser les constantes "DegradStyle") et le dégradé apparaîtra...

Commentaire de Jujufouq le 06/06/2003 12:09:13

Ouai, ben tu t'es bien défoulé apparement... j'espère que t'as pas fait trop de mal à ton clavier ;-)
De voir ça, ça me décourage... Il y en a qui sont doués, c'est tout.
Bravo.

Commentaire de Arecibo le 06/06/2003 17:04:37

C'est très bien, les possibilités sont nombreuses mais, comme tu le dis, c'est très très condensée et pas évident à comprendre pour tout le monde...

Commentaire de Neo.balastik le 06/06/2003 21:40:25

En effet, le code est très condensé.  Tu aurais mis des "If Then Else" un peu plus au lieu de "IIF", le code aurait gagné en clareté (point de vue compréhension).
Ceci dit, même si IIF rend le code plus court, ce n'est pas pour cela qu'il en est plus rapide.  Bien au contraire, l'instruction IIF est bcp plus longue à interpréter par VB qu'un simple IF THEN ELSE...
Aussi, bravo pour ce code....  Un bon 8 !

Commentaire de ICIoBRa le 07/06/2003 12:23:15

grd1to2 < Type d'argument ByRef incompatible ...

Commentaire de Alain Proviste le 09/06/2003 09:12:36 administrateur CS

le code est à la fois beau et immonde... il n'en reste pas moins qu'il est efficace...

Ajouter un commentaire

Nos sponsors

Derniers Blogs

GESTION D'EXCEPTION AVEC LES TASKS par richardc

DéMARRONS AVEC LES TASKS par richardc

SLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPS par Vko

XNA IS DEAD! par richardc

TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice

Forum

RE : PROBLèME VéRIFICATION MD5 DEPUIS UN ENCLENCHEMENT DE BOUTON. par LeFoureur

RE : BLOCAGE DE MON PROGRAMME par ucfoutu

RE : PROBLèME VéRIFICATION MD5 DEPUIS UN ENCLENCHEMENT DE BOUTON. par NHenry

RE : OUVRIR PLUSIEURS FICHIERS EXCEL EN MêME AVEC VB par ossama261988

Côté IT

Offres d'emploi

Formations Video

Appels d'offres

Finalisation site d-encheres au centime
Budget : 2 800€
Recherche expert webmarketing
Budget : 3 000€
Republication - fichier d-export de site OS commerce ver plateforme logistique-CDC disponible
Budget : 1 200€

Logiciels

DocTranslate (V3.1.0.0)
DOCTRANSLATE (V3.1.0.0)

DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom...

Cliquez pour télécharger DocTranslate
Tribler (2012)
TRIBLER (2012)

Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des...

Cliquez pour télécharger Tribler
OneSwarm (2012)
ONESWARM (2012)

Le peer-to-peer qui protège votre vie privée, c'est OneSwarm. Ce logiciel de peer-to-peer crypté...

Cliquez pour télécharger OneSwarm
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)

PONAMEDIA TV DEVIENS HELLLOOO FLASH LA TV SUR VOTRE ORDINATEUR. Toute une plateforme Multi...

Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO
Academy System (17.2.1.0)
ACADEMY SYSTEM (17.2.1.0)

Logiciel de gestion des établissements. - élèves/étudiants (inscription, dossier, absence...) -...

Cliquez pour télécharger Academy System