Composant bouton 4 cotés arrondis

Télécharger le projet
Commenter

Description

Bouton couleur avec scanline, 4 cotés arrondis, pouvant servir de label, cadre,...
Rotation de bitmap avec scanline, et exemple d'utilisation.

Source / Exemple : 


unit BoutCoulArrondi;

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
  TBoutCoulArrondi = class(TGraphicControl)
  private
    { 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)
    FBColor:Tcolor;                                        //Couleur du cadre
    FBROUGE:Byte;
    FBVERT:Byte;
    FBBLEU:Byte;
    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);
    Procedure SETBVERT(Value:Byte);
    Procedure SETBBLEU(Value:Byte);
    Procedure SETBColor(Value:TColor);
    procedure SETBCaption(Value: TCaption);
    procedure SETBGlyph(Value:TBitmap);
    procedure SETBGlyphSite(Value:TGlyphSite);
    Procedure Controle(Var Rouge:Byte;Var Vert:Byte;Var Bleu:Byte);//contrôle des limites RVB
    procedure Rotation(LeBitmapSource, LeBitmapCible : TBitmap);//rotation de 90° du bitmap source sur cible

  protected
    { Déclarations protégées }
    procedure Paint; override;
    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);

  public
    { Déclarations publiques }
    constructor Create(AOwner:TComponent); override;
    Destructor Destroy;Override;
    Procedure Click;Override;
    Procedure DblClick;Override;

  published
    { Déclarations publiées }
   Property TimerEnabled:Boolean READ FBTimerEnabled WRITE SETBTimerEnabled;
   Property TimerTemp:Integer READ FBTimerTemp WRITE SETBTimerTemp;
   property Propriete:boolean READ FBBosse WRITE SETBBosse;
   Property PourCent:Integer READ FBPourCent WRITE SETBPourCent;
   Property Marge:integer READ FBMarge WRITE SETBMarge;
   property Glyph:TBitmap READ FBGLyph WRITE SETBGlyph;
   Property GlyphSite:TGlyphSite READ FBGlyphSite WRITE SETBGlyphSite;
   property Caption: TCaption read FBCaption  WRITE SETBCaption;
   Property ROUGE:Byte READ FBROUGE WRITE SETBROUGE;
   Property VERT:Byte READ FBVERT WRITE SETBVERT;
   Property BLEU:Byte READ FBBLEU WRITE SETBBLEU;
   property Color: TColor READ FBColor WRITE  SETBColor;
   property Align;
   property Cursor;
   property DragCursor;
   property DragMode;
   property Enabled;
   property Font;
   property Hint;
   property ParentFont;
   property ParentShowHint;
   property PopupMenu;
   property Visible;
   property OnClick;
   property OnDblClick;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
  end;

procedure Register;

Var
   Image: TImage;

implementation

Procedure TBoutCoulArrondi.TransformeBouton(Var Rouge, Vert, Bleu:Byte;//Modification du bouton avec scanline}
          Marge:Integer;FPourCent:integer;FBosse:boolean;M:string);
VAR
   Btmap1,Btmap2 : TBitmap;                                {bitmaps}
   i : INTEGER;                                            {X avec scanline}
   j : INTEGER;                                            {y avec scanline}
   row : pRGBTripleArray;
   ScanlineBytes: INTEGER;
   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;
   R1,G1,B1:Byte;
   Re:Trect;
   T:integer;                                              {le % pour le relief}
   RGN:HRGN;
   W,H:integer;                                            {Largeur hauteur}
   CourantGlyph:^TBitmap;                                  {Pointeur sur Glyph}
   WBg,HBg,TBg,LBg:integer;                                {Largeur, hauteur, top, left}
   Dr,Ga:integer;                                          {droite et gauche}
   Recouvrement:integer;
begin
   Recouvrement:=3;
   W:=Width;
   H:=Height;
   T:=FPourCent;
   R:=Rouge;
   G:=Vert;
   B:=Bleu;                             //Calculs des coef R, V, B en fonction de Bosse
   coef[1,1]:=(255-Rouge)/100;
   coef[2,1]:=(255-Vert)/100;
   coef[3,1]:=(255-Bleu)/100;
   coef[1,2]:=Rouge/100;
   coef[2,2]:=vert/100;
   coef[3,2]:=Bleu/100;
   If W>=H then                          //eviter les erreurs en changement de dimension}
   Laie:=round(((Height-1)/2)-Marge)     //Calcul de la laie au milieu pour l'écriture du texte}
   else
   Laie:=round(((Width-1)/2)-Marge);
   Case Fbosse of
      True : begin                      //Calcul de la couleur de départ et du coef poun incrémentation
         R1:=Rouge-round(T*Coef[1,1]);
         G1:=Vert-round(T*Coef[2,1]);
         B1:=Bleu-round(T*Coef[3,1]);
         Controle(R1,G1,B1);
         Coefi[1]:=(Rouge-R1)/Laie;
         Coefi[2]:=(Vert-G1)/Laie;
         Coefi[3]:=(Bleu-B1)/Laie;
      end;
      False : begin
         R1:=Rouge+round(T*Coef[1,2]);
         G1:=Vert+round(T*Coef[2,2]);
         B1:=Bleu+round(T*Coef[3,2]);
         Controle(R1,G1,B1);
         Coefi[1]:=(R1-Rouge)/Laie;
         Coefi[2]:=(G1-Vert)/Laie;
         Coefi[3]:=(B1-Bleu)/Laie;
      end;
   end;
   Image:=TImage.Create(Self);      //Création et dimension de l'image
   Image.Width := Width;
   Image.Height := Height;
   Btmap1 := TBitmap.Create;
   TRY
      Btmap1.PixelFormat := pf24bit; //Création du premier bitmap aux mêmes dimentions que l'image
      Btmap1.Width := Width;
      Btmap1.Height := Height;
      row := Btmap1.Scanline[0];     //Initialisation de Scanline
      ScanlineBytes := Integer(Btmap1.Scanline[1]) - Integer(row);
      Dr:=0;                        //On va dessiner un angle jusqu'a la laie
      Ga:=Btmap1.Width-1;
      FOR j := 0 TO Laie DO
      BEGIN
         FOR i := Dr TO Ga DO
         BEGIN
            WITH row[i] DO
            BEGIN
               Case FBosse of
                  True :
                  begin
                     R:=round(R1+(coefi[1]*j));
                     G:=round(G1+(coefi[2]*j));
                     B:=round(B1+(coefi[3]*j));
                  end;
                  False :
                  Begin
                     R:=round(R1-(coefi[1]*j));
                     G:=round(G1-(coefi[2]*j));
                     B:=round(B1-(coefi[3]*j));
                  end;
               end;
               Controle(R,G,B);
               rgbtRed := Integer(R);
               rgbtGreen := Integer(G);
               rgbtBlue := Integer(B);
            END;
         END;
         INC(Integer(Row), ScanlineBytes);
         if J>Recouvrement then      //Le dessin de l'angle, attention, recouvrement nécessaire
         begin
            Dr:=Dr+1;
            Ga:=Ga-1;
         end;
      END;
      Posit:=Btmap1.Height-laie;  //Dessin de la plage plate pour l'écriture
      FOR j := Laie TO Posit DO
      BEGIN
         FOR i := Dr TO Ga DO
         BEGIN
            WITH row[i] DO
            BEGIN
               rgbtRed := Integer(Rouge);
               rgbtGreen := Integer(vert);
               rgbtBlue := Integer(Bleu);
            END;
         END;
         INC(Integer(Row), ScanlineBytes);
      END;
      R1:=Rouge;               //On repart des couleurs initiales
      G1:=vert;
      B1:=Bleu;
      FOR j := Posit TO Btmap1.Height-3 DO
      BEGIN
         FOR i := Dr TO Ga DO
         BEGIN
            WITH row[i] DO
            BEGIN
               Case FBosse of
                  True : Begin
                     R:=round(R1-(coefi[1]*(j-posit)));
                     G:=round(G1-(coefi[2]*(j-posit)));
                     B:=round(B1-(coefi[3]*(j-posit)));
                  end;
                  False : Begin
                     R:=round(R1+(coefi[1]*(j-posit)));
                     G:=round(G1+(coefi[2]*(j-posit)));
                     B:=round(B1+(coefi[3]*(j-posit)));
                  end;
               end;
               Controle(R,G,B);
               rgbtRed := Integer(R);
               rgbtGreen := Integer(G);
               rgbtBlue := Integer(B);
            END;
         END;
         INC(Integer(Row), ScanlineBytes);
         If Dr>0 then                       //Angle inversé
         begin
            Dr:=Dr-1;
            Ga:=Ga+1;
         end;
      END;
      Case Fbosse of
         True : begin
            R1:=Rouge-round(T*Coef[1,1]);
            G1:=Vert-round(T*Coef[2,1]);
            B1:=Bleu-round(T*Coef[3,1]);
            Controle(R1,G1,B1);
            Coefi[1]:=(Rouge-R1)/Laie;
            Coefi[2]:=(Vert-G1)/Laie;
            Coefi[3]:=(Bleu-B1)/Laie;
         end;
         False : begin
            R1:=Rouge+round(T*Coef[1,2]);
            G1:=Vert+round(T*Coef[2,2]);
            B1:=Bleu+round(T*Coef[3,2]);
            Controle(R1,G1,B1);
            Coefi[1]:=(R1-Rouge)/Laie;
            Coefi[2]:=(G1-Vert)/Laie;
            Coefi[3]:=(B1-Bleu)/Laie;
         end;
      end;
      Btmap2 := TBitmap.Create;      //Création du deuxième bitmap, avec dimentions inversées
      Btmap2.PixelFormat := pf24bit; //On va traiter l'image inversée de la même manière
      Btmap2.Width := Height;
      Btmap2.Height := Width;
      Rotation(Btmap1,Btmap2);      //Inversion de l'image dans le deuxième bitmap
      Dr:=0;
      Ga:=Btmap2.Width-1;
      row := Btmap2.Scanline[0];   //Initialisation de Scanline
      ScanlineBytes := Integer(Btmap2.Scanline[1]) - Integer(row);
      FOR j := 0 TO Laie DO
      BEGIN
         FOR i := Dr TO Ga DO
         BEGIN
            WITH row[i] DO
            BEGIN
               Case FBosse of
                  True :
                  begin
                     R:=round(R1+(coefi[1]*j));
                     G:=round(G1+(coefi[2]*j));
                     B:=round(B1+(coefi[3]*j));
                  end;
                  False :
                  Begin
                     R:=round(R1-(coefi[1]*j));
                     G:=round(G1-(coefi[2]*j));
                     B:=round(B1-(coefi[3]*j));
                  end;
               end;
               Controle(R,G,B);
               rgbtRed := Integer(R);
               rgbtGreen := Integer(G);
               rgbtBlue := Integer(B);
            END;
         END;
         INC(Integer(Row), ScanlineBytes);
         if J>Recouvrement then
         begin
            Dr:=Dr+1;
            Ga:=Ga-1;
         end;
      END;
      Posit:=Btmap2.Height-laie;
      FOR j := Laie TO Posit DO
      BEGIN
         FOR i := Dr TO Ga DO
         BEGIN
            WITH row[i] DO
            BEGIN
               rgbtRed := Integer(Rouge);
               rgbtGreen := Integer(Vert);
               rgbtBlue := Integer(Bleu);
            END;
         END;
         INC(Integer(Row), ScanlineBytes);
      END;
      R1:=Rouge;
      G1:=vert;
      B1:=Bleu;
      FOR j := Posit TO Btmap2.Height-3 DO
      BEGIN
         FOR i := Dr TO Ga DO
         BEGIN
            WITH row[i] DO
            BEGIN
               Case FBosse of
                  True : Begin
                     R:=round(R1-(coefi[1]*(j-posit)));
                     G:=round(G1-(coefi[2]*(j-posit)));
                     B:=round(B1-(coefi[3]*(j-posit)));
                  end;
                  False : Begin
                     R:=round(R1+(coefi[1]*(j-posit)));
                     G:=round(G1+(coefi[2]*(j-posit)));
                     B:=round(B1+(coefi[3]*(j-posit)));
                  end;
               end;
               Controle(R,G,B);
               rgbtRed := Integer(R);
               rgbtGreen := Integer(G);
               rgbtBlue := Integer(B);
            END;
         END;
         INC(Integer(Row), ScanlineBytes);
         If Dr>0 then
         begin
            Dr:=Dr-1;
            Ga:=Ga+1;
         end;
      END;
      Rotation(Btmap2,Btmap1); //On inverse à nouveau l'image dans le Bitmap N°1
      With Image do
      begin
         Picture.Graphic := Btmap1; //Récupération du Glyph s'il existe
         CourantGlyph:=ADDR(FBGlyph);
         WBg:=0;
         LBg:=0;
         if CourantGlyph<>nil Then
         begin
            Btmap1.Assign(CourantGlyph^);
            With Btmap1 do
            Begin
               HBg:=Btmap1.Height;
               WBg:=Btmap1.Width;
               TBg:=round((Image.Height-HBg)/2);
               If FBGlyphSite=GLLeft then
               LBg:=5
               else
               LBg :=(Image.Width-5)-(WBg);
               Transparent:=True;
               TransparentColor:=Btmap1.Canvas.pixels[5,5];
            end;
         end;
         Canvas.Brush.Style:=Bsclear;  //Dessin de l'image et du texte
         Canvas.Draw(LBg,TBg,Btmap1);
         RGN:=CreateRectRGN(0,0,W,H);
         SelectClipRGN(Canvas.Handle,RGN);
         Canvas.Font.Size:=Font.Size;
         Canvas.Font.Name:=Font.Name;
         Canvas.Font.Color:=Font.Color;
         Transparent:=True;
         If FBGlyphSite=GLLeft then
         Re:=Rect(WBg,0,W,H)
         else
         Re:=Rect(0,0,W-WBg,H);
         Drawtext(Canvas.Handle,PCHAR(FBCaption),-1,Re,DT_SINGLELINE or DT_VCENTER or DT_CENTER);
      END;
   FINALLY
      Btmap1.Free;
      Btmap2.free;
   END;
END;

procedure TBoutCoulArrondi.Rotation(LeBitmapSource, LeBitmapCible : TBitmap);//rotation de 90° du bitmap source sur cible
var
   BitmapSource, BitmapCible : TBitmap;        //source et cible}
   x,y : integer;
   LigneSource, LigneCible : pRGBTripleArray;  //Lignes source et cible
begin
   BitmapSource := TBitmap.Create;
   BitmapCible := TBitmap.Create;
   try
      BitmapSource.pixelformat := pf24bit;
      BitmapCible.pixelformat := pf24bit;
      BitmapSource.assign(LeBitmapSource);     //récupération du bitmap source
      BitmapCible.Height := BitmapSource.Width;//Dimentions inversées
      BitmapCible.Width := BitmapSource.Height;
      for y:=0 to BitmapSource.Height - 1 do  //On lit une ligne horizontale que l'on écrit verticalement
      begin
         LigneSource := BitmapSource.ScanLine[y];
         for x:=0 to BitmapSource.Width - 1 do
         begin
            LigneCible := BitmapCible.ScanLine[x];
            LigneCible[BitmapSource.Height - 1 - y] := LigneSource[x];
         end;
      end;
      LeBitmapCible.Height:=BitmapCible.Height;
      LeBitmapCible.Width:=BitmapCible.Width;
      with LeBitmapCible do
      Canvas.draw(0,0,BitmapCible);
   finally
      BitmapSource.free;
      BitmapCible.free;
   end;
