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?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Sinisa VukSoftware architectCommented:
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
Sinisa VukSoftware architectCommented:
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
CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

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
Sinisa VukSoftware architectCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Alcione BernardAuthor Commented:
Sinisa
    thank you very much for your attention.  Sorry for your day break away.

Thanks again
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.