1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
RichEdit1: TRichEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
ReservedWords: array[0..75] of string =
('and', 'array', 'as', 'asm', 'at', 'begin', 'case', 'class', 'const',
'constructor', 'default', 'destructor', 'dispinterface', 'div', 'do',
'downto', 'else', 'end', 'except', 'exports', 'file', 'finalization',
'finally', 'for', 'function', 'goto', 'if', 'implementation', 'in',
'inherited', 'initialization', 'inline', 'interface', 'is', 'label',
'library', 'message', 'mod', 'nil', 'not', 'object', 'of', 'on', 'or',
'out', 'packed', 'procedure', 'program', 'property', 'raise', 'read',
'record', 'repeat', 'resourcestring', 'set', 'shl', 'shr', 'string',
'stored', 'then', 'threadvar', 'to', 'try', 'type', 'unit', 'until',
'uses', 'var', 'while', 'with', 'write', 'xor', 'private', 'protected',
'public', 'published');
AllowedChars: array[0..5] of string =
('(', ')', '[', ']', ' ', '');
t, t1, t2, t3: boolean;
implementation
{$R *.dfm}
procedure HighlightReservedWords(re: Trichedit);
var
i, j, k: integer;
rword, str: string;
begin
for i:= 1 to length(re.Text) do
for j:= 0 to High(ReservedWords) do
begin
application.processmessages;
rword:= ReservedWords[j];
str:= Copy(re.text, i, Length(rword));
if (str = rword) then
begin
re.SelStart:= i - 1;
re.Sellength:= length(rword);
re.SelAttributes.Color:= clnavy;
re.SelAttributes.style:= [fsbold];
end;
end;
end;
procedure HighlightStrings(re: TRichedit);
var
i: integer;
begin
t:= false;
for i:= 1 to length(re.text) do
begin
application.processmessages;
if not (t) then
begin
if re.text[i] = '''' then
begin
t:= true;
re.selstart:= i - 1;
end;
end else
if (t) and (re.Text[i] = '''') then
begin
t:= false;
re.SelLength:= i - re.selstart;
re.SelAttributes.Color:= clblue;
re.SelAttributes.Style:= [];
end;
end;
end;
procedure HighLightComments(re: TRichedit);
var
i: integer;
str: string;
begin
t1:= false;
t2:= false;
t3:= false;
for i:= 1 to length(re.text) do
begin
application.processmessages;
str:= copy(re.text, i, 2);
if not ((t1) or (t2) or (t3)) then
begin
if str = '//' then
t1:= true;
if str = '(*' then
t2:= true;
if str[1] = '{' then
t3:= true;
if ((t1) or (t2) or (t3)) then
re.SelStart:= i - 1;
end else
begin
if (t1) and (str = #13#10) then
begin
t1:= false;
re.SelLength:= i - re.selstart + 1;
re.SelAttributes.Color:= clgreen;
re.SelAttributes.Style:= [];
end;
if (t2) and (str = '*)') then
begin
t2:= false;
re.SelLength:= i - re.SelStart + 1;
re.SelAttributes.Color:= clgreen;
re.SelAttributes.Style:= [];
end;
if (t3) and (str[1] = '}') then
begin
t3:= false;
re.SelLength:= i - re.SelStart;
re.SelAttributes.Color:= clgreen;
re.SelAttributes.Style:= [];
end;
end;
end;
end;
procedure SyntaxHighLighting(re: TRichEdit);
begin
re.Font.Name:= 'arial';
re.Font.Color:= clblack;
HighlightReservedWords(re);
HighlightStrings(re);
HighlightComments(re);
HighlightStrings(re); end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SyntaxHighLighting(Richedit1);
end;
end. |