end;                                          //génial avec scanline

Procedure TBoutCoulArrondi.Controle(Var Rouge:Byte;Var Vert:Byte;Var Bleu:Byte);//contrôle des limites RVB
begin
   If Rouge>255 then Rouge:=255 else if Rouge<0 then Rouge:=0;
   If Vert>255 then Vert:=255 else if Vert<0 then Vert:=0;
   If Bleu>255 then Bleu:=255 else if Bleu<0 then Bleu:=0;
end;

Procedure TBoutCoulArrondi.SETBTimerEnabled(Value:boolean);//Mise en route ou pas du timer}
Begin
   If Value<>FBTimerEnabled then
   FBTimerEnabled:=Value;
   If CsDesigning In ComponentState then //si on est en création, pas de démarrage
   begin
      FBTimer.Enabled:=false;
      exit;
   end;
   FBTImer.Enabled:=FBTimerEnabled;
end;

Procedure TBoutCoulArrondi.SETBTimerTemp(Value:integer);//récupération de la durée de tempo}
begin
   if Value<>FBTimerTemp then
   FBTimerTemp:=Value;
   FBTimer.Interval:=FBTimerTemp;
   If CsDesigning in componentState then //si on est en conception du bouton alors le timer ne démarre pas
   begin
      FBTimer.Enabled:=false;
      exit;
   end;
end;

Procedure TBoutCoulArrondi.Ontimer(Sender:Tobject);//Procedure pour le clignotement du bouton au click
Begin
   FBBosse:=Not FBBOsse;
   If CsDesigning in componentState then//si on est en conception du bouton alors  le timer ne démarre pas
   begin
      FBTimer.Enabled:=false;
      exit;
   end;
   Invalidate;
end;

procedure TBoutCoulArrondi.SETBCaption(Value: TCaption);
begin
   if Value <> FBCaption then
   begin
      FBCaption := Value;
      Invalidate;
   end;
end;

