REALISER UN DEGRADE SUR PLUSIEURS COULEURS AVEC LES API WINDOWS

Commentaire de jlen100 le 28/01/2006 16:34:58

salut cirec,
intéressant.
pas mal l'effet toutefois 2/3 petites choses pas trop grave:
sous D7 cela ne se compile pas :
[Erreur] Gradients.pas(78): Les types des paramètres VAR originaux et formels doivent être identiques
alors que cela ne pose pas de probleme sous D2005 (je n'est pas testé sous D6 entreprise qui n'est pas installé sur ce PC et non raccordé au réseau)
evite de mettre un XPman qui n'est pas supporté par les version<D7 je crois (j'ai trouvé la "ruse" : mettre un fichier ressources du genre XPManifest.res et mettre :{$R XPManifest.res}
) l'effet est identique et supporté par toute les versions.
une petite remarque dans le fonctionnement de la demo (peut être du à mon PC) l'effet n'est pas instantanné quand on change de mode( qqs secondes pour avoir une stabilisation complète des couleurs).
à+
jlen

Commentaire de cirec le 28/01/2006 16:58:29 administrateur CS

@ Jlen chez moi c'est instantané et le XPManifest je l'ai juste mis pour montrer que ça le prenait aussi en compte (je ferais ce qu'il faut bientôt promis)
Pour le reste je vais essayer de voir ce que ça donne avec Delphi4
désolé je n'ai pas D7 pour faire les testes, j'ai ma petite idée sur le problème.
Par contre pour aujourd'hui ce ne sera peut être plus possible je dois me sauver
mais dès que je revient je me penche dessus et posterai une mise à jour

Commentaire de cirec le 29/01/2006 12:42:58 administrateur CS

@ Nicolas et Jlen,
Les modifications sont faites merci à vous deux

Il semblerait que les Dev de chez Borland aient fait des modifications sur certain type :
Color16 était déclaré comme Shortint alors que maintenant il semblerait qu'il soit de type Word.

Je l'ai testé Ok sur Delphi4.
Testez et tenez moi informé.
@+
Cirec

Commentaire de cirec le 29/01/2006 13:07:06 administrateur CS

Merci Jlen, je ne sais pas si tu as vu mais j'ai refait une mise à jour les re-déclaration de type sont maintenant dans la section Implémentation
Chez moi sur un P4 HT 3Ghz je ne remarque rien c'est immédiat ce qui ma un peut surpris je m'attendais justement à voir le rafraîchissement mais non c'est impeccable.

@+
Cirec

Commentaire de Nicolas___ le 30/01/2006 18:53:43

Ah ,
Merci Cirec pour avoir transforme le code pour qu il soit compatible Delphi7.
Et ben en tt cas vraiment excellente cette fonction  

Par contre tu peux mettre,

procedure TForm1.FormCreate(Sender: TObject);
begin
doublebuffered:=true;
end;

et

procedure TForm1.FormResize(Sender: TObject);
begin
Direction := TRadioButton(Sender).Tag;
Invalidate;
    GradientRect(Canvas.Handle,[cllime, clblack, clYellow, clRed], ClientRect, Direction);

end;

Ca permet comme on le voit tres bien de pouvoir modifier la taille de la form en faisant tjs le degrader

Le doublebuffered c est pr le scintillement

J ai une ATIRadeon 9600 pro et un athlon 1800+(donc pas terrible) et ya pas de prob

Commentaire de Nicolas___ le 30/01/2006 20:23:06

procedure TForm1.FormResize(Sender: TObject);
begin
  Invalidate;
end;
------> Oui Oui tt a fait d acc av toi je pense que j ai ete un peu trop vite ...
Allez, Ciao et Re-Merci !

Nico

Commentaire de jlen100 le 30/01/2006 20:34:52

c'est ce que j'ai constaté le fondu est meilleurs sur un  crt
que sur un TFT Remarque aussi que le photos ont bien souvent un meilleurs rendu sur un crt (saturation des couleurs moins importante)
@+
jlen

Commentaire de jlen100 le 30/01/2006 21:09:39

en fait je pense que çà vient du mode de reproduction des couleurs:
sur un crt chaque pixel posséde 3 lumiphores exités par le flux d'électrons et en fait ce flux ou plutot le flux secondaire emis exite les lumiphores adjacents ce qui produit une sorte de "flou"
alors de dans les TFT ou les LCD chaque pixel est activé par la matrice.
tout ce passe comme si dans une image on passait directement d'une couleur à une autre sans zone de transition (exemple d'une image détourée mise sur un fond uni: l'effet n'est pas naturel) c'est pour cela que les logiciel de retouche photo procede à un dégradé de la zone de transition.
comme quoi le mieux est l'ennemi du bien!!
@+
jlen

