Tedit with background gradient color - Delphi

Alcione Bernard
Alcione Bernard used Ask the Experts™
on
Hi

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

thanks
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Sinisa VukSoftware architect
Top Expert 2012

Commented:
Which version you use? In newer (fmx) - it is supported almost natively.

Author

Commented:
hello

Sorry

I'm talking about TEdit ( VCL) .

Thanks
Sinisa VukSoftware architect
Top Expert 2012

Commented:
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...
Fundamentals of JavaScript

Learn the fundamentals of the popular programming language JavaScript so that you can explore the realm of web development.

Author

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.
Software architect
Top Expert 2012
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...

Author

Commented:
Sinisa
    thank you very much for your attention.  Sorry for your day break away.

Thanks again

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial