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.

unit HSGradient;

interface
uses
 Windows, Graphics;

type
 THSGradientStyle = (gsNone, gsHorizontal, gsVertical);

 THSGradientFill = class
 private
   FStartColor: TColor;
   FEndColor: TColor;
   FStyle: THSGradientStyle;
 public
   procedure FillRect (ACanvas: TCanvas; ARect: TRect);
   property StartColor: TColor read FStartColor write FStartColor;
   property EndColor: TColor read FEndColor write FEndColor;
   property Style: THSGradientStyle read FStyle write FStyle;
 end;

implementation
uses
 HSMsImg;

{ THSGradientFill }

procedure THSGradientFill.FillRect(ACanvas: TCanvas; ARect: TRect);
const
 StdGradientRect: GRADIENT_RECT = (UpperLeft: 0; LowerRight: 1);
 GradientDirections: array[Boolean] of Integer = (GRADIENT_FILL_RECT_H,
   GRADIENT_FILL_RECT_V);
var
 Vert: array[0..1] of THSTriVertex;
begin
 Vert[0].Red := Word(GetRValue(FStartColor)) shl 8;
 Vert[0].Green := Word(GetGValue(FStartColor)) shl 8;
 Vert[0].Blue := Word(GetBValue(FStartColor)) shl 8;
 Vert[1].Red := Word(GetRValue(FEndColor)) shl 8;
 Vert[1].Green := Word(GetGValue(FEndColor)) shl 8;
 Vert[1].Blue := Word(GetBValue(FEndColor)) shl 8;
 Vert[0].x := ARect.Left;
 Vert[0].y := ARect.Top;
 Vert[1].y := ARect.Bottom;
 Vert[1].x := ARect.Right;
 HSGradientFill(ACanvas.Handle, PHSTriVertex(@Vert), 2, @StdGradientRect, 1,
   GradientDirections[FStyle = gsVertical]);
end;

end.

{
  Модуль: HsMsImg

  Описание: Интерфейс к функциям MSIMG32

  Автор: Игорь Шевченко

  Дата создания: 18.10.2002

  История изменений:
}
unit HSMsImg;

interface
uses
 Windows;

type
 THSTriVertex = packed record
   x: LongInt;
   y: LongInt;
   Red: Word;
   Green: Word;
   Blue: Word;
   Alpha: Word;
 end;
 PHSTriVertex = ^THSTriVertex;

function HSGradientFill(DC: HDC; Vertex: PHSTriVertex; NumVertex: ULONG;
 Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall;
const
 { gradient drawing modes }
 GRADIENT_FILL_RECT_H = $00000000;
 GRADIENT_FILL_RECT_V = $00000001;
 GRADIENT_FILL_TRIANGLE = $00000002;
 GRADIENT_FILL_OP_FLAG = $000000ff;

implementation

type
 THSGradientFill = function (DC: HDC; Vertex: PHSTriVertex; NumVertex: ULONG;
   Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall;
var
 _HSGradientFill: THSGradientFill;
 DllHandle: THandle;

const
 Dllname = 'msimg32.dll';

function InitLib: Boolean;
begin
 if DllHandle = 0 then begin
   DllHandle := LoadLibrary(Dllname);
   if DllHandle <> 0 then begin
     @_HSGradientFill := GetProcAddress(DllHandle, 'GradientFill');
   end;
 end;
 Result := DllHandle <> 0;
end;

function HSGradientFill(DC: HDC; Vertex: PHSTriVertex; NumVertex: ULONG;
 Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall;
begin
 if InitLib and Assigned(_HSGradientFill) then
   Result := _HSGradientFill(DC, Vertex, NumVertex, Mesh, NumMesh, Mode)
 else begin
   Result := false;
   SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
 end;
end;

initialization
finalization
 if DllHandle <> 0 then
   FreeLibrary(DllHandle);
end.