TGradEdit = class(TCustomEdit)
 private
   FSecondColor: TColor;
   procedure SetSecondColor(const Value: TColor);
   function GetFirstColor: TColor;
   procedure SetFirstColor(const Value: TColor);
 published
   property FirstColor: TColor read GetFirstColor write SetFirstColor;
   property SecondColor: TColor read FSecondColor write SetSecondColor;
 end;
.....
function TGradEdit.GetFirstColor: TColor;
begin
 Result:=Color;
end;

procedure TGradEdit.SetFirstColor(const Value: TColor);
begin
 if Color<>Value then Color := Value;
....
end;

procedure TGradEdit.SetSecondColor(const Value: TColor);
begin
 if FSecondColor <> Value then FSecondColor := Value;
....
end;

// Заполнение буфера-битмапа градиентом
procedure TMRAEdit.FillBuffer;
var
 i: integer;
 Deltas: Array [0 .. 2] of real;
begin
 Deltas[0] := (GetRValue(FBgColorEnd) - GetRValue(FBgColorStart)) / FBGBuffer.Height;
 Deltas[1] := (GetGValue(FBgColorEnd) - GetGValue(FBgColorStart)) / FBGBuffer.Height;
 Deltas[2] := (GetBValue(FBgColorEnd) - GetBValue(FBgColorStart)) / FBGBuffer.Height;

 for i := 0 to FBGBuffer.Height - 1 do
 begin
   FBGBuffer.Canvas.MoveTo(0, i);
   FBGBuffer.Canvas.Pen.Color := RGB(
     Round(GetRValue(FBgColorStart) + I * Deltas[0]),
     Round(GetGValue(FBgColorStart) + I * Deltas[1]),
     Round(GetBValue(FBgColorStart) + I * Deltas[2]));
   FBGBuffer.Canvas.LineTo(FBGBuffer.Width, i);
 end;
end;