Commentaire de f0xi le 19/02/2006 14:23:06 administrateur CS

unit GRADIENT.PAS

modification de la structure _TRIVERTEX :

  _TRIVERTEX = Packed Record
    X,Y : Longint;
    Red, Green, Blue, Alpha: COLOR16;
  End;

on aurait egalement pus faire :

  _TRIVERTEX = Record
    Coord : TPoint;
    Red, Green, Blue, Alpha: COLOR16;
  End;
_________________________________________

Ajout de methodes pour le type TTRIVERTEX :

procedure PointTVX(out TVX : TTriVertex; const aX,aY : LongInt); forward;
Procedure ColorTVX(out TVX : TTriVertex; const aRed,aGreen,aBlue : COLOR16; const aAlpha : COLOR16 = 0); overload; forward;
Procedure ColorTVX(out TVX : TTriVertex; const aCol : TColor; const aAlpha : COLOR16 = 0); overload; forward;
procedure TriVertexP(out TVX : TTriVertex; const aX,aY : LongInt;const aRed,aGreen,aBlue : COLOR16; const aAlpha : COLOR16 = 0); overload; forward;
procedure TriVertexP(out TVX : TTriVertex; const aX,aY : LongInt;const aCol : Tcolor; const aAlpha : COLOR16 = 0); overload; forward;
function TriVertexF(const aX,aY : LongInt;const aRed,aGreen,aBlue : COLOR16; const aAlpha : COLOR16 = 0) : TTriVertex; overload; forward;
function TriVertexF(const aX,aY : LongInt;const aCol : Tcolor; const aAlpha : COLOR16 = 0) : TTriVertex; overload; forward;

// permet de definir rapidement les coordonées
procedure PointTVX(out TVX : TTriVertex; const aX,aY : LongInt);
begin
  TVX.X := aX;
  TVX.Y := aY;
end;

// permet de definir rapidement la couleur
Procedure ColorTVX(out TVX : TTriVertex; const aRed,aGreen,aBlue : COLOR16; const aAlpha : COLOR16 = 0);
begin
  With TVX do begin
    Red   := aRed;
    Green := aGreen;
    Blue  := aBlue;
    Alpha := aAlpha
  end;
end;

// en incluant les traitements
Procedure ColorTVX(out TVX : TTriVertex; const aCol : TColor; const aAlpha : COLOR16 = 0);
begin
  With TVX do begin
    Red   := GetRValue(aCol) Shl 8;
    Green := GetGValue(aCol) Shl 8;
    Blue  := GetBValue(aCol) Shl 8;
    Alpha := aAlpha
  end;
end;

// permet de definir rapidement un element TTriVertex

procedure TriVertexP(out TVX : TTriVertex; const aX,aY : LongInt;const aRed,aGreen,aBlue : COLOR16; const aAlpha : COLOR16 = 0);
begin
  PointTVX(TVX,aX,aY);
  ColorTVX(TVX,aRed,aGreen,aBlue,aAlpha);
end;

procedure TriVertexP(out TVX : TTriVertex; const aX,aY : LongInt;const aCol : TColor; const aAlpha : COLOR16 = 0);
begin
  PointTVX(TVX,aX,aY);
  ColorTVX(TVX,aCol,aAlpha);
end;

function TriVertexF(const aX,aY : LongInt;const aRed,aGreen,aBlue : COLOR16; const aAlpha : COLOR16 = 0) : TTriVertex;
begin
  PointTVX(result,aX,aY);
  ColorTVX(result,aRed,aGreen,aBlue,aAlpha);
end;

function TriVertexF(const aX,aY : LongInt;const aCol : TColor; const aAlpha : COLOR16 = 0) : TTriVertex;
begin
  PointTVX(result,aX,aY);
  ColorTVX(result,aCol,aAlpha);
end;
_________________________________________

ajout de methode pour TGRADIENTTRIANGLE :

procedure GradientTriP(out aGT : TGRADIENTTRIANGLE; const Vx1, Vx2, Vx3 : cardinal);
begin
  aGT.Vertex1 := Vx1;
  aGT.Vertex2 := Vx2;
  aGT.Vertex3 := Vx3;
end;

function GradientTriF(const Vx1, Vx2, Vx3 : cardinal) : TGRADIENTTRIANGLE;
begin
  result.Vertex1 := Vx1;
  result.Vertex2 := Vx2;
  result.Vertex3 := Vx3;
