cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 2014
-
23 mars 2005 à 17:29
Bacterius
Messages postés3792Date d'inscriptionsamedi 22 décembre 2007StatutMembreDernière intervention 3 juin 2016
-
15 mars 2008 à 14:23
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
Bacterius
Messages postés3792Date d'inscriptionsamedi 22 décembre 2007StatutMembreDernière intervention 3 juin 201610 15 mars 2008 à 14:23
Bonjour,
Très sympa cette source, elle marche même sous Delphi 3 :) Super !
Cordialement, Bacterius ...
cs_ManChesTer
Messages postés374Date d'inscriptionvendredi 20 octobre 2000StatutModérateurDernière intervention15 janvier 2021 1 avril 2005 à 13:15
Bizard,
Je n'obtiend pas de grosses différences sur mes pc...
J'utilise Form.canvas, peut etre que dans un paintbox c'est diffèrent, mais je n'en vois pas la raison.
En tout cas je n'ai pas plus de noir sur mes pc avec ma mèthode ou ta mèthode, ta mèthode est juste un peux + saccadée au niveau du dégradé, c'est la seule différence que je vois.
Envoie moi ton mail en privé, je te send un screenshoot.
Bon Coding...
ManChesTer.
cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 20145 1 avril 2005 à 10:17
Il m' est difficile de comparer quelle est la source qui a le plus bel effet. Donc, si tu dis que c' est la tienne, je te l' accorde. Cependant, il y a réellement une différence de couleurs choisies pour le dégradé. Comme je le disais plus haut, un dégradé du blanc vers le noir sera très différent selon la méthode. La tienne donnant un resultat plus sombre.
cs_ManChesTer
Messages postés374Date d'inscriptionvendredi 20 octobre 2000StatutModérateurDernière intervention15 janvier 2021 31 mars 2005 à 19:45
Non,
L'algo de dégradé est fondamentalement le même, juste un peux plus lisse à cose de l'utilisation des virgules flottantes, ce qui donne un résultat plus 'correct' (en fait plus "rond" en 24 ou 32bits).
Quand au perfs, voici les résutats pour 10.000 affichage 223x344Pixels/32Bits sur P4 3.2Ghz Ati RADEON 9600 (résoloution 1600x1200).
Ma routine H : 10125 ms
Ta routine H : 9625 ms
Ma routine V : 10906 ms
Ta routine V : 11125 ms
Ce qui donne sensiblemet le même résultat.
Sur 3 autres pc, j'obtiend des écarts similaires.
Bon Coding...
ManChesTer.
cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 20145 31 mars 2005 à 17:26
Je viens de refaire les mêmes tests: pareil!
Les temps d' execution sont les mêmes! L' effet que l' on voyait avec ton code a disparu :)
MAIS, ta fonction fait un dégradé du blanc vers le noir sans passer para la couleur blanc et même, privilégie trop le noir: les gris clairs ne sont pas assez représenté. Pourrais-tu me confirmer cela?
cs_ManChesTer
Messages postés374Date d'inscriptionvendredi 20 octobre 2000StatutModérateurDernière intervention15 janvier 2021 31 mars 2005 à 16:39
Oui, g vu, voila le corrigè, un peux modifiè a ma sauce, perfs +- identiques a la tienne, mais je trouve le dégradé + beau...
procedure GradFill(canvas:Tcanvas;ClientRect:Trect;fromColor, toColor: TColor; adgradOrientation: TdgradOrientation);
Type Trgb = Record
R : Byte;
G : Byte;
B : Byte;
end;
Tirgb = Record
R : Integer;
G : Integer;
B : Integer;
end;
var
aBand,Ort : TRect; { Bande rectangulaire de couleur courante }
i,nbDgrad : integer; { Compteur pour parcourir la hauteur de la fiche }
Sx,Sy,p : Real;
StartRGB : Trgb; { RGB de la couleur de départ }
DifRGB : TIrgb; { RGB à ajouter à la couleur de départ pour atteindre la couleur de fin }
CurRGB : Trgb;
OCurRGB : Trgb;
begin
// Calcul des valeurs RGB pour la couleur courante
StartRGB.R := GetRValue(ColorToRGB( fromColor ));
StartRGB.G := GetGValue(ColorToRGB( fromColor ));
StartRGB.B := GetBValue(ColorToRGB( fromColor ));
// Calcul des valeurs à ajouter pour atteindre la couleur de fin
DifRGB.R := GetRValue(ColorToRGB( toColor )) - StartRGB.R ;
DifRGB.G := GetgValue(ColorToRGB( toColor )) - StartRGB.G;
DifRGB.B := GetbValue(ColorToRGB( toColor )) - StartRGB.B ;
OCurRGB:=StartRGB;
With Canvas do
begin
nbDgrad := 255;
Aband:=Clientrect;
if adgradOrientation = doVertical then
begin
Aband.Bottom:=Aband.Top;
if ClientRect.Bottom - ClientRect.Top < 255 then
nbDgrad := ClientRect.Bottom - ClientRect.Top;
end
else
begin
Aband.Right:=Aband.Left;
if ClientRect.Right - ClientRect.Left < 255 then
nbDgrad := ClientRect.Right - ClientRect.Left;
end;
Sy:=(ClientRect.Bottom-ClientRect.Top)/NbDgrad;
Sx:=(ClientRect.Right-ClientRect.Left)/NbDgrad;
for i:=0 to nbDgrad do // Degradé de um max. de 255 cores ...
begin
p:=i/NbDgrad;
CurRGB.R := StartRGB.R + round(p*DifRGB.R);
CurRGB.G := StartRGB.G + round(p*DifRGB.G);
CurRGB.B := StartRGB.B + round(p*DifRGB.B);
if (OCurRGB.R<>CurRgb.R) or
(OCurRGB.G<>CurRgb.G) or
(OCurRGB.B<>CurRgb.B) then
begin
Brush.color:=RGB(CurRGB.R,CurRGB.G,CurRGB.B);
FillRect(aBand);
if adgradOrientation = doVertical then
begin
aBand.Top:=aBand.Bottom;
aBand.Bottom:=Clientrect.Top+abs(Round(sy*i));
end
else
begin
aBand.left:=Aband.Right;
aBand.right:=Clientrect.left+abs(Round(sx*i));
end;
OCurRGB:=currgb;
end;
end;
Brush.color:=RGB(CurRGB.R,CurRGB.G,CurRGB.B);
FillRect(aBand);
end;
end;
Bon Coding...
ManChesTer.
cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 20145 31 mars 2005 à 12:12
Je viens de faire un test de comparaison de ta fonction et de la mienne. Voici les résultats obtenus sur un Pentium 4 3GHZ WinXPSP2 :
1. Dégradé doVertical (lignes horizontals) sur un paintbox de dimension Witdh=25 Height=505 executé 99 fois:
ma fonction = 109 millisecondes
ta fonction = 15 millisecondes mais il y a un bug d' affichage dû à ton code qui n' execute que 25 la commande fillRect...
2. Dégradé doVertical (lignes horizontals) sur un paintbox de dimension Witdh=505 Height=505 executé 99 fois:
ma fonction = 109 millisecondes, normal puisque la hauteur est la même.
ta fonction = 2350 millisecondes surement dû au bug cité plus haut.
3. Dégradé doVertical (lignes horizontals) sur un paintbox de dimension Witdh=25 Height=25 executé 9999 fois:
ma fonction = 1172 millisecondes
ta fonction = 2110 millisecondes
Il est donc impossible de conclure pour l' instant mais, d' apres le dernier test, ta méthode est curieusement plus lente (on voit le paint s' executer plusieurs fois sur l' ecran alors que pour ma méthode, elle parait etre faite une seule fois).
cs_ManChesTer
Messages postés374Date d'inscriptionvendredi 20 octobre 2000StatutModérateurDernière intervention15 janvier 2021 30 mars 2005 à 17:03
Maurico voici exactement la meme (niveau rèsultat visuel) :
procedure GradFill(canvas:Tcanvas;ClientRect:Trect;fromColor, toColor: TColor; adgradOrientation: TdgradOrientation);
var
aBand,Ort : TRect; { Bande rectangulaire de couleur courante }
i,nbDgrad,add : integer; { Compteur pour parcourir la hauteur de la fiche }
Sx,Sy : real;
Arr_StartRGB : array[0..2] of Byte; { RGB de la couleur de départ }
Arr_DifRGB : array[0..2] of integer; { RGB à ajouter à la couleur de départ pour atteindre la couleur de fin }
Arr_CurRGB : array[0..2] of Byte; { RGB de la couleur courante }
begin
// Calcul des valeurs RGB pour la couleur courante
Arr_StartRGB[0] := GetRValue(ColorToRGB( fromColor ));
Arr_StartRGB[1] := GetGValue(ColorToRGB( fromColor ));
Arr_StartRGB[2] := GetBValue(ColorToRGB( fromColor ));
// Calcul des valeurs à ajouter pour atteindre la couleur de fin
Arr_DifRGB[0] := GetRValue(ColorToRGB( toColor )) - Arr_StartRGB[0] ;
Arr_DifRGB[1] := GetgValue(ColorToRGB( toColor )) - Arr_StartRGB[1] ;
Arr_DifRGB[2] := GetbValue(ColorToRGB( toColor )) - Arr_StartRGB[2] ;
With Canvas do
begin
Pen.Style := psSolid;
Pen.Mode := pmCopy;
Pen.Width := 1;
nbDgrad := 255;
if adgradOrientation = doVertical then
if ClientRect.Bottom - ClientRect.Top < 255 then
nbDgrad := ClientRect.Bottom - ClientRect.Top
else
if ClientRect.Right - ClientRect.Left < 255 then
nbDgrad := ClientRect.Right - ClientRect.Left;
Aband:=Clientrect;
Sy:=(ClientRect.Bottom-ClientRect.Top)/NbDgrad;
Sx:=(ClientRect.Right-ClientRect.Left)/NbDgrad;
for i:= 0 to nbDgrad do // Degradé de um max. de 255 cores ...
begin
Arr_CurRGB[0] := (Arr_StartRGB[0] + MulDiv( i, Arr_DifRGB[0] , nbDgrad ));
Arr_CurRGB[1] := (Arr_StartRGB[1] + MulDiv( i, Arr_DifRGB[1] , nbDgrad ));
Arr_CurRGB[2] := (Arr_StartRGB[2] + MulDiv( i, Arr_DifRGB[2] , nbDgrad ));
Brush.color:=RGB(Arr_CurRGB[0], Arr_CurRGB[1], Arr_CurRGB[2]);
FillRect(aBand);
if adgradOrientation = doVertical then
begin
add:=Round(sy*i);
aBand.Top:=Clientrect.Top+add;
aBand.Bottom:=Clientrect.Top+add+i;
end
else
begin
add:=Round(sx*i);
aBand.left:=Clientrect.Left+add;
aBand.right:=Clientrect.Left+add+i;
end;
end;
end;
end;
Bon Coding...
ManChesTer.
cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 20145 30 mars 2005 à 15:28
Je vais pouvoir te répondre Manchester maintenant que j' ai essayé ton code.
Il permet d' occuper moins le CPU mais je ne sais pas pkoi, mais si tu fais un dgradé du blanc vers le noir, ce drnier sera plutôt gris. Donc, il y a comme un petit problème.
cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 20145 30 mars 2005 à 10:45
Non, je ne vais pas m' arreter là, d' ailleurs, ce pack ne comportait au debut qu' 1 compo :)
J' en sortirai d' autres non graphiques, mais j' etudie encore le potentiel dans divers manuels que j' ai:
Mastering Delphi - Marco Cantù
Delphi Developer's handbook - Marco Cantù/Tim Gooch/John F. Lam
Donc, mes manuels + exemples du net = bcp de travail preliminaire!
cs_ManChesTer
Messages postés374Date d'inscriptionvendredi 20 octobre 2000StatutModérateurDernière intervention15 janvier 2021 25 mars 2005 à 17:46
cs_ManChesTer
Messages postés374Date d'inscriptionvendredi 20 octobre 2000StatutModérateurDernière intervention15 janvier 2021 25 mars 2005 à 17:45
Bien vu Mauricio, rapide pour le dégradé
j'ai un peux modifié ton code ca donne :
procedure GradFill(canvas:Tcanvas;ClientRect:Trect;fromColor, toColor: TColor; adgradOrientation: TdgradOrientation);
var
aBand : TRect; { Bande rectangulaire de couleur courante }
i,nbDgrad,Sx,Sy : integer; { Compteur pour parcourir la hauteur de la fiche }
Arr_StartRGB : array[0..2] of Byte; { RGB de la couleur de départ }
Arr_DifRGB : array[0..2] of integer; { RGB à ajouter à la couleur de départ pour atteindre la couleur de fin }
Arr_CurRGB : array[0..2] of Byte; { RGB de la couleur courante }
begin
// Calcul des valeurs RGB pour la couleur courante
Arr_StartRGB[0] := GetRValue(ColorToRGB( fromColor ));
Arr_StartRGB[1] := GetGValue(ColorToRGB( fromColor ));
Arr_StartRGB[2] := GetBValue(ColorToRGB( fromColor ));
// Calcul des valeurs à ajouter pour atteindre la couleur de fin
Arr_DifRGB[0] := GetRValue(ColorToRGB( toColor )) - Arr_StartRGB[0] ;
Arr_DifRGB[1] := GetgValue(ColorToRGB( toColor )) - Arr_StartRGB[1] ;
Arr_DifRGB[2] := GetbValue(ColorToRGB( toColor )) - Arr_StartRGB[2] ;
With Canvas do
begin
Pen.Style := psSolid;
Pen.Mode := pmCopy;
Pen.Width := 1;
nbDgrad := 255;
if adgradOrientation = doVertical then
if ClientRect.Bottom - ClientRect.Top < 255 then
nbDgrad := ClientRect.Bottom - ClientRect.Top
else
if ClientRect.Right - ClientRect.Left < 255 then
nbDgrad := ClientRect.Right - ClientRect.Left;
Aband:=Clientrect;
Sy:=(ClientRect.Bottom - ClientRect.Top) div NbDgrad+1;
Sx:=(ClientRect.Right - ClientRect.Left) div NbDgrad+1;
Arr_CurRGB[0] := Arr_StartRGB[0];
Arr_CurRGB[1] := Arr_StartRGB[1];
Arr_CurRGB[2] := Arr_StartRGB[2];
for i:= 0 to nbDgrad do // Degradé de um max. de 255 cores ...
begin
Arr_CurRGB[0] := (Arr_StartRGB[0] + MulDiv( i, Arr_DifRGB[0] , nbDgrad ));
Arr_CurRGB[1] := (Arr_StartRGB[1] + MulDiv( i, Arr_DifRGB[1] , nbDgrad ));
Arr_CurRGB[2] := (Arr_StartRGB[2] + MulDiv( i, Arr_DifRGB[2] , nbDgrad ));
Brush.color:=RGB(Arr_CurRGB[0], Arr_CurRGB[1], Arr_CurRGB[2]);
FillRect(aBand);
if adgradOrientation = doVertical then
begin
Inc(aBand.Top,sy);
Inc(aBand.Bottom,sy+1);
end
else
begin
Inc(aBand.left,sx);
Inc(aBand.right,sx+1);
end;
end;
end;
end;
Bon Coding...
ManChesTer.
japee
Messages postés1727Date d'inscriptionvendredi 27 décembre 2002StatutModérateurDernière intervention 6 novembre 20218 24 mars 2005 à 19:53
Bah, c'est la révolution des oeillets sinon, quoi, Mauricio ;o)
rylryl
Messages postés311Date d'inscriptionmardi 9 mars 2004StatutMembreDernière intervention15 décembre 20061 24 mars 2005 à 18:33
C'est clair, c'est beau et utile ...
merci MAURICIO.
ryl...
cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 20145 24 mars 2005 à 17:38
Merci Debiars!
Ben, y a pas de quoi crier à la révolution non plus mais fallait y penser c' est tout :)
A+
Debiars
Messages postés285Date d'inscriptionlundi 16 juin 2003StatutMembreDernière intervention11 février 2018 24 mars 2005 à 17:06
Un seul mot : impeccable.
jp
cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 20145 24 mars 2005 à 10:24
Ha ben merci tout le monde!
Pour faire le test, c' est assez simple.
Prenez la méthode pour faire le paint sur n' importe quel canvas (un TPaintBox par exemple) et faites 999 fois le refresh dans une boucle 'for'. Avec GetTickCount, on peut comparer le temps que ça mets.
Ensuite, refaites le test en obligeant à faire 255 fois comme ceci:
nbdgrad := 255;
for i:= 0 to nbDgrad do
A+ et merci encore une fois
cs_Kenavo
Messages postés702Date d'inscriptionvendredi 21 mars 2003StatutMembreDernière intervention 1 octobre 20095 24 mars 2005 à 08:19
Salut Mauricio,
J'ai retrouvé mon fond dégradé écrit en 1997, en Delphi 1 et en toute innocence !
Ben j'ai fait tout ce que tu dis qu'il faut pas faire pour aller vite ! God damned !
Ken@vo
N'empêche que c'est un composant !
ni69
Messages postés1418Date d'inscriptionsamedi 12 juin 2004StatutMembreDernière intervention 5 juillet 201012 23 mars 2005 à 23:18
Comme toujours, c'est du très bon code que tu nous propose !
Bravo ! ;)
@+
Nico
japee
Messages postés1727Date d'inscriptionvendredi 27 décembre 2002StatutModérateurDernière intervention 6 novembre 20218 23 mars 2005 à 20:08
Salut, Mauricio.
Je n'ai pas fait de comparatif direct avec d'autres méthodes, mais il me semble que la tienne est super rapide.
Et le rendu du dégradé est impeccable.
L'essayer, c'est l'adopter !
Bonne chance pour ton premier compo.
Il faudrait que je m'y mette aussi, bien que les compos soient un peu boudés sur le site. Et puis c'est pas un travail de "newbie", si l'on veut vraiment faire quelque chose de correct.
Merci pour ce code utile.
japee
cs_MAURICIO
Messages postés2106Date d'inscriptionmardi 10 décembre 2002StatutModérateurDernière intervention15 décembre 20145 23 mars 2005 à 17:29
Ha oui, veuillez m' excuser mais j' ai oublié de preciser que la variable adgradOrientation est de type TdgradOrientation (dans mon compo).
type
TdgradOrientation = (doVertical, doHorizontal);
15 mars 2008 à 14:23
Très sympa cette source, elle marche même sous Delphi 3 :) Super !
Cordialement, Bacterius ...
1 avril 2005 à 13:15
Je n'obtiend pas de grosses différences sur mes pc...
J'utilise Form.canvas, peut etre que dans un paintbox c'est diffèrent, mais je n'en vois pas la raison.
En tout cas je n'ai pas plus de noir sur mes pc avec ma mèthode ou ta mèthode, ta mèthode est juste un peux + saccadée au niveau du dégradé, c'est la seule différence que je vois.
Envoie moi ton mail en privé, je te send un screenshoot.
Bon Coding...
ManChesTer.
1 avril 2005 à 10:17
31 mars 2005 à 19:45
L'algo de dégradé est fondamentalement le même, juste un peux plus lisse à cose de l'utilisation des virgules flottantes, ce qui donne un résultat plus 'correct' (en fait plus "rond" en 24 ou 32bits).
Quand au perfs, voici les résutats pour 10.000 affichage 223x344Pixels/32Bits sur P4 3.2Ghz Ati RADEON 9600 (résoloution 1600x1200).
Ma routine H : 10125 ms
Ta routine H : 9625 ms
Ma routine V : 10906 ms
Ta routine V : 11125 ms
Ce qui donne sensiblemet le même résultat.
Sur 3 autres pc, j'obtiend des écarts similaires.
Bon Coding...
ManChesTer.
31 mars 2005 à 17:26
Les temps d' execution sont les mêmes! L' effet que l' on voyait avec ton code a disparu :)
MAIS, ta fonction fait un dégradé du blanc vers le noir sans passer para la couleur blanc et même, privilégie trop le noir: les gris clairs ne sont pas assez représenté. Pourrais-tu me confirmer cela?
31 mars 2005 à 16:39
procedure GradFill(canvas:Tcanvas;ClientRect:Trect;fromColor, toColor: TColor; adgradOrientation: TdgradOrientation);
Type Trgb = Record
R : Byte;
G : Byte;
B : Byte;
end;
Tirgb = Record
R : Integer;
G : Integer;
B : Integer;
end;
var
aBand,Ort : TRect; { Bande rectangulaire de couleur courante }
i,nbDgrad : integer; { Compteur pour parcourir la hauteur de la fiche }
Sx,Sy,p : Real;
StartRGB : Trgb; { RGB de la couleur de départ }
DifRGB : TIrgb; { RGB à ajouter à la couleur de départ pour atteindre la couleur de fin }
CurRGB : Trgb;
OCurRGB : Trgb;
begin
// Calcul des valeurs RGB pour la couleur courante
StartRGB.R := GetRValue(ColorToRGB( fromColor ));
StartRGB.G := GetGValue(ColorToRGB( fromColor ));
StartRGB.B := GetBValue(ColorToRGB( fromColor ));
// Calcul des valeurs à ajouter pour atteindre la couleur de fin
DifRGB.R := GetRValue(ColorToRGB( toColor )) - StartRGB.R ;
DifRGB.G := GetgValue(ColorToRGB( toColor )) - StartRGB.G;
DifRGB.B := GetbValue(ColorToRGB( toColor )) - StartRGB.B ;
OCurRGB:=StartRGB;
With Canvas do
begin
nbDgrad := 255;
Aband:=Clientrect;
if adgradOrientation = doVertical then
begin
Aband.Bottom:=Aband.Top;
if ClientRect.Bottom - ClientRect.Top < 255 then
nbDgrad := ClientRect.Bottom - ClientRect.Top;
end
else
begin
Aband.Right:=Aband.Left;
if ClientRect.Right - ClientRect.Left < 255 then
nbDgrad := ClientRect.Right - ClientRect.Left;
end;
Sy:=(ClientRect.Bottom-ClientRect.Top)/NbDgrad;
Sx:=(ClientRect.Right-ClientRect.Left)/NbDgrad;
for i:=0 to nbDgrad do // Degradé de um max. de 255 cores ...
begin
p:=i/NbDgrad;
CurRGB.R := StartRGB.R + round(p*DifRGB.R);
CurRGB.G := StartRGB.G + round(p*DifRGB.G);
CurRGB.B := StartRGB.B + round(p*DifRGB.B);
if (OCurRGB.R<>CurRgb.R) or
(OCurRGB.G<>CurRgb.G) or
(OCurRGB.B<>CurRgb.B) then
begin
Brush.color:=RGB(CurRGB.R,CurRGB.G,CurRGB.B);
FillRect(aBand);
if adgradOrientation = doVertical then
begin
aBand.Top:=aBand.Bottom;
aBand.Bottom:=Clientrect.Top+abs(Round(sy*i));
end
else
begin
aBand.left:=Aband.Right;
aBand.right:=Clientrect.left+abs(Round(sx*i));
end;
OCurRGB:=currgb;
end;
end;
Brush.color:=RGB(CurRGB.R,CurRGB.G,CurRGB.B);
FillRect(aBand);
end;
end;
Bon Coding...
ManChesTer.
31 mars 2005 à 12:12
1. Dégradé doVertical (lignes horizontals) sur un paintbox de dimension Witdh=25 Height=505 executé 99 fois:
ma fonction = 109 millisecondes
ta fonction = 15 millisecondes mais il y a un bug d' affichage dû à ton code qui n' execute que 25 la commande fillRect...
2. Dégradé doVertical (lignes horizontals) sur un paintbox de dimension Witdh=505 Height=505 executé 99 fois:
ma fonction = 109 millisecondes, normal puisque la hauteur est la même.
ta fonction = 2350 millisecondes surement dû au bug cité plus haut.
3. Dégradé doVertical (lignes horizontals) sur un paintbox de dimension Witdh=25 Height=25 executé 9999 fois:
ma fonction = 1172 millisecondes
ta fonction = 2110 millisecondes
Il est donc impossible de conclure pour l' instant mais, d' apres le dernier test, ta méthode est curieusement plus lente (on voit le paint s' executer plusieurs fois sur l' ecran alors que pour ma méthode, elle parait etre faite une seule fois).
30 mars 2005 à 17:03
procedure GradFill(canvas:Tcanvas;ClientRect:Trect;fromColor, toColor: TColor; adgradOrientation: TdgradOrientation);
var
aBand,Ort : TRect; { Bande rectangulaire de couleur courante }
i,nbDgrad,add : integer; { Compteur pour parcourir la hauteur de la fiche }
Sx,Sy : real;
Arr_StartRGB : array[0..2] of Byte; { RGB de la couleur de départ }
Arr_DifRGB : array[0..2] of integer; { RGB à ajouter à la couleur de départ pour atteindre la couleur de fin }
Arr_CurRGB : array[0..2] of Byte; { RGB de la couleur courante }
begin
// Calcul des valeurs RGB pour la couleur courante
Arr_StartRGB[0] := GetRValue(ColorToRGB( fromColor ));
Arr_StartRGB[1] := GetGValue(ColorToRGB( fromColor ));
Arr_StartRGB[2] := GetBValue(ColorToRGB( fromColor ));
// Calcul des valeurs à ajouter pour atteindre la couleur de fin
Arr_DifRGB[0] := GetRValue(ColorToRGB( toColor )) - Arr_StartRGB[0] ;
Arr_DifRGB[1] := GetgValue(ColorToRGB( toColor )) - Arr_StartRGB[1] ;
Arr_DifRGB[2] := GetbValue(ColorToRGB( toColor )) - Arr_StartRGB[2] ;
With Canvas do
begin
Pen.Style := psSolid;
Pen.Mode := pmCopy;
Pen.Width := 1;
nbDgrad := 255;
if adgradOrientation = doVertical then
if ClientRect.Bottom - ClientRect.Top < 255 then
nbDgrad := ClientRect.Bottom - ClientRect.Top
else
if ClientRect.Right - ClientRect.Left < 255 then
nbDgrad := ClientRect.Right - ClientRect.Left;
Aband:=Clientrect;
Sy:=(ClientRect.Bottom-ClientRect.Top)/NbDgrad;
Sx:=(ClientRect.Right-ClientRect.Left)/NbDgrad;
for i:= 0 to nbDgrad do // Degradé de um max. de 255 cores ...
begin
Arr_CurRGB[0] := (Arr_StartRGB[0] + MulDiv( i, Arr_DifRGB[0] , nbDgrad ));
Arr_CurRGB[1] := (Arr_StartRGB[1] + MulDiv( i, Arr_DifRGB[1] , nbDgrad ));
Arr_CurRGB[2] := (Arr_StartRGB[2] + MulDiv( i, Arr_DifRGB[2] , nbDgrad ));
Brush.color:=RGB(Arr_CurRGB[0], Arr_CurRGB[1], Arr_CurRGB[2]);
FillRect(aBand);
if adgradOrientation = doVertical then
begin
add:=Round(sy*i);
aBand.Top:=Clientrect.Top+add;
aBand.Bottom:=Clientrect.Top+add+i;
end
else
begin
add:=Round(sx*i);
aBand.left:=Clientrect.Left+add;
aBand.right:=Clientrect.Left+add+i;
end;
end;
end;
end;
Bon Coding...
ManChesTer.
30 mars 2005 à 15:28
Il permet d' occuper moins le CPU mais je ne sais pas pkoi, mais si tu fais un dgradé du blanc vers le noir, ce drnier sera plutôt gris. Donc, il y a comme un petit problème.
30 mars 2005 à 10:45
J' en sortirai d' autres non graphiques, mais j' etudie encore le potentiel dans divers manuels que j' ai:
Mastering Delphi - Marco Cantù
Delphi Developer's handbook - Marco Cantù/Tim Gooch/John F. Lam
Donc, mes manuels + exemples du net = bcp de travail preliminaire!
25 mars 2005 à 17:46
Arr_CurRGB[0] := Arr_StartRGB[0];
Arr_CurRGB[1] := Arr_StartRGB[1];
Arr_CurRGB[2] := Arr_StartRGB[2];
a virer...
Bon Coding....
ManChesTer.
25 mars 2005 à 17:45
j'ai un peux modifié ton code ca donne :
procedure GradFill(canvas:Tcanvas;ClientRect:Trect;fromColor, toColor: TColor; adgradOrientation: TdgradOrientation);
var
aBand : TRect; { Bande rectangulaire de couleur courante }
i,nbDgrad,Sx,Sy : integer; { Compteur pour parcourir la hauteur de la fiche }
Arr_StartRGB : array[0..2] of Byte; { RGB de la couleur de départ }
Arr_DifRGB : array[0..2] of integer; { RGB à ajouter à la couleur de départ pour atteindre la couleur de fin }
Arr_CurRGB : array[0..2] of Byte; { RGB de la couleur courante }
begin
// Calcul des valeurs RGB pour la couleur courante
Arr_StartRGB[0] := GetRValue(ColorToRGB( fromColor ));
Arr_StartRGB[1] := GetGValue(ColorToRGB( fromColor ));
Arr_StartRGB[2] := GetBValue(ColorToRGB( fromColor ));
// Calcul des valeurs à ajouter pour atteindre la couleur de fin
Arr_DifRGB[0] := GetRValue(ColorToRGB( toColor )) - Arr_StartRGB[0] ;
Arr_DifRGB[1] := GetgValue(ColorToRGB( toColor )) - Arr_StartRGB[1] ;
Arr_DifRGB[2] := GetbValue(ColorToRGB( toColor )) - Arr_StartRGB[2] ;
With Canvas do
begin
Pen.Style := psSolid;
Pen.Mode := pmCopy;
Pen.Width := 1;
nbDgrad := 255;
if adgradOrientation = doVertical then
if ClientRect.Bottom - ClientRect.Top < 255 then
nbDgrad := ClientRect.Bottom - ClientRect.Top
else
if ClientRect.Right - ClientRect.Left < 255 then
nbDgrad := ClientRect.Right - ClientRect.Left;
Aband:=Clientrect;
Sy:=(ClientRect.Bottom - ClientRect.Top) div NbDgrad+1;
Sx:=(ClientRect.Right - ClientRect.Left) div NbDgrad+1;
Arr_CurRGB[0] := Arr_StartRGB[0];
Arr_CurRGB[1] := Arr_StartRGB[1];
Arr_CurRGB[2] := Arr_StartRGB[2];
for i:= 0 to nbDgrad do // Degradé de um max. de 255 cores ...
begin
Arr_CurRGB[0] := (Arr_StartRGB[0] + MulDiv( i, Arr_DifRGB[0] , nbDgrad ));
Arr_CurRGB[1] := (Arr_StartRGB[1] + MulDiv( i, Arr_DifRGB[1] , nbDgrad ));
Arr_CurRGB[2] := (Arr_StartRGB[2] + MulDiv( i, Arr_DifRGB[2] , nbDgrad ));
Brush.color:=RGB(Arr_CurRGB[0], Arr_CurRGB[1], Arr_CurRGB[2]);
FillRect(aBand);
if adgradOrientation = doVertical then
begin
Inc(aBand.Top,sy);
Inc(aBand.Bottom,sy+1);
end
else
begin
Inc(aBand.left,sx);
Inc(aBand.right,sx+1);
end;
end;
end;
end;
Bon Coding...
ManChesTer.
24 mars 2005 à 19:53
24 mars 2005 à 18:33
merci MAURICIO.
ryl...
24 mars 2005 à 17:38
Ben, y a pas de quoi crier à la révolution non plus mais fallait y penser c' est tout :)
A+
24 mars 2005 à 17:06
jp
24 mars 2005 à 10:24
Pour faire le test, c' est assez simple.
Prenez la méthode pour faire le paint sur n' importe quel canvas (un TPaintBox par exemple) et faites 999 fois le refresh dans une boucle 'for'. Avec GetTickCount, on peut comparer le temps que ça mets.
Ensuite, refaites le test en obligeant à faire 255 fois comme ceci:
nbdgrad := 255;
for i:= 0 to nbDgrad do
A+ et merci encore une fois
24 mars 2005 à 08:19
J'ai retrouvé mon fond dégradé écrit en 1997, en Delphi 1 et en toute innocence !
Ben j'ai fait tout ce que tu dis qu'il faut pas faire pour aller vite ! God damned !
Ken@vo
N'empêche que c'est un composant !
23 mars 2005 à 23:18
Bravo ! ;)
@+
Nico
23 mars 2005 à 20:08
Je n'ai pas fait de comparatif direct avec d'autres méthodes, mais il me semble que la tienne est super rapide.
Et le rendu du dégradé est impeccable.
L'essayer, c'est l'adopter !
Bonne chance pour ton premier compo.
Il faudrait que je m'y mette aussi, bien que les compos soient un peu boudés sur le site. Et puis c'est pas un travail de "newbie", si l'on veut vraiment faire quelque chose de correct.
Merci pour ce code utile.
japee
23 mars 2005 à 17:29
type
TdgradOrientation = (doVertical, doHorizontal);