怎么实现RichEdit关键字高亮?大家提供一下思路!(200分)

例如文本中有这样的关键字
<begin
>
fdsafdsafdsafd
</begin
>
<begin
>和</begin
>是关键字,编辑的时候关键字不能修改,删除,"fdsafdsafdsafd"只能修改值,关键字颜色为蓝色,要怎么实现比较好,

下面我写的代码,感觉思路不太对.
//----------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, xmldom, XMLIntf, msxmldom, XMLDoc, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
redt1: TRichEdit;
lbl: TLabel;
btn1: TButton;
edt1: TEdit;
btn2: TButton;
procedure redt1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
procedure btn1Click(Sender: TObject);
procedure redt1KeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure btn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
CurPos: TPoint;
KeyWords: TStringList;
end;

var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.redt1MouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
procedure GetCursorPos(var P: TPoint);
begin
P.X := TRichEdit(Sender).CaretPos.X;
p.Y := TRichEdit(Sender).CaretPos.Y;
end;
begin
GetCursorPos(CurPos);
lbl.Caption := format('CurPos.x = %s CurPos.y = %s',[inttostr(CurPos.X), inttostr(CurPos.Y)]);
end;


function IsKeywordsX(const strValue: string): boolean;
const
test1 = '<我不是是关键字>键字>';
test2 = '<我不是是关键字<';
test3 = '<我不是是关键字>我不是>';
test4 = '我不是<关键字>';
var
str: string;
i, j: integer;
begin
result := false;
str := Trim(strValue);
//str := Trim(test1);
i := Pos('<', str);
j := Pos('>', str);
if (i = 1) and ( j = Length(str)) then
begin
str := Copy(str,i + 1, j - 2);
result := not ((Pos(Char('<'), str) > 0) or (Pos(Char('>'), str) > 0));
end;

end;

function GetChar(const List:TStringList;
X, Y:integer;
MoveLen: integer): Char;
var
i,iLineLen: integer;
num: integer;
begin
//Len 是负数时向左，正数时向右。
Result := ' ';
if (List = nil) or (List.Count < Y) or
(Length(List.Strings[Y]) < X) then
Exit;
if MoveLen <= 0 then

begin

//左搜索abs(MoveLen)位
num := abs(MoveLen);
if num <= X then
begin
Result := List.Strings[Y][X-num];
end
else
begin

i := 0;
while num > 0do
begin
iLineLen := Length(List.Strings[Y-i]);
if num < iLineLen then
begin
Result :=List.Strings[Y-i][iLineLen-num];
break;
end;
num := num - iLineLen;
Inc(i);
end;
end;
end
else
//向右搜索abs(MoveLen)
begin
num := abs(MoveLen);
if X+num <= Length(List.Strings[Y]) then
begin
Result :=List.Strings[Y][X+num];
end
else
begin

i := 0;
while num > 0do
begin
iLineLen := Length(List.Strings[Y+i]);
if i = 0 then
num := num - (iLineLen - X)
else
num := num - iLineLen;

if num < iLineLen then
begin
Result :=List.Strings[Y+i][num];
break;
end;
Inc(i);
end;
end;
end;
end;

function GetMaxKeyWordLen(const KeyWords: TStringList):integer;
var
index, Len: integer;
begin
result := 0;
if not Assigned(KeyWords) then
Exit;
for index := 0 to KeyWords.Count - 1do
begin
Len := Length(KeyWords.Strings[index]);
if result < Len then
result := Len;
end;
end;

function InKeywords(const List:TStringList;
const KeyWords: TStringList;
const X, Y: integer): Boolean;
var
LIndex, RIndex: integer;
LSelect, RSelect: Boolean;
KeyChar: Char;
MaxKeyWordLen: integer;
begin
Result := false;
LIndex := 0;
RIndex := 0;
if (List = nil) or (KeyWords = nil) or
(List.Count < Y) or (Length(List.Strings[Y]) < X) then
Exit;
MaxKeyWordLen := GetMaxKeyWordLen(KeyWords);
KeyChar := GetChar(List, X, Y, 0);
LSelect := not (KeyChar = '<');
RSelect := not (KeyChar = '>');
while (LSelect and (LIndex < MaxKeyWordLen)) or (RSelect and (RIndex < MaxKeyWordLen))do
begin
//向左搜索< or > 如果 < LSelect = false 如果 > result false
if LSelect then

begin

inc(LIndex);
KeyChar := GetChar(List, X, Y, -LIndex);
if KeyChar = Char('<') then

LSelect := false;
if KeyChar = Char('>') then

begin
result := false;
end;
end;
//向右搜索< or > 如果 > LSelect = false 如果 < result false
if RSelect then
begin
inc(RIndex);
KeyChar := GetChar(List, X, Y, RIndex);
if KeyChar = Char('>') then

RSelect := false;
if KeyChar = Char('<') then

begin
result := false;
end;
end;
end;

Result := not (LSelect or RSelect);
end;

function ContainKeywords(const KeyWords: TStringList;
const strValue: string): boolean;
var
index: integer;
begin
result := false;
for index := 0 to KeyWords.Count - 1do
begin
if Pos(TStringList(KeyWords).Strings[index], strValue) > 0 then
begin
result := true;
break;
end;
end;
if Result = false then
begin
//还要判断光标begin
和end 是不是要关键字内。
end;
end;