procedure TMRAEdit.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
 with ThemeServices do
 if ThemesEnabled and Assigned(Parent) and (csParentBackground in FControlStyle) then
   begin
     { Get the parent to draw its background into the control's background. }
     DrawParentBackground(Handle, Message.DC, nil, False);
   end
   else
   begin
     { Only erase background if we're not doublebuffering or painting to memory. }
     if not FDoubleBuffered or
        (TMessage(Message).wParam = TMessage(Message).lParam) then
       //Тут было заполнение пустым цветом
       BitBlt(Message.DC, 0, 0, ClientRect.Right, ClientRect.Bottom, FBGBuffer.Canvas.Handle, 0, 0, SRCCOPY);
   end;

 Message.Result := 1;
end;

procedure TMRAEdit.WMPaint(var Message: TWMPaint);
var
 DC, MemDC: HDC;
 MemBitmap, OldBitmap: HBITMAP;
 PS: TPaintStruct;
begin
 if not FDoubleBuffered or (Message.DC <> 0) then
 begin
   if not (csCustomPaint in ControlState) and (ControlCount = 0) then
     inherited
   else
     PaintHandler(Message);
 end
 else
 begin
   DC := GetDC(0);
   MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
   ReleaseDC(0, DC);
   MemDC := CreateCompatibleDC(0);
   OldBitmap := SelectObject(MemDC, MemBitmap);
   try
     DC := BeginPaint(Handle, PS);
     Perform(WM_ERASEBKGND, MemDC, MemDC);
     Message.DC := MemDC;
     WMPaint(Message);
     Message.DC := 0;
     // Тут подменил источник копирования на свой буфер
     BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, FBGBuffer.Canvas.Handle, 0, 0, SRCCOPY);
     EndPaint(Handle, PS);
   finally
     SelectObject(MemDC, OldBitmap);
     DeleteDC(MemDC);
     DeleteObject(MemBitmap);
   end;
 end;
end;

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, jpeg, ExtCtrls, ComCtrls, StdCtrls;

type

 TEdit = class(StdCtrls.TEdit)
 private
   FBitmap: TBitmap;
 protected
   procedure WndProc(var Message: TMessage); override;
   procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
 public
   property Bitmap: TBitmap read FBitmap write FBitmap;
 end;

 TForm1 = class(TForm)
   Image1: TImage;
   Edit1: TEdit;
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

uses CommCtrl;

procedure TEdit.WndProc(var Message: TMessage);
begin
 if Message.Msg = WM_ERASEBKGND then
 begin
   Message.Result := 1
 end else
 begin
   case Message.Msg of
     WM_KEYDOWN:
       InvalidateRect(Handle, nil, False);
   end;
   inherited
 end
end;

procedure TEdit.WMPaint(var Message: TWMPaint);
var
 DC, TempDC, TempDC1: HDC;
 TempBmp, OldBmp, OldBmp1, TempBMP1: HBITMAP;
 PS: TPaintStruct;
 TempRect: TRect;
begin
 if Message.DC <> 0 then
   inherited
 else begin
   TempRect := ClientRect;
   BeginPaint (Handle, PS);
   try
     DC := GetDC(Handle);
     TempDC := CreateCompatibleDC(DC);
     TempDC1 := CreateCompatibleDC(DC);
     TempBMP := CreateCompatibleBitmap(DC, TempRect.Right, TempRect.Bottom);
     TempBMP1 := CreateCompatibleBitmap(DC, TempRect.Right, TempRect.Bottom);
     try
       OldBmp := SelectObject(TempDC, TempBMP);
       OldBmp1 := SelectObject(TempDC1, TempBMP1);
       try
         Message.DC := TempDC;
         inherited;
         Message.DC := 0;
         FillRect(TempDC1, TempRect, GetStockObject(WHITE_BRUSH));
         if FBitmap <> nil then
           BitBlt(TempDC1, 0, 0, FBitmap.Width, FBitmap.Height, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);
         TransparentBlt (TempDC1, 0, 0, TempRect.Right, TempRect.Bottom, TempDC, 0, 0, TempRect.Right, TempRect.Bottom, clWhite);
         BitBlt(DC, 0, 0, TempRect.Right, TempRect.Bottom, TempDC1, 0, 0, SRCCOPY);
       finally
         SelectObject (TempDC, OldBmp);
         SelectObject (TempDC1, OldBmp1)
       end;
     finally
       DeleteObject (TempBMP);
       DeleteObject (TempBMP1);
       ReleaseDC (Handle, TempDC);
       ReleaseDC (Handle, TempDC1);
       ReleaseDC (Handle, DC);
     end;
   finally
     EndPaint (Handle, PS)
   end;
 end
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Edit1.Color := clWhite;
 Edit1.Bitmap := TBitmap.Create;
 Edit1.Bitmap.Assign(image1.Picture.Graphic);
end;

end.

unit main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;

type
 TForm1 = class(TForm)
   EditPlace: TEdit;
 private
   procedure WmCtlColorEdit (var Message: TWMCtlColorEdit); message WM_CTLCOLOREDIT;
 end;

var
 Form1: TForm1;

implementation
uses
 GraphUtil;

{$R *.dfm}

procedure TForm1.WmCtlColorEdit(var Message: TWMCtlColorEdit);
var
 ACanvas: TCanvas;
begin
 if Message.ChildWnd = EditPlace.Handle then
 begin
   ACanvas := TCanvas.Create;
   try
     ACanvas.Handle := Message.ChildDC;
     GradientFillCanvas (ACanvas, clRed, clGreen, EditPlace.ClientRect,
       gdHorizontal);
   finally
     ACanvas.Handle := 0;
     ACanvas.Free;
   end;
   SetBkMode(Message.ChildDC, TRANSPARENT);
   Message.Result := GetStockObject(NULL_BRUSH);
 end;
end;

end.

if Message.DC <> 0 then
   inherited

unit HsGradientEdit;

interface
uses
 Messages, Graphics, Controls, StdCtrls;

type
 THsGradientEdit = class(TEdit)
 private
   FEndColor: TColor;
   FStartColor: TColor;
   procedure CnCtlColorEdit (var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT;
   procedure SetEndColor(const Value: TColor);
   procedure SetStartColor(const Value: TColor);
 published
   property StartColor: TColor read FStartColor write SetStartColor;
   property EndColor: TColor read FEndColor write SetEndColor;
 end;

implementation
uses
 Windows, HsGradient;

{ THsGradientEdit }

procedure THsGradientEdit.CnCtlColorEdit(var Message: TWMCtlColorEdit);
var
 ACanvas: TCanvas;
 GradientFill: THSGradientFill;
begin
 GradientFill := THSGradientFill.Create;
 try
   GradientFill.StartColor := FStartColor;
   GradientFill.EndColor := FEndColor;
   GradientFill.Style := gsHorizontal;
   ACanvas := TCanvas.Create;
   try
     ACanvas.Handle := Message.ChildDC;
     GradientFill.FillRect(ACanvas, ClientRect);
   finally
     ACanvas.Handle := 0;
     ACanvas.Free;
   end;
 finally
   GradientFill.Free;
 end;
 SetBkMode(Message.ChildDC, TRANSPARENT);
 SelectObject(Message.ChildDC, Font.Handle);
 Message.Result := GetStockObject(NULL_BRUSH);
end;

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

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

end.