Další vylepšení komponenty Edit

A máme tu další vylepšení komponenty Edit. Abych se přiznal, jako odchovanec osmibitových počítačů a dalších podobných staříků jsem měl moc rád, když kurzor při zadávání textu měl podobu blikajícího čtverečku a ve Windows (a dalších systémech) používaná svislá "čárka" se mi moc nelíbí. Ukážeme si teď, jak u komponenty Edit tento svislý a poněkud nudný kurzor změnit.
Umístěte si tedy na formulář nějaký EditBox a pak přidejte následující kód:
.
.
.
public
{ Public declarations }
CaretBm : TBitmap;
CaretBmBk : TBitmap;
OldEditsWindowProc : Pointer;
.
.
.
type
WParameter = LongInt;
LParameter = LongInt;
.
.
.
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
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');
{-----------------------------------------------------------------}

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;