Degrade d'une couleur a une autre

Télécharger le projet
Commenter

Description

voici une fonction permettant de tracer un dégrader linéaire verticale ou horizontal sur un objet :

explications :
Objet : ici un controle image, mais vous pouvez remplacer par n'import kel objet contenant un canvas
DebCol : couleur de départ
FinCol : couleur d'arrivé
Vertical : mettre True pour un dégradé vertical

voila

(il y a un exemple dans le zip)

Source / Exemple : 


procedure Degrade(Objet:timage;DebCol:real;FinCol:real;Vertical:boolean);
var
a:Integer;       //Déclaration des variables
r:real;
v:real;     
b:real;
r2:real;
v2:real;
b2:real;
decR:real;
decV:real;
decB:real;
Vcalc:integer;

        begin
b:=trunc(DebCol / 65536);  //Décomposition des couleur en rouge
v:=trunc((DebCol - b * 65536) / 256);  //Vert et bleu
r:=DebCol - b * 65536 - V * 256;
b2:=trunc(FinCol / 65536);
v2:=trunc((FinCol - b2 * 65536) / 256);
r2:=FinCol - b2 * 65536 - v2 * 256;

If Vertical=False Then Vcalc:=Objet.Width Else Vcalc:=Objet.Height;

decR:=(r2 - r)/Vcalc;   //Calcul du décalage des couleurs
decV:=(v2 - V)/Vcalc;
decB:=(b2 - b)/Vcalc;

//Tracage du dégradé
If Vertical = False Then        //Horizontal
        begin
        For a:=0 To Objet.Width do
                begin
                        objet.Canvas.pen.Color:=rgb(trunc(r),trunc(v),trunc(b));
                        Objet.canvas.Rectangle(a,0,a + 1, Objet.Height);
                        r:=abs(r + decR);  //Incrémentation des couleurs
                        v:=abs(v + decV);
                        b:=abs(b + decB);
                end;
        end
Else                            //Vertical
        begin
       For a:=0 To Objet.height do
                begin
                        objet.Canvas.pen.Color:=rgb(trunc(r),trunc(v),trunc(b));
                        Objet.Canvas.Rectangle(0,a,Objet.width,a+1);
                        r:=abs(r + decR);  //Incrémentation des couleurs
                        v:=abs(v + decV);
                        b:=abs(b + decB);
                end;
        end;

end;

Conclusion :


cette fonction existe aussi en visual basic : a l'adresse suivante :
http://www.vbfrance.com/article.asp?Val=1081

hop
Télécharger le projet

Codes Sources

A voir également

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 (fabiin)