Author: Jonas Bilinkevicius
How to create a colored caret in a TMemo
Answer:
It is possible to color the caret. Windows uses inverse color values for its
carets. Black for white, white for black, etc. I made a blue caret by making a
bitmap 7 pixels wide and 14 pixels tall with a black background and yellow
foreground. Here's how I handled it: I'm not sure if I am handling the destruction
correctly or not, that is something I will leave up to you to figure out...
1 unit caret1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, ComCtrls, ExtCtrls;
8
9 const
10 MY_POST_ENTER = WM_USER + 500;
11
12 type
13
14 TForm1 = class(TForm)
15 Edit1: TEdit;
16 Memo1: TMemo;
17 procedure Memo1Exit(Sender: TObject);
18 procedure Memo1Change(Sender: TObject);
19 procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
20 procedure Memo1Enter(Sender: TObject);
21 private
22 { Private declarations }
23 public
24 { Public declarations }
25 procedure MyPost_Enter(var message: TMessage); message MY_POST_ENTER;
26 end;
27
28 var
29 Form1: TForm1;
30 hCaret: HBITMAP;
31
32 implementation
33
34 {$R *.DFM}
35 {$R caret2.res} // caret2.res has the 7 x 14 bitmap in it
36
37 procedure TForm1.MyPost_Enter(var message: TMessage);
38 var
39 CaretHeight: Integer;
40 begin
41 hCaret := LoadBitmap(hInstance, MAKEINTRESOURCE(150));
42 CreateCaret(TWinControl(ActiveControl).Handle, hCaret, 0, 0);
43 ShowCaret(TWinControl(ActiveControl).Handle);
44 end;
45
46 procedure TForm1.Memo1Exit(Sender: TObject);
47 begin
48 DestroyCaret;
49 CreateCaret(TWinControl(ActiveControl).Handle, 1, 1, 1);
50 ShowCaret(TWinControl(ActiveControl).Handle);
51 end;
52
53 procedure TForm1.Memo1Change(Sender: TObject);
54 begin
55 PostMessage(Handle, MY_POST_ENTER, 0, 0);
56 end;
57
58 procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
59 begin
60 PostMessage(Handle, MY_POST_ENTER, 0, 0);
61 end;
62
63 procedure TForm1.Memo1Enter(Sender: TObject);
64 begin
65 PostMessage(Handle, MY_POST_ENTER, 0, 0);
66 end;
67
68 end.
69
70 //DFM Text:
71
72 object Form1: TForm1
73 Left = 270
74 Top = 97
75 Width = 214
76 Height = 192
77 Caption = 'Form1'
78 Color = clBtnFace
79 Font.Charset = DEFAULT_CHARSET
80 Font.Color = clWindowText
81 Font.Height = -11
82 Font.Name = 'MS Sans Serif'
83 Font.Style = []
84 OldCreateOrder = False
85 PixelsPerInch = 96
86 TextHeight = 13
87 object Edit1: TEdit
88 Left = 16
89 Top = 112
90 Width = 121
91 Height = 21
92 TabOrder = 0
93 Text = 'Edit1'
94 OnChange = Memo1Change
95 OnEnter = Memo1Enter
96 OnExit = Memo1Exit
97 end
98 object Memo1: TMemo
99 Left = 8
100 Top = 8
101 Width = 185
102 Height = 89
103 Lines.Strings = ('Memo1')
104 TabOrder = 1
105 OnChange = Memo1Change
106 OnEnter = Memo1Enter
107 OnExit = Memo1Exit
108 end
109 end
|
