Panel avec degradation de couleur

Télécharger le projet
Commenter

Description

composant (tout simple) issu de TCustomPanel dans lequel est ajouté 2 propriétés :
. une couleur N°2
. une orientation pour le dégradé

peut être que ce type de composant existe déjà ?
(à défaut et dans le doute et en guise de remerciement pour l'entraide...)

Source / Exemple : 


unit DegradePanel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type Tsens = (GaucheDroite, DroiteGauche, HautBas, BasHaut);
type TDegradePanel = class(TCustomPanel)
  private
    { Déclarations privées }
    Color1 : TColor;
    FSens : TSens;
    Procedure SetColor (ColorX: TColor);
    Procedure SetSens (sens: TSens);
  protected
    { Déclarations protégées }
    procedure Paint; override;

  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Déclarations publiées }
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BiDiMode;
    property BorderWidth;
    property BorderStyle;
    property Caption;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FullRepaint;
    property Font;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;

    Property ColorDeg: TColor read Color1 write SetColor;
    property Orientation: TSens read FSens write Setsens;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Ric', [TDegradePanel]);
end;

constructor TDegradePanel.Create(AOwner: TComponent);
begin
  inherited Create(Aowner);
  Color:= clgray;
  color1:= clsilver;
  FSens:= GaucheDroite;
end;

destructor TDegradePanel.Destroy;
begin
  inherited Destroy;
end;

procedure TDegradePanel.SetColor(ColorX: TColor);
Begin
  color1 := colorX;
  Paint;
end;

Procedure TDegradePanel.SetSens (sens: TSens);
Begin
  Fsens:= sens;
  Paint;
end;

procedure TDegradePanel.Paint;
const Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var pr, pg, pb : real;
    Rdep, Gdep, Bdep : byte;
    Rfin, Gfin, Bfin : byte;
    i, x : integer;
    Rect : TRect;
    Flags: Longint;
    FontHeight: Integer;
begin
  Rect := GetClientRect;
  if FSens in [GaucheDroite, HautBas]
     then begin
          Rdep := getRvalue (color);
          Gdep := getGvalue (color);
          Bdep := getBvalue (color);
          Rfin := getRvalue (color1);
          Gfin := getGvalue (color1);
          Bfin := getBvalue (color1); end 
     else begin
          Rdep := getRvalue (color1);
          Gdep := getGvalue (color1);
          Bdep := getBvalue (color1);
          Rfin := getRvalue (color);
          Gfin := getGvalue (color);
          Bfin := getBvalue (color); end ;

  if fsens in [HautBas, BasHaut]
     then x :=  height else x:= width;
  pr := (Rfin - Rdep) / x;
  pg := (Gfin - Gdep) / x;
  pb := (Bfin - Bdep) / x;
  
  with canvas do begin
       Brush.Color := Color;
       FillRect(Rect);
       Brush.Style := bsClear;
       Font := Self.Font;
       FontHeight := TextHeight('W');
       case FSens of
           GaucheDroite: for i := 0 to x do begin
                        pen.color := rgb (Rdep +round(i*pr), Gdep+round(i*pg), Bdep+round (i*pb));
                        moveto (i,0); LineTo (i,height); end;
           DroiteGauche : for i := 0 to x do begin
                        pen.color := rgb (Rdep +round(i*pr), Gdep+round(i*pg), Bdep+round (i*pb));
                        moveto (i,0); LineTo (i, height); end;
           HautBas :    for i := 0 to x do begin
                        pen.color := rgb (Rdep +round(i*pr), Gdep+round(i*pg), Bdep+round (i*pb));
                        moveto (0,i); LineTo (width,i); end;
           BasHaut  :    for i := 0 to x do begin
                        pen.color := rgb (Rdep +round(i*pr), Gdep+round(i*pg), Bdep+round (i*pb));
                        moveto (0,i); LineTo (width,i); end;
           end;
       with Rect do begin
            Top := ((Bottom + Top) - FontHeight) div 2;
            Bottom := Top + FontHeight; end;
       Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];
       Flags := DrawTextBiDiModeFlags(Flags);
       DrawText(Handle, PChar(Caption), -1, Rect, Flags);
  end;
end;

end.
Télécharger le projet

Codes Sources

A voir également