Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to create a colored caret in a TMemo Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
23-Oct-03
Category
Reporting /Printing
Language
Delphi 2.x
Views
160
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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



			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC