Own cool text cursor in Editbox

Standard text cursor is boring. What about replacing default vertical line with some cool shape?

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public 
    { Public declarations }
    CaretBm : TBitmap;
    CaretBmBk : TBitmap;
    OldEditsWindowProc : Pointer;
  end;
 
type
  WParameter = LongInt;
  LParameter = LongInt;
 
 
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
function NewWindowProc(WindowHandle : hWnd; TheMessage : WParameter; 

        ParamW : WParameter; ParamL : LParameter) : LongInt stdcall;
begin
  NewWindowProc := CallWindowProc(Form1.OldEditsWindowProc, WindowHandle, 

        TheMessage, ParamW, ParamL);
 
  if TheMessage = WM_SETFOCUS then
  begin
    CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
    ShowCaret(WindowHandle);
  end;
 
  if TheMessage = WM_KILLFOCUS then
  begin
    HideCaret(WindowHandle);
    DestroyCaret;
  end;
 
  if TheMessage = WM_KEYDOWN then
  begin
    if ParamW = VK_BACK then CreateCaret(WindowHandle, Form1.CaretBmBk.Handle, 0, 0)
                        else CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
    ShowCaret(WindowHandle);
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 
  //normal cursor
  CaretBm := TBitmap.Create;
  CaretBm.Canvas.Font.Name := 'WingDings';
  CaretBm.Canvas.Font.Height := Edit1.Font.Height;
  CaretBm.Canvas.Font.Color := clWhite;
  CaretBm.Width := CaretBm.Canvas.TextWidth('J') + 2;
  CaretBm.Height := CaretBm.Canvas.TextHeight('J') + 2;
  CaretBm.Canvas.Brush.Color := clBlue;
  CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width, CaretBm.Height));
  CaretBm.Canvas.TextOut(1, 1, 'J');
 
  //backspace cursor
  CaretBmBk := TBitmap.Create;
  CaretBmBk.Canvas.Font.Name := 'WingDings';
  CaretBmBk.Canvas.Font.Height := Edit1.Font.Height;
  CaretBmBk.Canvas.Font.Color := clWhite;
  CaretBmBk.Width := CaretBmBk.Canvas.TextWidth('L') + 2;
  CaretBmBk.Height := CaretBmBk.Canvas.TextHeight('L') + 2;
  CaretBmBk.Canvas.Brush.Color := clBlue;
  CaretBmBk.Canvas.FillRect(Rect(0, 0, CaretBmBk.Width, CaretBmBk.Height));
  CaretBmBk.Canvas.TextOut(1, 1, 'L');
  OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle, GWL_WNDPROC,  

        LongInt(@NewWindowProc)));
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetWindowLong(Edit1.Handle, GWL_WNDPROC, LongInt(OldEditsWindowProc));
  CaretBm.Free;
  CaretBmBk.Free;
end;
 
end.