Author: Jonas Bilinkevicius
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:
1 unit DisplayMemo;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls;
8
9 type
10 TDisplayMemo = class(TcustomMemo)
11 private
12 { Private declarations }
13 procedure WMSetFocus(var msg: TWMSetFocus); message WM_SETFOCUS;
14 procedure WMKillFocus(var msg: TWMKillFocus); message WM_KILLFOCUS;
15 protected
16 { Protected declarations }
17 procedure WndProc(var message: TMessage); override;
18 public
19 { Public declarations }
20 constructor Create(aOwner: TComponent); override;
21 published
22 { Publish most of the stuff TMemo publishes, rest commented out }
23 property Align;
24 property Alignment;
25 property Anchors;
26 property BiDiMode;
27 property BorderStyle;
28 property Color default $C0FFFF;
29 property Constraints;
30 property Ctl3D;
31 property DragCursor;
32 property DragKind;
33 property DragMode;
34 property Enabled;
35 property Font;
36 {property HideSelection;}
37 property ImeMode;
38 property ImeName;
39 property Lines;
40 property MaxLength;
41 property OEMConvert;
42 property ParentBiDiMode;
43 property ParentColor;
44 property ParentCtl3D;
45 property ParentFont;
46 property ParentShowHint;
47 property PopupMenu;
48 {property ReadOnly;}
49 property ScrollBars;
50 property ShowHint;
51 property TabOrder;
52 property TabStop;
53 property Visible;
54 {property WantReturns;}
55 {property WantTabs;}
56 property WordWrap;
57 property OnChange;
58 {property OnClick;}
59 {property OnDblClick;}
60 property OnDragDrop;
61 property OnDragOver;
62 property OnEndDock;
63 property OnEndDrag;
64 property OnEnter;
65 property OnExit;
66 {property OnKeyDown;}
67 {property OnKeyPress;}
68 {property OnKeyUp;}
69 {property OnMouseDown;}
70 {property OnMouseMove;}
71 {property OnMouseUp;}
72 property OnStartDock;
73 property OnStartDrag;
74
75 end;
76
77 procedure register;
78
79 implementation
80
81 procedure register;
82 begin
83 RegisterComponents('PBGoodies', [TDisplayMemo]);
84 end;
85
86 { TDisplayMemo }
87
88 constructor TDisplayMemo.Create(aOwner: TComponent);
89 begin
90 inherited;
91 ReadOnly := True;
92 Color := $C0FFFF;
93 end;
94
95 procedure TDisplayMemo.WMKillFocus(var msg: TWMKillFocus);
96 begin
97 ShowCaret(handle);
98 inherited;
99 end;
100
101 procedure TDisplayMemo.WMSetFocus(var msg: TWMSetFocus);
102 begin
103 inherited;
104 HideCaret(handle);
105 end;
106
107 procedure TDisplayMemo.WndProc(var message: TMessage);
108
109 procedure Scroll(msg, scrollcode: Integer);
110 begin
111 Perform(msg, scrollcode, 0);
112 Perform(msg, SB_ENDSCROLL, 0);
113 end;
114
115 begin
116 if not (csDesigning in ComponentState) then
117 case message.Msg of
118 WM_LBUTTONDOWN, WM_LBUTTONUP, WM_MOUSEMOVE,
119 WM_LBUTTONDBLCLK, WM_CHAR, WM_KEYUP:
120 begin
121 message.Result := 0;
122 if message.Msg = WM_LBUTTONDOWN then
123 if not Focused then
124 SetFocus;
125 Exit;
126 end;
127 WM_KEYDOWN:
128 begin
129 case message.WParam of
130 VK_DOWN: Scroll(WM_VSCROLL, SB_LINEDOWN);
131 VK_UP: Scroll(WM_VSCROLL, SB_LINEUP);
132 VK_LEFT: Scroll(WM_HSCROLL, SB_LINELEFT);
133 VK_RIGHT: Scroll(WM_HSCROLL, SB_LINERIGHT);
134 VK_NEXT: Scroll(WM_VSCROLL, SB_PAGEDOWN);
135 VK_PRIOR: Scroll(WM_VSCROLL, SB_PAGEUP);
136 VK_HOME: Scroll(WM_VSCROLL, SB_TOP);
137 VK_END: Scroll(WM_VSCROLL, SB_BOTTOM);
138 end;
139 message.Result := 0;
140 Exit;
141 end;
142 end;
143 inherited;
144 end;
145
146 end.
|