function IsKeywords(const KeyWords: TStringList;
strValue: string): boolean;
var
str: string;
i, j: integer;
index: integer;
begin
result := false;
str := Trim(strValue);
i := Pos('<', str);
j := Pos('>', str);
if (i = 1) and ( j = Length(str)) then
for index := 0 to KeyWords.Count - 1do
begin
if Pos(TStringList(KeyWords).Strings[index], strValue) > 0 then
begin
result := true;
break;
end;
end;
end;

procedure TForm1.btn1Click(Sender: TObject);
procedure GetCursorPos(var P: TPoint);
var
s: string;
text: string;
i, len: integer;
begin
P.Y := SendMessage(TRichEdit(Sender).Handle, EM_LINEFROMCHAR, 0,
TRichEdit(Sender).SelStart);
P.X := (TRichEdit(Sender).SelStart -
SendMessage(TRichEdit(Sender).Handle, EM_LINEINDEX, P.Y, 0));
end;
var
i, len: integer;
text: string;
List: TStringList;
X,Y: integer;
begin
X:= 11;
Y:= 0;
List := TStringList.Create;
try
List.DelimitedText := '<引题>,<引题/>,<标题>,<标题/>,<副题>,<副题/>,<作者>,<作者/>';
List.Delimiter := ',';
if InKeywords(TStringList(redt1.Lines) ,List, X,Y) then
showmessage(TStringList(redt1.Lines).Strings[y][x]);
finally
List.Free;
end;
end;

procedure TForm1.redt1KeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
var
X,Y: integer;
begin
X := TRichEdit(Sender).CaretPos.X;
Y := TRichEdit(Sender).CaretPos.Y;
if Key = VK_DELETE then
begin
if InKeywords(TStringList(redt1.Lines), KeyWords, X, Y) then
begin
showmessage('当前光标在关键字上不能删除！');
Key := Word(#0);

end
else
begin
if TRichEdit(Sender).SelText <> '' then
if ContainKeywords(KeyWords, TRichEdit(Sender).SelText) then
begin
showmessage('包含关键字上不能删除！');
Key := Word(#0);
end
end;
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
KeyWords := TStringList.Create;
KeyWords.DelimitedText := '<1>,<1/>,<2>,<2/>,<3>,<3/>,<3>,<3/>,<4>,<4/>,<5>,<5/>,<6>,<6/>,<7>,<7/>,<8>,<8/>,<9>,<9/>,<10>,<10/>,<11>,<11/>';
KeyWords.Delimiter := ',';
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
if redt1.SelStart > 0 then
showmessage(inttostr(redt1.SelStart));
if (redt1.SelText <>'') and
ContainKeywords(KeyWords, redt1.SelText) then
showmessage('你不能删除，选中的内容包含关键字！');

end;

end.

RXrichedit 用这个吧

procedure TForm1.LightKeyWords(Words: string;
Color: TColor;
RichEdit: TRichEdit);
var
StartPos : Integer;
ToEnd : Integer;
FindAt : Integer;
FindNum : Integer;
tmpPos : integer;
KeyWord : string;
clString : string;
begin
FindNum:=0;
if trim(Words)='' then
Exit;
if RichEdit=nil then
Exit;
KeyWord:=trim(Words);
FindNum:=0;
tmpPos:=RichEdit.SelStart;
StartPos := 0;
ToEnd := Length(RichEdit.Text);
repeat
FindAt := RichEdit.FindText(KeyWord, StartPos, ToEnd, []);
if FindAt<>-1 then
begin
StartPos := FindAt+Length(KeyWord);
ToEnd := Length(RichEdit.Text)-StartPos;
RichEdit.SelStart := FindAt;
RichEdit.SelLength := Length(KeyWord);
RichEdit.SelAttributes.Color := Color;
PostMessage(RichEdit.Handle, EM_SCROLLCARET, 0, 0);
FindNum:=FindNum+1;
end;
until FindAt =-1;
RichEdit.SelStart:=tmpPos;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
LightKeyWords('<begin
>',clBlue,RichEdit1);
LightKeyWords('</begin
>',clBlue,RichEdit1);
end;

procedure TForm1.RichEdit1SelectionChange(Sender: TObject);
function CanReadOnly(sRichEdit:TRichEdit):boolean;
var
tempRE:TRichEdit;
i:integer;
begin
Result:=False;
if sRichEdit.SelLength<1 then
Exit;
sRichEdit.CopyToClipboard;
tempRE:=TRichEdit.Create(self);
tempRE.Visible:=False;
tempRE.Parent:=self;
tempRE.PasteFromClipboard;
for i:=0 to length(tempRE.Text)do
begin
tempRE.SelStart:=i;
tempRE.SelLength:=1;
if tempRE.SelAttributes.Color=clBlue then
begin
Result:=True;
Break;
end;
end;
tempRE.Free;
end;
begin
RichEdit1.ReadOnly:=CanReadOnly(RichEdit1)
end;

谢谢康凌了，我还有个问题，有兴趣我再+200，怎么实现禁止RichEdit拖动文本到关键字里面