Procedure TBoutCoulArrondi.SETBBosse(Value:Boolean);
Begin
   if Value <> FBBosse then
   begin
      FBBosse := Value;
      SavFBBosse:=Value;
      Invalidate;
   end;
End;

Procedure TBoutCoulArrondi.SETBPourCent(Value:Integer);
Begin
   If Value<0 then Value:=0 else if Value>100 then Value:=100;
   if Value <> FBPourCent then
   begin
      FBPourCent := Value;
      Invalidate;
   end;
End;

Procedure TBoutCoulArrondi.SETBMarge(Value:Integer);//modifier la largeur de laie
Begin //Contrôle des limites, à revoir avec même modif sur MonBoutonCouleur
   If Value<0 then Value:=0;
   if Height>=Width then
   begin
      if Value>(Height/2.25)then
      Value:=round(Height/2.25);
   end
   else
   begin
      if Value>(Width/2.25)then
      Value:=round(Width/2.25);
   end;
   if Value <> FBMarge then
   begin
      FBMarge := Value;
      Invalidate; //Demande à Windows de repeindre le contrôle
   end;
End;

Procedure TBoutCoulArrondi.SETBROUGE(Value:Byte);
Begin
   if Value <> FBROUGE then
   begin
      FBROUGE := Value;
      Invalidate;
   end;
End;

Procedure TBoutCoulArrondi.SETBVERT(Value:Byte);
Begin
   if Value <> FBVERT then
   begin
      FBVERT := Value;
      Invalidate;
   end;
End;

Procedure TBoutCoulArrondi.SETBBLEU(Value:Byte);
Begin
   if Value <> FBBLEU then
   begin
      FBBLEU := Value;
      Invalidate;
   end;
End;

Procedure TBoutCoulArrondi.SETBColor(Value:TColor);
Begin
   if Value <> FBColor then
   begin
      FBColor := Value;
      Invalidate;
   end;
end;

Procedure TBoutCoulArrondi.SETBGlyphSite(Value:TGlyphSite);//position du glyph
begin
   If FBGlyphSite<>Value then
   FBGlyphSite:=Value;
   Invalidate;
end;

procedure TBoutCoulArrondi.SetBGlyph(Value:TBitmap);
begin
   FBGlyph.Assign(Value);
   Invalidate;
end;

Procedure TBoutCoulArrondi.Click;
Begin
   If FBTimerEnabled=true then
   FBTimer.Enabled:=true;
   InHerited Click;
end;

Procedure TBoutCoulArrondi.DblClick;
Begin
   If FBTimerEnabled=true then
   FBTimer.Enabled:=true;
   InHerited DblClick;
end;
procedure TBoutCoulArrondi.Paint;
begin
   inherited Paint;
   with Canvas do
   begin
      TransformeBouton(FBrouge,FBvert,FBbleu,FBMarge,FBPourcent,FBBosse,FBCaption);
      Canvas.Draw(0,0,Image.Picture.Graphic);
      Image.Free;
      Brush.Style:=bsClear;
      Pen.Width:=4;
      Pen.Color:=FBColor;
      Rectangle(0,0,Width,Height);
   end;
   If FBBOsse=SavFBBosse then
   FBTimer.Enabled:=False;
end;

constructor TBoutCoulArrondi.Create(AOwner:TComponent);
begin
   inherited Create(AOwner);
   FBGlyph:=TBItmap.Create;
   FBTimerEnabled:=True;
   FBTimerTemp:=50;
   FBTimer:=TTImer.Create(Self);
   FBTimer.Interval:=FBTimerTemp;
   FBTimer.OnTimer:=Ontimer;
   Width:=200;
   Height:=100;
   FBRouge:=154;
   FBVert:=134;
   FBBleu:=177;
   FBColor:=CLWhite;
   FBPourCent:=80;
   Font.Size:=16;
   Font.Color:=CLBlack;
   FBCaption:=TBoutCoulArrondi.ClassName;
   FBCaption:=Copy(FBCaption,2,Length(FBCaption)-2);
   FBBosse:=true;
   SAVFBBosse:=FBBosse;
   FBGlyphSite := glLeft;
   FBMarge:=10;
end;

Destructor TBoutCoulArrondi.Destroy;
Begin
   FBGlyph.Free;
   FBTimer.Free;
   Inherited Destroy;
end;

procedure Register;
begin
  RegisterComponents('Exemples', [TBoutCoulArrondi]);
end;

end.
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 (francoisbalsan)