type
  TEditState   = (esCaretVisible);
  TEditStates  = set of TEditState;

  TEditor = class(TCustomControl)
  private
    FCaretWidth: Integer;
    FState: TEditStates;
    FScrollBars: TScrollStyle;
    FScrollMaxX: Integer;
    FScrollMaxY: Integer;
    FScrollPagX: Integer;
    FScrollPagY: Integer;
    FScrollPosX: Integer;
    FScrollPosY: Integer;
    FTextHeight: Integer;
    FTextWidth: Integer;
  private
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  protected
    procedure DoShowCaret;
    procedure DoHideCaret;
    procedure DoScrollBy(DeltaX, DeltaY: Integer); virtual;
    procedure DoScrollTo(PosX, PosY: Integer); virtual;
    procedure DoScrollToCaret; virtual;
    procedure ReCalcTextHeight; virtual;
    procedure UpdateCaret; virtual;
    procedure UpdateScrollBars; virtual;
  end;

procedure TEditor.WMKillFocus(var Message: TWMSetFocus);
begin
  DoHideCaret;
  inherited;
end;

procedure TEditor.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  DoShowCaret;
end;

procedure TEditor.DoShowCaret;
begin
  if (HandleAllocated) and not (csDesigning in ComponentState) and
     (Focused) then
    begin
        if (FTextHeight < 4) then ReCalcTextHeight;
        if (FCaretWidth < 1) then FCaretWidth := 1;
        if not (eoReadOnly in FOptions) and not (esCaretVisible in FState) then
          begin
              Windows.CreateCaret(Handle, 0, FCaretWidth, FTextHeight);
              Windows.ShowCaret(Handle);
              FState := FState + [esCaretVisible];
          end;
        UpdateCaret;
    end;
end;

procedure TEditor.DoHideCaret;
begin
  if (HandleAllocated) and (esCaretVisible in FState) then
    begin
        Windows.HideCaret(Handle);
        Windows.DestroyCaret;
        FState := FState - [esCaretVisible];
    end;
end;

procedure TEditor.DoScrollBy(DeltaX, DeltaY: Integer);
begin
  DoScrollTo(FScrollPosX + DeltaX, FScrollPosY + DeltaY);
end;

procedure TEditor.DoScrollTo(PosX, PosY: Integer);
begin
  if (PosX < 0)
    then PosX := 0
    else
  if (PosX > FScrollMaxX)
    then PosX := FScrollMaxX;
  if (PosY < 0)
    then PosY := 0
    else
  if (PosY > FScrollMaxY)
    then PosY := FScrollMaxY;

  if (PosX <> FScrollPosX) or
     (PosY <> FScrollPosY) then
    begin
        FScrollPosX := PosX;
        FScrollPosY := PosY;
        Refresh;
        UpdateCaret;
        UpdateScrollBars;
    end;
end;

procedure TEditor.DoScrollToCaret;
var
  X, Y: Integer;
begin
  CalcPosToCoord(CaretPos, X, Y);
  if (X <= 0) or (X >= ClientWidth) then
    begin
        dec(X, ClientWidth div 2);
        if (FTextWidth > 0) then X := X div FTextWidth;
    end
  else
      X := 0;
  if (Y <= 0) or (Y > (ClientHeight - FTextHeight)) then
    begin
        if (FTextHeight > 0) then Y := Y div FTextHeight;
        dec(Y, 1);
    end
  else
      Y := 0;
  DoScrollBy(X, Y);
  UpdateCaret;
end;

procedure TCustomEditor.ReCalcTextHeight;
var
  I: Integer;
begin
  I := Canvas.TextHeight('Xy');
  if (I <> FTextHeight) then
    begin
        DoHideCaret;
        FTextHeight := I;
        DoShowCaret;
    end;
end;

procedure TEditor.UpdateCaret;
var
  X, Y: Integer;
begin
  if (esCaretVisible in FState) then
    begin
        CalcPosToCoord(CaretPos, X, Y)
        Windows.SetCaretPos(X, Y);
    end;
end;

procedure TEditor.UpdateScrollBars;
var
  S: TScrollInfo;
begin
  if (FTextWidth > 0) then FScrollPagX := ClientWidth div FTextWidth;
  if (FTextHeight > 0) then FScrollPagY := ClientHeight div FTextHeight;
  if (HandleAllocated) and (FScrollBars in [ssHorizontal, ssBoth]) then
    begin
        S.cbSize := SizeOf(S);
        S.fMask := SiF_POS or SIF_RANGE or SIF_PAGE or SIF_DISABLENOSCROLL;
        S.nPos := FScrollPosX;
        S.nMin := 0;
        S.nMax := FScrollMaxX;
        if (FScrollPagX > 0) then
          inc(S.nMax, FScrollPagX - 1);
        S.nPage := FScrollPagX;
        SetScrollInfo(WindowHandle, SB_HORZ, S, true);
    end;
  if (HandleAllocated) and (FScrollBars in [ssVertical, ssBoth]) then
    begin
        S.cbSize := SizeOf(S);
        S.fMask := SiF_POS or SIF_RANGE or SIF_PAGE or SIF_DISABLENOSCROLL;
        S.nPos := FScrollPosY;
        S.nMin := 0;
        S.nMax := FScrollMaxY;
        if (FScrollPagY > 0) then
          inc(S.nMax, FScrollPagY - 1);
        S.nPage := FScrollPagY;
        SetScrollInfo(WindowHandle, SB_VERT, S, true);
    end;
end;
