Tedit with background gradient color - Delphi

Hi

I looking for a TEdit with gradient color.  How to change a TCustomEdit for this?

thanks
Alcione BernardAsked:
Who is Participating?
 
Sinisa VukConnect With a Mentor Commented:
I put my day break away - to make this example. Example use some tricky parts (draw gradient when clear background message was send)...
unit GradientEdit;

interface

{
  example made by Sinisa Vuk - for ExpertExchange question: How to ake gradient Edit (vcl) (2017)
}

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics;

type
  TGradientEdit = class(TEdit)
  private
    FStartColor: TColor;
    FEndColor: TColor;
    FCanvas: TCanvas;
    procedure SetEndColor(const Value: TColor);
    procedure SetStartColor(const Value: TColor);
    procedure FontChange(Sender: TObject);
    { Private declarations }
  protected
    { Protected declarations }
    procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure CnCtlColorEdit (var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT;
    property Color;  //hide property
    procedure DrawGradient(dc: HDC);
  public
    { Public declarations }
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property StartColor: TColor read FStartColor write SetStartColor;
    property EndColor: TColor read FEndColor write SetEndColor;
  end;

procedure Register;

implementation

uses Math;

procedure Register;
begin
  RegisterComponents('Samples', [TGradientEdit]);
end;

//source: http://delphi.cjcsoft.net/viewthread.php?tid=46373
procedure GradHorizontal(Canvas:TCanvas; Rect:TRect; FromColor, ToColor:TColor) ;
var
   X, w:integer;
   dr,dg,db:Extended;
   C1,C2:TColor;
   r1,r2,g1,g2,b1,b2:Byte;
   R,G,B:Byte;
   cnt:integer;
begin
   C1 := FromColor;
   R1 := GetRValue(C1) ;
   G1 := GetGValue(C1) ;
   B1 := GetBValue(C1) ;

   C2 := ToColor;
   R2 := GetRValue(C2) ;
   G2 := GetGValue(C2) ;
   B2 := GetBValue(C2) ;

   w := Rect.Right-Rect.Left;
   dr := (R2-R1) / w;
   dg := (G2-G1) / w;
   db := (B2-B1) / w;

   cnt := 0;
   Canvas.Pen.Style := psSolid;
   for X := Rect.Left to Rect.Right-1 do
   begin
     R := R1+Ceil(dr*cnt) ;
     G := G1+Ceil(dg*cnt) ;
     B := B1+Ceil(db*cnt) ;

     Canvas.Pen.Color := RGB(R,G,B) ;
     Canvas.MoveTo(X,Rect.Top) ;
     Canvas.LineTo(X,Rect.Bottom) ;
     inc(cnt) ;
   end;
end;

{ TGradientEdit }

constructor TGradientEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FStartColor := clWindow;
  FEndColor := clWindow;

  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  Self.Font.OnChange := FontChange;
end;

destructor TGradientEdit.Destroy;
begin
  FCanvas.Free;

  inherited Destroy;
end;

procedure TGradientEdit.FontChange(Sender: TObject);
begin
  FCanvas.Font.Assign(Self.Font);
end;

procedure TGradientEdit.SetEndColor(const Value: TColor);
begin
  if FEndColor <> Value then
  begin
    FEndColor := Value;
    Invalidate;
  end;
end;

procedure TGradientEdit.SetStartColor(const Value: TColor);
begin
  if FStartColor <> Value then
  begin
    FStartColor := Value;
    Invalidate;
  end;
end;

procedure TGradientEdit.DrawGradient(dc: HDC);
begin
  //set canvas and draw...
  FCanvas.Lock;
  try
   FCanvas.Handle := dc;
   try
     FCanvas.Brush.Assign(Self.Brush);
     if FStartColor = FEndColor then
     begin
       FCanvas.Brush.Color := FStartColor;
       FCanvas.FillRect(ClientRect);
     end
     else
       GradHorizontal(FCanvas, ClientRect, FStartColor, FEndColor);
   finally
     FCanvas.Handle := 0;
   end;
  finally
   FCanvas.Unlock;
  end;
end;

procedure TGradientEdit.WMEraseBkGnd(var msg: TWMEraseBkGnd);
begin
  //draw gradient fill
  DrawGradient(msg.DC);
  msg.Result := 1;
end;

procedure TGradientEdit.CnCtlColorEdit(var Message: TWMCtlColorEdit);
begin
  //draw gradient fill
  DrawGradient(TWMCtlColorEdit(Message).ChildDC);
  //set transparent font
  SetBkMode(Message.ChildDC, TRANSPARENT);
  SelectObject(Message.ChildDC, Font.Handle);
  Message.Result := GetStockObject(NULL_BRUSH);
end;

end.

Open in new window

...
Newer Delphi (>XE) and fmx - way easier to do this... For vcl - you need to know how Delphi works, how windows messaging works...
0
 
Sinisa VukCommented:
Which version you use? In newer (fmx) - it is supported almost natively.
0
 
Alcione BernardAuthor Commented:
hello

Sorry

I'm talking about TEdit ( VCL) .

Thanks
0
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
Sinisa VukCommented:
Cause I'm short with time ... cannot generate demo/example...but, got to Torry.net, look for BI Library or CH Component Pack. Both have modified TEdits... Try to invest some time to get into Paint method. You need to create two properties: StartColor and EndColor (TColor), in Paint method before custom drawing text - do gradient fill starting from  StartColor to EndColor. Here is how to implement that algo... or here...
0
 
Alcione BernardAuthor Commented:
yes I get it about (StartColor EndColor and Gradient functions to draw gradients), but can you provide more details about how to implements Paint method before custom drawing text ?

thank you again.
0
 
Alcione BernardAuthor Commented:
Sinisa
    thank you very much for your attention.  Sorry for your day break away.

Thanks again
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.