How to disable the caret in a TMemo or TRichEdit (Views: 1213)
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. |