22 - DEGRADE DE COULEUR SUR UNE FICHE OU UN PANNEAU

Le petit coin du web de Nono40

http://nono40.developpez.com

SOURCES

PRÉSENTATION : Ce composant permet d'ajouter un dégradé de couleur sur le fond d'une fiche ou d'un panneau

ZIP : Téléchargez le zip

APERÇUS : -1.jpg-

NOTES : Installation :
Menu composant\Installer un composant et sélectionner le fichier Degradeur.pas comme nom d'unité.

Utilisation:
Il suffit de le placer sur n'importe quel composant pouvant servir de conteneur :
TForm, TGroupBox, TPanel
Le fond est alors transformé en dégradé de couleur.
Il faut le mettre en arrière plan ( click droit puis Options de contrôle\Mettre en arrière plan ) pour que tous les autres composants visuels soient visibles. Pensez aussi à mettre à True la propriété Transparent des TLabel.

CODE :

Unit Degradeur;

Interface

Uses Windows,Graphics,Classes,Controls;

Type
  // DegradeClass est dérivé de GraphicControl pour avoir une propriété Canvas perméttant de dessiner
  // ( au minimum un composant doit être descendant de TComponent pour apparaitre dans la palette )
  TDegradeClass = Class (TGraphicControl)
  Private
  // Variables internes au composant conservant la valeur des propriétés
    FStartColor : TColor;{ Couleur de départ pour le dégradé }
    FEndColor   : TColor;{ Couleur à atteindre pour le dégradé }
  // Procédures de mise à jour des variables ci dessus.
  // Elles sont appelées implicitement quand une propriété est écrite, elles permettent ainsi
  // de définir la réaction du composant au changement de valeur des propriétés
    Procedure SetStartColor (Valeur:TColor);
    Procedure SetEndColor   (Valeur:TColor);
  Protected
  // Le TGraphicControl implémente une procédure Paint qu'il faut surcharger pour
  // définir le dessin voulu du composant
    Procedure Paint; override;
  Public
  // Le constructeur Create permet d'initialiser le composant a sa création
  // Il n'est pas nécéssaire de le surcharger si aucun traitement supplémentaire n'est effectué
    Constructor Create(AOwner: TComponent); override;
  Published
  // Définition des propriété visible dans l'inspecteur d'objet
    Property StartColor:TColor read FStartColor Write SetStartColor;
    Property EndColor  :TColor read FEndColor   Write SetEndColor;
  End;

  // Définition de Register, c'est absolument indispensable pour une unité contenant un(des) composant(s)
Procedure Register;

Implementation

// On écrit alors les procédures de mise à jour des propriétés
// Dans la cas d'une modification réelle de la valeur interne
// on demande au composant de se redessiner
Procedure TDegradeClass.SetStartColor(Valeur:TColor);
Begin
  If Valeur<>FStartColor
  Then Begin
    FStartColor:=Valeur;
    Invalidate;
  End;
End;

Procedure TDegradeClass.SetEndColor(Valeur:TColor);
Begin
  If Valeur<>FEndColor
  Then Begin
    FEndColor:=Valeur;
    Invalidate;
  End;
End;

// Cette procédure en indispensable pour tous les controles visuels
// afin de définir l'aspect visuel du composant
Procedure TDegradeClass.Paint;
Var
  aBand : TRect;     { Bande rectangulaire de couleur courante        }
  i     : Integer;   { Compteur pour parcourir la hauteur de la fiche }
  FStartRGB   : Array[0..2] Of Byte;    { RGB de la couleur de départ }
  FCurrentRGB : Array[0..2] Of Byte;    { RGB de la couleur courante  }
  FDeltaRGB   : Array[0..2] Of Integer; { RGB à ajouter à la couleur de départ pour atteindre la couleur de fin }
Begin
  { Calcul des valeurs RGB pour la couleur courante }
  FStartRGB[0] := GetRValue( ColorToRGB( FStartColor ) );
  FStartRGB[1] := GetGValue( ColorToRGB( FStartColor ) );
  FStartRGB[2] := GetBValue( ColorToRGB( FStartColor ) );
  { Calcul des valeurs à ajouter pour atteindre la couleur de fin }
  FDeltaRGB[0] := GetRValue( ColorToRGB( FEndColor )) - FStartRGB[0];
  FDeltaRGB[1] := GetgValue( ColorToRGB( FEndColor )) - FStartRGB[1];
  FDeltaRGB[2] := GetbValue( ColorToRGB( FEndColor )) - FStartRGB[2];

  { Initialisation des dimensions de la bande de couleur }
  aBand.Left :=0;
  aBand.Right:=Width;
  { Boucle pour remplir la fiche courante en dégradé }
  With Canvas Do
  Begin
    Pen.Style:=psSolid;
    Pen.Mode:=pmCopy;
    For i:= 0 To 255
    Do Begin
      { Dimensions verticales de la bande }
      aBand.Top := MulDiv( i , Height , 256 );
      aBand.Bottom := MulDiv( i+1 , Height , 256 );
      { Calcul de la couleur courante }
      FCurrentRGB[0] := (FStartRGB[0] + MulDiv( i , FDeltaRGB[0] , 255 )) Mod 256;
      FCurrentRGB[1] := (FStartRGB[1] + MulDiv( i , FDeltaRGB[1] , 255 )) Mod 256;
      FCurrentRGB[2] := (FStartRGB[2] + MulDiv( i , FDeltaRGB[2] , 255 )) Mod 256;
      { Affichage sur la fiche }
      Brush.color:=RGB(FCurrentRGB[0],FCurrentRGB[1],FCurrentRGB[2]);
      FillRect(aBand);
    End;
  End;
End;

// Le contructeur permet surtout d'initialiser les valeurs par défaut
Constructor TDegradeClass.Create(AOwner: TComponent);
Begin
  Inherited Create(AOwner);
  FStartColor:=clBlue;
  FEndColor  :=clRed;
  Align      :=alClient; // Pour occuper toute la surface du Parent
End;

// Définition de la procédure Register enregistrant les nouvelles classes
// et les localise dans une palette
Procedure Register;
Begin
  RegisterComponents('Exemples',[TDegradeClass]);
End;

End.

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2003 Bruno Guérangé. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.