Bouton de couleur essai scanline

Description

Bouton de couleur relief: bosse ou creux avec effet click.
Encore un, mais avec scanline.
Exemple qui permet de choisir la couleur du bouton.
L'effet n'est pas souvent visible à l'exécution, seulement avec menu surgissant par exemple.

Source / Exemple :


unit MonBoutonCouleur;                                     {bouton de couleur créé avec scanline et incrémentation}
                                                           {relief avec effet au click}
interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, ExtCtrls, ExtDlgs, Spin, FileCtrl, ComCtrls;

Const
   PixelCountMax=32768;                                    {Nombre maxi de pixels}

TYPE
   pRGBTripleArray=^TRGBTripleArray;                       {Nom de pointeur}
   TRGBTripleArray=ARRAY[0..PixelCountMax-1]of TRGBTRIPLE; {sur l'ensemble des pixels}
   TGlyphSite = (GLLeft, GLRight);                         {Position du Glypf : droite ou gauche}

type
  TMonBoutonCouleur = class(TGraphicControl)               {Le bouton}

  private                                                  { Déclarations privées }
    { Déclarations privées }                               { Déclarations privées }
    FBTimer:TTimer;                                        {Le timer pour le click sur bouton}
    FBTimerEnabled:Boolean;                                {On le met ou pas}
    FBTimerTemp:Integer;                                   {la temporisation du timer}
    FBCaption: TCaption;                                   {Caption du bouton}
    FBBosse : Boolean;                                     {Bouton en relief}
    SavFBBosse:boolean;                                    {Variable pour arréter le clignotement du bouton}
    FBMarge:Integer;                                       {Largeur de la laie pour l'écriture}
    FBPourCent:Integer;                                    {Relief du bouton(de 0 à 100) }
    FBROUGE:Byte;                                          {Le rouge}
    FBVERT:Byte;                                           {le vert}
    FBBLEU:Byte;                                           {le bleu}
    FBColor:Tcolor;                                        {Couleur du cadre}
    FBGlyphSite:TGlyphSite;                                {position du glyph}
    FBGLyph:TBitmap;                                       {le glyph}
    Procedure SETBTimerEnabled(Value:boolean);             {Mise en route ou pas du timer}
    Procedure SETBTimerTemp(Value:integer);                {récupération de la durée de tempo}
    Procedure SETBBosse(Value:Boolean);                    {en relief ou inversé}
    Procedure SETBPourCent(Value:Integer);                 {La hauteur de relief}
    Procedure SETBMarge(Value:Integer);                    {la largeur de laie}
    Procedure SETBROUGE(Value:Byte);                       {le rouge}
    Procedure SETBVERT(Value:Byte);                        {le vert}
    Procedure SETBBLEU(Value:Byte);                        {le bleu}
    Procedure SETBColor(Value:TColor);                     {couleur du cadre}
    procedure SETBCaption(Value: TCaption);                {caption}
    procedure SETBGlyph(Value:TBitmap);                    {glyph}
    procedure SETBGlyphSite(Value:TGlyphSite);             {position du glyph}
  protected                                                { Déclarations protégées }
    { Déclarations protégées }                             { Déclarations protégées }
    procedure Paint; override;                             {on reécrit paint}
    Procedure OnTimer(Sender:TObject);Virtual;             {Procedure pour le clignotement du bouton au click}
    Procedure TransformeBouton(Var Rouge, Vert, Bleu:Byte; {Modification du bouton avec scanline}
          Marge:Integer;FPourCent:integer;FBosse:boolean;M:string);{avec les variables utilisées}
  public                                                   { Déclarations publiques }
    { Déclarations publiques }                             { Déclarations publiques }
    constructor Create(AOwner:TComponent); override;       {construction du bouton}
    Destructor Destroy;Override;                           {suppression du bouton}
    Procedure Click;Override;                              {le click est revu}
    Procedure DblClick;Override;                           {le double click idem}
  published                                                { Déclarations publiées }
    { Déclarations publiées }                              { Déclarations publiées }
   Property TimerEnabled:Boolean READ FBTimerEnabled WRITE SETBTimerEnabled;{Modifier FBTImerEnabled}
   Property TimerTemp:Integer READ FBTimerTemp WRITE SETBTimerTemp;{Modifier la tempo}
   property Propriete:boolean READ FBBosse WRITE SETBBosse;{modifier : Bosse ou creux}
   Property PourCent:Integer READ FBPourCent WRITE SETBPourCent;{modifier la profondeur du relief}
   Property Marge:integer READ FBMarge WRITE SETBMarge;    {modifier la largeur de laie}
   Property ROUGE:Byte READ FBROUGE WRITE SETBROUGE;       {modifier le rouge}
   Property VERT:Byte READ FBVERT WRITE SETBVERT;          {modifier le vert}
   Property BLEU:Byte READ FBBLEU WRITE SETBBLEU;          {modifier le bleu}
   property Glyph:TBitmap READ FBGLyph WRITE SETBGlyph;    {changer de glyph}
   Property GlyphSite:TGlyphSite READ FBGlyphSite WRITE SETBGlyphSite;{modifier la position du glyph}
   property Caption: TCaption read FBCaption  WRITE SETBCaption;{modifier le caption}
   property Color: TColor READ FBColor WRITE  SETBColor;   {modifier la couleur du cadre}
   property Align;                                         {align}
   property Cursor;                                        {Curseur}
   property DragCursor;                                    {Image du pointeur souris}
   property DragMode;                                      {comportement glisser-déplacer d'un contrôle}
   property Enabled;                                       {Détermine si le contrôle répond aux événements de souris, du clavier et du timer}
   property Font;                                          {Fonte de l'écriture}
   property Hint;                                          {Spécifie la chaîne de texte apparaissant dans la boîte de conseil}
   property ParentFont;                                    {Détermine comment un contrôle trouve ses attributs de fonte}
   property ParentShowHint;                                {Détermine comment un contrôle décide s'il faut ou non afficher le texte de son conseil}
   property PopupMenu;                                     {Identifie le menu surgissant associé à la colonne}
   property Visible;                                       {Détermine si le composant apparaît à l'écran}
   property OnClick;                                       {Se produit quand l'utilisateur clique sur le contrôle}
   property OnDblClick;                                    {Se produit quand l'utilisateur double clique sur le contrôle}
   property OnMouseDown;                                   {utilisateur appuie sur un bouton de la souris alors que le pointeur de la souris est au-dessus d'un contrôle}
   property OnMouseMove;                                   {utilisateur déplace le pointeur de la souris au-dessus d'un contrôle}
   property OnMouseUp;                                     {utilisateur relâche un bouton de la souris qui a été enfoncé alors que le pointeur de la souris se trouvait au-dessus d'un composant}
end;                                                       {Fin des déclarations}

procedure Register;                                        {Enregistrer le composant}

Var                                                        {déclaration de variable}
   Image: TImage;                                          {image du bouton}

implementation

Procedure Controle(Var Rouge:Byte;Var Vert:Byte;Bleu:Byte);{contrôle des limites RVB}
begin                                                      {début de contrôle}
   If Rouge>255 then Rouge:=255 else if Rouge<0 then Rouge:=0;{pas >255 ni <0 }
   If Vert>255 then Vert:=255 else if Vert<0 then Vert:=0; {pas >255 ni <0 }
   If Bleu>255 then Bleu:=255 else if Bleu<0 then Bleu:=0; {pas >255 ni <0 }
end;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.SETBTimerEnabled(Value:boolean);{Mise en route ou pas du timer}
Begin                                                      {début de procédure}
   If Value<>FBTimerEnabled then                           {si la valeur a changée alors}
   FBTimerEnabled:=Value;                                  {On récupère la valeur}
   If CsDesigning In ComponentState then                   {si on est en conception du bouton alors}
   begin                                                   {début}
      FBTimer.Enabled:=false;                              {le timer ne démarre pas}
      exit;                                                {on sort}
   end;                                                    {fin}
   FBTImer.Enabled:=FBTimerEnabled;                        {si non on modifie suivant valeur}
end;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.SETBTimerTemp(Value:integer);  {récupération de la durée de tempo}
begin                                                      {début de procédure}
   if Value<>FBTimerTemp then                              {si la valeur a changée alors}
   FBTimerTemp:=Value;                                     {On récupère la valeur}
   FBTimer.Interval:=FBTimerTemp;                          {on modifie suivant valeur}
   If CsDesigning in componentState then                   {si on est en conception du bouton alors}
   begin                                                   {début}
      FBTimer.Enabled:=false;                              {le timer ne démarre pas}
      exit;                                                {on sort}
   end;                                                    {fin}
end;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.Ontimer(Sender:Tobject);       {Procedure pour le clignotement du bouton au click}
Begin                                                      {début de procédure}
   FBBosse:=Not FBBOsse;                                   {On inverse la relief du bouton d'entrée}
   If CsDesigning in componentState then                   {si on est en conception du bouton alors}
   begin                                                   {début}
      FBTimer.Enabled:=false;                              {le timer ne démarre pas}
      exit;                                                {on sort}
   end;                                                    {fin}
   Invalidate;                                             {Demande à Windows de repeindre le contrôle}
end;                                                       {fin de procédure}

procedure TMonBoutonCouleur.SETBCaption(Value: TCaption);  {modifier le caption}
begin                                                      {début de procédure}
   if Value <> FBCaption then                              {si la valeur a changée alors}
   begin                                                   {début}
      FBCaption := Value;                                  {On récupère la valeur}
      Invalidate;                                          {Demande à Windows de repeindre le contrôle}
   end;                                                    {fin}
end;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.SETBBosse(Value:Boolean);      {en relief ou inversé}
Begin                                                      {début de procédure}
   if Value <> FBBosse then                                {si la valeur a changée alors}
   begin                                                   {début}
      FBBosse := Value;                                    {On récupère la valeur}
      SavFBBosse:=Value;                                   {Une sauvegarde pour arréter la tempo}
      Invalidate;                                          {Demande à Windows de repeindre le contrôle}
   end;                                                    {fin}
End;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.SETBPourCent(Value:Integer);   {La hauteur de relief}
Begin                                                      {début de procédure}
   If Value<0 then Value:=0 else if Value>100 then Value:=100;{contrôle des limites}
   if Value <> FBPourCent then                             {si la valeur a changée alors}
   begin                                                   {début}
      FBPourCent := Value;                                 {On récupère la valeur}
      Invalidate;                                          {Demande à Windows de repeindre le contrôle}
   end;                                                    {fin}
End;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.SETBMarge(Value:Integer);      {modifier la largeur de laie}
Begin                                                      {début de procédure}
   If Value<0 then Value:=0 else if Value>100 then Value:=100;{contrôle des limites}
   if Value <> FBMarge then                                {si la valeur a changée alors}
   begin                                                   {début}
      FBMarge := Value;                                    {On récupère la valeur}
      Invalidate;                                          {Demande à Windows de repeindre le contrôle}
   end;                                                    {fin}
End;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.SETBROUGE(Value:Byte);         {modifier le rouge}
Begin                                                      {début de procédure}
   if Value <> FBROUGE then                                {si la valeur a changée alors}
   begin                                                   {début}
      FBROUGE := Value;                                    {On récupère la valeur}
      Invalidate;                                          {Demande à Windows de repeindre le contrôle}
   end;                                                    {fin}
End;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.SETBVERT(Value:Byte);          {modifier le Vert}
Begin                                                      {début de procédure}
   if Value <> FBVERT then                                 {si la valeur a changée alors}
   begin                                                   {début}
      FBVERT := Value;                                     {On récupère la valeur}
      Invalidate;                                          {Demande à Windows de repeindre le contrôle}
   end;                                                    {fin}
End;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.SETBBLEU(Value:Byte);          {modifier le Bleu}
Begin                                                      {début de procédure}
   if Value <> FBBLEU then                                 {si la valeur a changée alors}
   begin                                                   {début}
      FBBLEU := Value;                                     {On récupère la valeur}
      Invalidate;                                          {Demande à Windows de repeindre le contrôle}
   end;                                                    {fin}
End;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.SETBColor(Value:TColor);       {couleur du cadre}
Begin                                                      {début de procédure}
   if Value <> FBColor then                                {si la valeur a changée alors}
   begin                                                   {début}
      FBColor := Value;                                    {On récupère la valeur}
      Invalidate;                                          {Demande à Windows de repeindre le contrôle}
   end;                                                    {fin}
end;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.SETBGlyphSite(Value:TGlyphSite);{position du glyph}
begin                                                      {début de procédure}
   If FBGlyphSite<>Value then                              {si la valeur a changée alors}
   FBGlyphSite:=Value;                                     {On récupère la valeur}
   Invalidate;                                             {Demande à Windows de repeindre le contrôle}
end;                                                       {fin de procédure}

procedure TMonBoutonCouleur.SetBGlyph(Value:TBitmap);      {adresse du glyph}
begin                                                      {début de procédure}
   FBGlyph.Assign(Value);                                  {on récupère l'adresse du glyph}
   Invalidate;                                             {Demande à Windows de repeindre le contrôle}
end;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.Click;                         {Click sur bouton}
Begin                                                      {début de procédure}
   If FBTimerEnabled=true then                             {Si on peut mettre le timer en route}
   FBTimer.Enabled:=true;                                  {on le fait pour que le bouton clignote avant}
   InHerited Click;                                        {que l'on effectue les autres instructions}
end;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.DblClick;                      {double click sur bouton}
Begin                                                      {début de procédure}
   If FBTimerEnabled=true then                             {Si on peut mettre le timer en route}
   FBTimer.Enabled:=true;                                  {on le fait pour que le bouton clignote avant}
   InHerited DblClick;                                     {que l'on effectue les autres instructions}
end;                                                       {fin de procédure}

Procedure TMonBoutonCouleur.TransformeBouton(Var Rouge, Vert, Bleu:Byte;{Modification du bouton avec scanline}
          Marge:Integer;FPourCent:integer;FBosse:boolean;M:string);{avec les variables utilisées}
VAR                                                        {Déclaration de variables utilisées}
   MonBitmap : TBitmap;                                    {bitmap}
   i : INTEGER;                                            {X avec scanline}
   j : INTEGER;                                            {y avec scanline}
   row : pRGBTripleArray;                                  {Bitmap entier}
   ScanlineBytes: INTEGER;                                 {scanline}
   Coef:array[1..3,1..2]of real;                           {coef pour les 3 couleurs et bosse avec ou sans}
   Coefi:array[1..3]of real;                               {coef pour les calculs des 3 couleurs}
   Laie,Posit : integer;                                   {Laie et position}
   R,G,B:Byte;                                             {3 couleurs en byte}
   R1,G1,B1:Byte;                                          {3 couleurs en byte pour les calculs}
   T:integer;                                              {le % pour le relief}
   Re:Trect;                                               {rectangle}
   RGN:HRGN;                                               {HRGN}
   W,H:integer;                                            {Largeur hauteur}
   CourantGlyph:^TBitmap;                                  {Pointeur sur Glyph}
   WBg,HBg,TBg,LBg:integer;                                {Largeur, hauteur, top, left}
begin                                                      {début de procédure}
   W:=Width;                                               {Initialisation}
   H:=Height;                                              {Initialisation}
   T:=FPourCent;                                           {Initialisation}
   R:=Rouge;                                               {Initialisation}
   G:=Vert;                                                {Initialisation}
   B:=Bleu;                                                {Initialisation}
   coef[1,1]:=(255-R)/100;                                 {calcul du coef R et bosse}
   coef[2,1]:=(255-G)/100;                                 {calcul du coef V et bosse}
   coef[3,1]:=(255-B)/100;                                 {calcul du coef B et bosse}
   coef[1,2]:=R/100;                                       {calcul du coef R et creux}
   coef[2,2]:=G/100;                                       {calcul du coef V et creux}
   coef[3,2]:=B/100;                                       {calcul du coef B et creux}
   Laie:=round((Height-1)/2)-Marge;                        {Calcul de la laie au milieu pour l'écriture du texte}
   Case Fbosse of                                          {En fonction de FBBosse}
      True : begin                                         {vrai alors}
         R1:=R-round(T*Coef[1,1]);                         {calcul de R1 et bosse}
         G1:=G-round(T*Coef[2,1]);                         {calcul de G1 et bosse}
         B1:=B-round(T*Coef[3,1]);                         {calcul de B1 et bosse}
         Controle(R1,G1,B1);                               {Contrôle des limites}
         Coefi[1]:=(R-R1)/Laie;                            {calcul de Coefi pour le R}
         Coefi[2]:=(G-G1)/Laie;                            {calcul de Coefi pour le G}
         Coefi[3]:=(B-B1)/Laie;                            {calcul de Coefi pour le B}
      end;                                                 {fin de bosse}
      False : begin                                        {faux alors}
         R1:=R+round(T*Coef[1,2]);                         {calcul de R1 et creux}
         G1:=G+round(T*Coef[2,2]);                         {calcul de G1 et creux}
         B1:=B+round(T*Coef[3,2]);                         {calcul de B1 et creux}
         Controle(R1,G1,B1);                               {Contrôle des limites}
         Coefi[1]:=(R1-R)/Laie;                            {calcul de Coefi pour le R}
         Coefi[2]:=(G1-G)/Laie;                            {calcul de Coefi pour le G}
         Coefi[3]:=(B1-B)/Laie;                            {calcul de Coefi pour le B}
      end;                                                 {fin de faux}
   end;                                                    {fin de en fonction}
   BEGIN                                                   {Début de traitement d'image}
      Image:=TImage.Create(Self);                          {création de l'image}
      Image.Width := Width;                                {largeur}
      Image.Height := Height;                              {hauteur}
      MonBitmap := TBitmap.Create;                         {création du bitmap}
      TRY                                                  {essai}
      MonBitmap.PixelFormat := pf24bit;                    {format de l'enregistrement }
      MonBitmap.Width := Width;                            {largeur du bitmap}
      MonBitmap.Height := Height;                          {hauteur du bitmap}
      row := MonBitmap.Scanline[0];                        {on perd l'ensemble du bitmap}
      ScanlineBytes := Integer(MonBitmap.Scanline[1]) - Integer(row);{on démare au premier pixel}
      FOR j := 0 TO Laie DO                                {Balayage des Y jusqu'a la laie}
      BEGIN                                                {début du balayage}
         FOR i := 0 TO MonBitmap.Width-1 DO                {balayage des X, largeur -1 puisqu'on part de 0}
         BEGIN                                             {début du balayge des X}
            WITH row[i] DO                                 {avec le pixel}
            BEGIN                                          {début de avec}
               Case FBosse of                              {en fonction de FBBosse}
                  True :                                   {vrai}
                  begin                                    {début}
                     R:=round(R1+(coefi[1]*j));            {calcul de R}
                     G:=round(G1+(coefi[2]*j));            {calcul de G}
                     B:=round(B1+(coefi[3]*j));            {calcul de B}
                  end;                                     {fin}
                  False :                                  {faux}
                  Begin                                    {début faux}
                     R:=round(R1-(coefi[1]*j));            {calcul de R}
                     G:=round(G1-(coefi[2]*j));            {calcul de G}
                     B:=round(B1-(coefi[3]*j));            {calcul de B}
                  end;                                     {fin de faux}
               end;                                        {fin de en fonction FBBosse}
               Controle(R,G,B);                            {contrôle des limites}
               rgbtRed := Integer(R);                      {on modifie le Rouge}
               rgbtGreen := Integer(G);                    {on modifie le vert}
               rgbtBlue := Integer(B);                     {on modifie le bleu}
            END;                                           {fin de avec}
         END;                                              {fin du balayage des X}
         INC(Integer(Row), ScanlineBytes);                 {on passe à la ligne suivante}
      END;                                                 {fin du dessin de la partie haute jusqu'a 1/2 laie}
      Posit:=round(Laie+(2*Marge));                        {Le calcul de fin de laie}
      FOR j := Laie TO Posit DO                            {Balayage des Y de la laie à la fin de laie}
      BEGIN                                                {début balayage}
         FOR i := 0 TO MonBitmap.Width-1 DO                {balayage des X, largeur -1 puisqu'on part de 0}
         BEGIN                                             {début}
            WITH row[i] DO                                 {avec le pixel}
            BEGIN                                          {début}
               rgbtRed := Integer(R);                      {le rouge}
               rgbtGreen := Integer(G);                    {le vert}
               rgbtBlue := Integer(B);                     {le bleu}
            END;                                           {fin avec le pixel}
         END;                                              {fin}
         INC(Integer(Row), ScanlineBytes);                 {on passe à la ligne suivante}
      END;                                                 {fin de balayage}
      R1:=R;                                               {On part de r}
      G1:=G;                                               {on part de G}
      B1:=B;                                               {on part de B}
      FOR j := Posit TO MonBitmap.Height-3 DO              {Balayage des Y de la fin de laie jusqu'en bas de l'image}
      BEGIN                                                {début balayage}
         FOR i := 0 TO MonBitmap.Width-1 DO                {balayage des X, largeur -1 puisqu'on part de 0}
         BEGIN                                             {début balayage des X}
            WITH row[i] DO                                 {avec le pixel}
            BEGIN                                          {début avec}
               Case FBosse of                              {en fonction de FBBosse}
                  True : Begin                             {si vrai alors}
                     R:=round(R1-(coefi[1]*(j-posit)));    {calcul de R}
                     G:=round(G1-(coefi[2]*(j-posit)));    {calcul de G}
                     B:=round(B1-(coefi[3]*(j-posit)));    {calcul de B}
                  end;                                     {fin de vrai}
                  False : Begin                            {si faux alors début}
                     R:=round(R1+(coefi[1]*(j-posit)));    {calcul de R}
                     G:=round(G1+(coefi[2]*(j-posit)));    {calcul de G}
                     B:=round(B1+(coefi[3]*(j-posit)));    {calcul de B}
                  end;                                     {fin de faux}
               end;                                        {fin de en fonction}
               Controle(R,G,B);                            {on vérifie les limites}
               rgbtRed := Integer(R);                      {le rouge}
               rgbtGreen := Integer(G);                    {le vert}
               rgbtBlue := Integer(B);                     {le bleu}
            END;                                           {fin de avec}
         END;                                              {fin de balayage des X}
         INC(Integer(Row), ScanlineBytes);                 {on passe à la ligne suivante}
      END;                                                 {fin de balayage des Y}
      With Image do                                        {avec l'image}
      begin                                                {début avec l'image}
         Picture.Graphic := MonBitmap;                     {on copy monBitmap sur l'image}
         CourantGlyph:=ADDR(FBGlyph);                      {on récupère l'adresse du glyph}
         WBg:=0;                                           {initialisation}
         if CourantGlyph<>nil Then                         {si elle n'est pas nulle alors}
         begin                                             {début de pas nulle}
            MonBitmap.Assign(CourantGlyph^);               {on copy le glyph dans monBitmap}
            With MonBitmap do                              {avec MonBitmap}
            Begin                                          {début de avec MonBitmap}
               HBg:=MonBitmap.Height;                      {la hauteur}
               WBg:=MonBitmap.Width;                       {la largeur}
               TBg:=round((Image.Height-HBg)/2);           {on calcule sa position par rapport à l'image}
               If FBGlyphSite=GLLeft then                  {si sa position est à gauche alors}
               LBg:=5                                      {position gauche à 5}
               else                                        {si non}
               LBg :=(Image.Width-5)-(WBg);                {on calcule sa position}
               Transparent:=True;                          {on va l'inscrire avec la transparence}
               TransparentColor:=MonBitmap.Canvas.pixels[5,5];{couleur de la transparence position : 5,5}
            end;                                           {fin de avec monBitmap}
         end;                                              {fin de pas nulle}
         Canvas.Brush.Style:=Bsclear;                      {Spécifie le motif du pinceau}
         Canvas.Draw(LBg,TBg,MonBitmap);                   {on affiche le Glyph}
         RGN:=CreateRectRGN(0,0,W,H);                      {On va sélectioner l'image}
         SelectClipRGN(Canvas.Handle,RGN);                 {Pour écrite le Caption}
         Canvas.Font.Size:=Font.Size;                      {la grosseur de caractère}
         Canvas.Font.Name:=Font.Name;                      {le nom de la fonte d'écriture}
         Canvas.Font.Color:=Font.Color;                    {la couleur}
         Transparent:=True;                                {Transparence}
         If FBGlyphSite=GLLeft then                        {si le glyph est à gauche alors}
         Re:=Rect(WBg,0,W,H)                               {le rectangle est à droite}
         else                                              {si non}
         Re:=Rect(0,0,W-WBg,H);                            {il est à gauche}
         Drawtext(Canvas.Handle,PCHAR(FBCaption),-1,Re,DT_SINGLELINE or DT_VCENTER or DT_CENTER);{on écrit le texte}
      END;                                                 {fin de avec l'image}
      FINALLY                                              {à la fin}
         MonBitmap.Free;                                   {on libère MonBitmap}
      END;                                                 {fin}
   END;                                                    {fin}
END;                                                       {fin de procédure}

procedure TMonBoutonCouleur.Paint;                         {dessiner le bouton}
begin                                                      {début de procédure}
   inherited Paint;                                        {on récupère l'héritage de paint}
   with Canvas do                                          {avec la canevas}
   begin                                                   {début de avec}
      TransformeBouton(FBrouge,FBvert,FBbleu,FBMarge,FBPourcent,FBBosse,FBCaption);{on modifie l'image}
      Canvas.Draw(0,0,Image.Picture.Graphic);              {que l'on dessine sur le canevas}
      Image.Free;                                          {et on libère l'image}
      Brush.Style:=bsClear;                                {Spécifie le motif du pinceau}
      Pen.Width:=4;                                        {grosseur du pinceau}
      Pen.Color:=FBColor;                                  {on récupère la couleur de bordure}
      Rectangle(0,0,Width,Height);                         {on dessine le rectangle}
   end;                                                    {fin de avec le canevas}
   If FBBOsse=SavFBBosse then                              {si on revient à l'image initiale}
   FBTimer.Enabled:=False;                                 {on arrète le timer}
end;                                                       {fin de procédure}

constructor TMonBoutonCouleur.Create(AOwner:TComponent);   {construction du bouton}
begin                                                      {début de procédure}
   inherited Create(AOwner);                               {on récupère l'héritage de créate}
   FBGlyph:=TBItmap.Create;                                {on cré le glyph}
   FBTimerEnabled:=True;                                   {Initialisation à vrai}
   FBTimerTemp:=50;                                        {tempo}
   FBTimer:=TTImer.Create(Self);                           {on cré le timer}
   FBTimer.Interval:=FBTimerTemp;                          {on récupère l'intervale}
   FBTimer.OnTimer:=Ontimer;                               {le timer à on}
   Width:=200;                                             {largeur bouton}
   Height:=100;                                            {hauteur bouton}
   FBRouge:=150;                                           {rouge}
   FBVert:=100;                                            {vert}
   FBBleu:=150;                                            {bleu}
   FBColor:=CLLime;                                        {couleur du tour}
   FBPourCent:=50;                                         {relief}
   Font.Size:=16;                                          {hauteur de caractère}
   Font.Color:=CLWhite;                                    {couleur écriture}
   FBCaption:=TMonBoutonCouleur.ClassName;                 {nom de classe}
   FBCaption:=Copy(FBCaption,5,Length(FBCaption)-4);       {on enlève les 4 premiers caractères}
   FBBosse:=true;                                          {bouton bosse}
   SAVFBBosse:=FBBosse;                                    {la sauvegarde pour l'arret}
   FBGlyphSite := glLeft;                                  {position du glyph à gauche}
   FBMarge:=10;                                            {la marge pour la laie du milieu}
end;                                                       {fin de procédure}

Destructor TMonBoutonCouleur.Destroy;                      {destruction du bouton}
Begin                                                      {début de procédure}
   FBGlyph.Free;                                           {on libère le glyph}
   FBTimer.Free;                                           {le timer}
   Inherited Destroy;                                      {on détruit tout}
end;                                                       {fin de procédure}

procedure Register;                                        {enregistrement du composent}
begin                                                      {début de procédure}
   RegisterComponents('Exemples', [TMonBoutonCouleur]);    {on enregistre dans exemples}
end;                                                       {fin de procédure}

end.

Codes Sources

A voir également

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.