end;
_________________________________________

Ajout de methodes pour le type TGRADIENTRECT :

procedure GradientRect(out aGR : TGRADIENTRECT; const aUL,aLR : cardinal);
begin
  aGR.UpperLeft := aUL;
  aGR.LowerRight:= aLR;
end;
_________________________________________

Modifications en consequence :

{ **** }

Function GradientRect(Dc: THandle; ColorArray: Array Of TColor; aRect: TRect; Direction: Integer): Boolean;
Var Idx, aHeight, aWidth, nbCycle,pX,pY : Integer;
  Vert  : Array Of TTrivertEx;
  gRect : Array Of TGRADIENTRECT;
Begin
  nbCycle := Length(ColorArray);
  SetLength(Vert, nbCycle);
  SetLength(gRect, nbCycle - 1);
  aHeight := GetRectHeight(aRect);
  aWidth  := GetRectWidth(aRect);
  PX := 0;
  PY := 0;
  For Idx := 0 To High(Vert) Do begin
      Case Direction Of
        GRADIENT_FILL_RECT_V : Begin
           If Idx Mod 2 = 0 Then pX := 0 Else pX := aWidth;
           pY := Round(aHeight / (nbCycle - 1) * Idx);
        End;
        GRADIENT_FILL_RECT_H : Begin
           If Idx Mod 2 = 0 Then pY := 0 Else pY := aHeight;
           pX := Round(aWidth / (nbCycle - 1) * Idx);
        End;
      End;
      TriVertexP(Vert[Idx],PX,PY, ColorArray[Idx]);
  End;

  For Idx := 0 To High(gRect) Do
      GradientRect(gRect[Idx],Idx,Idx + 1);

  Result := GradientFill( Dc, PTRIVERTEX(vert), nbCycle, PGradientRect(gRect), nbCycle-1, Direction);
End;

{ **** }

Procedure InitTriSequence;
Var I : Integer;
Begin
  For I := 1 To High(TriSequence) Do Begin
      SetLength(TriSequence[I], I);
  End;

  For I := 1 To 8 Do Begin
      if I in [1..8]    then GradientTriP(TriSequence[I][0],0,1,2);
      if I in [2,6..8]  then GradientTriP(TriSequence[I][1],0,2,3);
      if I in [3..5]    then GradientTriP(TriSequence[I][1],1,2,3);
      if I in [4..8]    then GradientTriP(TriSequence[I][2],2,3,4);
      if I in [5..8]    then GradientTriP(TriSequence[I][3],2,4,5);
      if I in [6..8]    then GradientTriP(TriSequence[I][4],2,5,6);
      if I in [7,8]     then GradientTriP(TriSequence[I][5],2,6,7);
      if I in [3,4]     then GradientTriP(TriSequence[I][I-1],0,2,4);
      if I in [5..8]    then GradientTriP(TriSequence[I][I-1],0,2,I);
  End;
  GradientTriP(TriSequence[8][6],2,7,8);
End;

{ **** }

Procedure GetVertPos(Var Vert: Array Of TTrivertEx; aRect: TRect);
Var nbCycle, aHeight, aWidth: Integer;
Begin
  aHeight := GetRectHeight(aRect);
  aWidth  := GetRectWidth(aRect);
  nbCycle := Length(Vert);

  PointTVX(Vert[0],aRect.Left,aRect.Top);

  if nbCycle IN [3..5] then begin
     PointTVX(Vert[1],aRect.Right,aRect.Top);
  end;

  if nbCycle IN [3..4] then begin
     PointTVX(Vert[2],aRect.Right,aRect.Bottom);
  end;

  if nbCycle IN [5..9] then begin
     PointTVX(Vert[2],aWidth Div 2,aHeight Div 2);
  end;

  if nbCycle IN [6..9] then begin
     PointTVX(Vert[1],aWidth Div 2,aRect.Top);
     PointTVX(Vert[3],aRect.Right,aRect.Top);
  end;

  if nbCycle IN [7..9] then begin
     PointTVX(Vert[4],aRect.Right,aHeight Div 2);
     PointTVX(Vert[5],aRect.Right,aRect.Bottom);
  end;

  if nbCycle IN [8..9] then begin
     PointTVX(Vert[6],aWidth Div 2,aRect.Bottom);
     PointTVX(Vert[7],aRect.Left,aRect.Bottom);
  end;

  if nbCycle = 4 then
     PointTVX(Vert[3],aRect.Left,aRect.Bottom);

  if nbCycle = 5 then begin
     PointTVX(Vert[3],aRect.Right,aRect.Bottom);
     PointTVX(Vert[4],aRect.Left,aRect.Bottom);
  End;

  if nbCycle = 6 then begin
        PointTVX(Vert[4],aRect.Right,aRect.Bottom);
        PointTVX(Vert[5],aRect.Left,aRect.Bottom);
  End;

  if nbCycle = 7 then
     PointTVX(Vert[6],aRect.Left,aRect.Bottom);

  if nbCycle = 9 then begin
     PointTVX(Vert[6],aWidth Div 2,aRect.Bottom);
     PointTVX(Vert[8],aRect.Left,aHeight Div 2);
  End;
