How to disable the caret in a TMemo or TRichEdit

Mirror

How to disable the caret in a TMemo or TRichEdit (Views: 714)

Problem/Question/Abstract:

How can I "turn off" the caret in a TRichEdit control? I want to use the control as a viewer only. I have ReadOnly selected but it still wants to display a caret.

Answer:

You can try to do the same the following TCustomMemo descendent does with a TCustomRichedit descendent:

unit DisplayMemo;

interface

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

type
  TDisplayMemo = class(TcustomMemo)
  private
    { Private declarations }
    procedure WMSetFocus(var msg: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var msg: TWMKillFocus); message WM_KILLFOCUS;
  protected
    { Protected declarations }
    procedure WndProc(var Message: TMessage); override;
  public
    { Public declarations }
    constructor Create(aOwner: TComponent); override;
  published
    { Publish most of the stuff TMemo publishes, rest commented out }
    property Align;
    property Alignment;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property Color default $C0FFFF;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    {property HideSelection;}
    property ImeMode;
    property ImeName;
    property Lines;
    property MaxLength;
    property OEMConvert;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    {property ReadOnly;}
    property ScrollBars;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    {property WantReturns;}
    {property WantTabs;}
    property WordWrap;
    property OnChange;
    {property OnClick;}
    {property OnDblClick;}
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    {property OnKeyDown;}
    {property OnKeyPress;}
    {property OnKeyUp;}
    {property OnMouseDown;}
    {property OnMouseMove;}
    {property OnMouseUp;}
    property OnStartDock;
    property OnStartDrag;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('PBGoodies', [TDisplayMemo]);
end;

{ TDisplayMemo }

constructor TDisplayMemo.Create(aOwner: TComponent);
begin
  inherited;
  ReadOnly := True;
  Color := $C0FFFF;
end;

procedure TDisplayMemo.WMKillFocus(var msg: TWMKillFocus);
begin
  ShowCaret(handle);
  inherited;
end;

procedure TDisplayMemo.WMSetFocus(var msg: TWMSetFocus);
begin
  inherited;
  HideCaret(handle);
end;

procedure TDisplayMemo.WndProc(var Message: TMessage);

  procedure Scroll(msg, scrollcode: Integer);
  begin
    Perform(msg, scrollcode, 0);
    Perform(msg, SB_ENDSCROLL, 0);
  end;

begin
  if not (csDesigning in ComponentState) then
    case Message.Msg of
      WM_LBUTTONDOWN, WM_LBUTTONUP, WM_MOUSEMOVE,
        WM_LBUTTONDBLCLK, WM_CHAR, WM_KEYUP:
        begin
          Message.Result := 0;
          if Message.Msg = WM_LBUTTONDOWN then
            if not Focused then
              SetFocus;
          Exit;
        end;
      WM_KEYDOWN:
        begin
          case Message.WParam of
            VK_DOWN: Scroll(WM_VSCROLL, SB_LINEDOWN);
            VK_UP: Scroll(WM_VSCROLL, SB_LINEUP);
            VK_LEFT: Scroll(WM_HSCROLL, SB_LINELEFT);
            VK_RIGHT: Scroll(WM_HSCROLL, SB_LINERIGHT);
            VK_NEXT: Scroll(WM_VSCROLL, SB_PAGEDOWN);
            VK_PRIOR: Scroll(WM_VSCROLL, SB_PAGEUP);
            VK_HOME: Scroll(WM_VSCROLL, SB_TOP);
            VK_END: Scroll(WM_VSCROLL, SB_BOTTOM);
          end;
          Message.Result := 0;
          Exit;
        end;
    end;
  inherited;
end;

end.

<< Back to main page