End;

{ **** }

Function GradientTriangle(Dc: THandle; ColorArray: Array Of TColor; aRect: TRect): Boolean;
Var Idx, nbCycle, NbTriCycle: Integer;
    Vert : Array Of TTrivertEx;
Begin
  nbCycle := Length(ColorArray);
  If NbCycle > 9 Then NbCycle := 9;
  SetLength(Vert, nbCycle);
  GetVertPos(Vert, aRect);
  For Idx := 0 To High(Vert) Do
      ColorTVX(Vert[Idx],ColorArray[Idx]);

  If NbCycle > 4 Then
     NbTriCycle := NbCycle - 1
  Else
     NbTriCycle := NbCycle - 2;

  GradientFill(dc, PTRIVERTEX(vert), NbCycle,
  PGRADIENTTRIANGLE(TriSequence[NbTriCycle]), NbTriCycle, GRADIENT_FILL_TRIANGLE);
End;



voila pour celle ci au niveau optimisation / completion, tu remarqueras que tous les ajouts de methodes ne sont pas utilisés.
je les ais laissés juste a titre d'exemple.

d'ailleur je conseil a tout le monde qui voudrais créer une petite ou grande structure "record"
de creer egalement les fonctions/procedure permettant d'ameliorer et optimiser le code, exemple :

TIdentity = record
  nom,prenom : string;
  DdN : tdatetime;
end;

procedure Identity(out aID : TIdentity; const aNom,aPrenom : string; cont aDdN : TDateTime);
begin
  aID.nom := aNom;
  aID.prenom := aPrenom;
  aID.DdN := aDdN;
end;

cela permet d'augementer la rapiditée d'ecriture de code et egalement d'alleger celui ci.

Commentaire de cirec le 19/02/2006 15:02:53 administrateur CS

Salut F0xi,
Merci de t'être penché sur ma source.
Que dire ?  wouaou ça fait beaucoup de changements d'un coup pour ma petite tête ;-)
je vais de ce pas tester le tout et dès que c'est fait je te tiens au courant.
une petite question toute fois :
Jlen ma signalé un problème dans la gestion des briques de couleurs sous D7, lors de la suppression d'une où plusieurs de ces briques (non mise à jour de l'affichage) et en retirant le fichier WinXP.res le problème serait résolue.
alors as-tu également ce genre de problème parce que moi j'ai aucun soucis à ce niveau
ni sous D4 ni sous D9 ?

@+
Cirec

Commentaire de cirec le 19/02/2006 16:40:41 administrateur CS

@ Jlen
je vais verifier tout ça et je te tiens au courrant.

@ F0xi
premiere modification testé j'ai été obligé d'apporté un petit changement si non il refusait de compiler :
// le nom de cette procedure est passé de GRect à GrdRect
// puisqu'il y avait confusion par le compilateur dans la procedure GradientRect avec
// le tableau dynamique gRect
procedure GrdRect(out aGR : TGRADIENTRECT; const aUL,aLR : cardinal);
begin
  aGR.UpperLeft := aUL;
  aGR.LowerRight:= aLR;
end;

Function GradientRect(Dc: THandle; ColorArray: Array Of TColor; aRect: TRect; Direction: Integer): Boolean;
Var Idx, aHeight, aWidth, nbCycle,pX,pY : Integer;
  Vert  : Array Of TTrivertEx;
  gRect : Array Of TGRADIENTRECT;

Begin
  nbCycle := Length(ColorArray);

  SetLength(Vert, nbCycle);
  SetLength(gRect, nbCycle - 1);

  aHeight := GetRectHeight(aRect);
  aWidth  := GetRectWidth(aRect);
  PX := 0;
  PY := 0;

  For Idx := 0 To High(Vert) Do begin
      Case Direction Of
        GRADIENT_FILL_RECT_V : Begin
           If Idx Mod 2 = 0 Then pX := 0 Else pX := aWidth;
           pY := Round(aHeight / (nbCycle - 1) * Idx);
        End;
        GRADIENT_FILL_RECT_H : Begin
           If Idx Mod 2 = 0 Then pY := 0 Else pY := aHeight;
           pX := Round(aWidth / (nbCycle - 1) * Idx);
        End;
      End;
      TriVertexP(Vert[Idx],PX,PY, ColorArray[Idx]);
  End;

  For Idx := 0 To High(gRect) Do
      GrdRect(gRect[Idx],Idx,Idx + 1);

  Result := GradientFill( Dc, PTRIVERTEX(vert), nbCycle, PGradientRect(gRect), nbCycle-1, Direction);
End;

et les deux fonctions : GetRectHeight et GetRectWidth sont inconue mais bon c'est pas un problème c'est fait et ça fonctionne.

Je teste la suite et je reviens vous en dire plus

@+
Cirec

Commentaire de cirec le 19/02/2006 19:41:28 administrateur CS

Voilà, la mise à jour est faite sur les propositions de F0xi,
du coup toute l'unité a été réécrite mais je vous laisse
pour l'instant l'ancienne version en commentaire pour pouvoir voir et comprendre
ce qui a été fait.
Le bug découvert par Jlen est également corrigé.

J'ai l'impression que les performances d'affichage sont meilleurs, a vous de juger.
Dites moi ce que vous en pensez.

@+
Cirec

Commentaire de jlen100 le 24/03/2006 21:07:48

salut Cirec,
Wolf a encore fait des siennes (son commentaire a été supprimé mais j'ai eu le temps de le lire) C'est le spécialiste des posts hors sujet : celà ne mérite même pas la peine d'y répondre. Un jour peut-être il comprendra que les commentaires ou critiques ont pour but d'améliorer les sources et que les critiques sans fondements n'apportent rien

@+
jlen

Commentaire de jlen100 le 24/03/2006 21:44:41

oui sans la notification automatique je l'aurais surement loupé
@+
jlen

Commentaire de jlen100 le 22/04/2006 10:51:01

ce n'est pas la même fonction avec un composant TImage tu n'as qu'un dégradé sinon il te faudra autant de Timage que de dégradé avec la fonction de cirec tu fais varier ton dégradé en dymanique avec un Timage c'est impossible
ce n'est pas plus difficile que de charger une image dans le picture puisqu'il te suffit d'appeler la procédure avec les bons paramètres

@+
jlen

Commentaire de Toya78 le 04/01/2007 19:09:20

Une seule chose à dire : MA-GNI-FIQUE !

Superbe source ! J'applaudis des 2 mains et des 2 pieds !

Bravo ! :)

Commentaire de Bacterius le 03/05/2008 22:10:31

Bon, j'ai laissé tomber le composant, trop dur à faire, quelqu'un pourrait-t-il m'expliquer les grandes lignes "conception d'un composant" car j'y comprends rien, à chaque fois j'ai 20 messages d'erreur :x

Sinon j'en ai fait une unité, que j'ai mis dans le dossier delphi, je peux facilement faire des bôs dégradés maintenant merci beaucoup Cirec pour ce joli code :)

Cordialement, Bacterius !

Commentaire de Bacterius le 04/05/2008 17:02:39

Bonjour,
j'ai juste un peu arrangé le code, qui beugeait un petit peu pour moi. Et puis j'ai bloqué les dégradés horizon/vertical avec 1 seule couleur, et les dégradés triangulaires avec moins de 4 couleurs (il est coupé).
C'est tout pour l'unité.
Et j'ai essayé de faire une application autour de ca aussi.
C'est dommage qu'on puisse pas faire de dégradé polygonal, et circulaire ... Il doit exister un moyen de le faire, je vais me renseigner :)

Ce code m'a redonné le gout de la programmation graphique :)

Cordialement, Bacterius !

Commentaire de ThWilliam le 08/05/2008 19:21:04

Salut Cirec.

Je n'ai pas encore eu le temps de regarder le code, mais le résultat est magnifique. Je sens que cela va me servir...
Bravo.

Commentaire de cincap le 20/11/2008 07:38:36

Bonjour à toutes et à tous,

@ Cirec, bon c'est OK, j'ai trouvé une parade qui fonctionne correctement.

@+,

Cincap

Commentaire de cincap le 20/11/2008 15:45:35

Bonjour à toutes et à tous,

@Cirec, merci d'avoir répondu, j'avais ajouté cette ligne ce qui me semble quif quif.

Procedure Tfrm_Color.AddBrique(Value: TColor);
Begin
  
  if value = $00000000 then value := value + 1 ;

  @+,

Cincap