在 RichEdit 中实现代码着色

下面的代码将以指定颜色对一些指定单词着色，就象delphi中的代码编辑器那样。

procedure CodeColors(Form : TForm;Style : String; RichE : TRichedit;

                        InVisible : Boolean);

const

 // 符号...

 CodeC1: array[0..20] of String = ('#','$','(',')','*',',',

         '.','/',':',';','[',']','{','}','<','>',

         '-','=','+','''','@');

 // 保留字...

 CodeC2: array[0..44] of String = ('and','as','begin',

         'case','char','class','const','downto',

         'else','end','except','finally','for',

         'forward','function','if','implementation','interface',

         'is','nil','or','private','procedure','public','raise',

         'repeat','string','to','try','type','unit','uses','var',

         'while','external','stdcall','do','until','array','of',

         'in','shr','shl','cos','div');

var

 FoundAt : LongInt;

 StartPos, ToEnd, i : integer;

 OldCap,T : String;

 FontC, BackC, C1, C2 ,C3 ,strC, strC1 : TColor;

begin

 OldCap := Form.Caption;

 with RichE do

 begin

   Font.Name := 'Courier New';

   Font.Size := 10;

   if WordWrap then WordWrap := false;

   SelectAll;

   SelAttributes.color := clBlack;

   SelAttributes.Style := [];

   SelStart := 0;

   if InVisible then

   begin

     Visible := False;

     Form.Caption := 'Executing Code Coloring...';

   end;

 end;

 BackC := clWhite; FontC := clBlack;

 C1 := clBlack; C2 := clBlack; C3 := clBlack;

 strC := clBlue; strC1 := clSilver;

 if Style = 'Twilight' then

 begin

   BackC := clBlack; FontC := clWhite;

   C1 := clLime; C2 := clSilver; C3 := clAqua;

   strC := clYellow; strC1 := clRed;

 end

 else

 if Style = 'Default' then

 begin

   BackC := clWhite; FontC := clBlack;

   C1 := clTeal; C2 := clMaroon; C3 := clBlue;

   strC := clMaroon; strC1 := clSilver;

 end

 else

 if Style = 'Ocean' then

 begin

   BackC := $00FFFF80; FontC := clBlack;

   C1 := clMaroon; C2 := clBlack; C3 := clBlue;

   strC := clTeal; strC1 := clBlack;

 end

 else

 if Style = 'Classic' then

 begin

   BackC := clNavy; FontC := clYellow;

   C1 := clLime; C2 := clSilver; C3 := clWhite;

   strC := clAqua; strC1 := clSilver;

 end

 else

 begin

   with RichE do

   begin

     T := '{'+Style+' = Invalid Style [Default,Classic,Twilight,Ocean] ONLY! }';

     Lines.Insert(0,T);

     StartPos := 0;

     ToEnd := Length(Text) - StartPos;

     FoundAt := FindText(T, StartPos, ToEnd, [stWholeWord]);

     SelStart := FoundAt;

     SelLength := Length(T);

     SelAttributes.Color := clRed;

     SelAttributes.Style := [fsBold];

     StartPos := 0;

     ToEnd := Length(Text) - StartPos;

     FoundAt := FindText('ONLY!', StartPos, ToEnd, [stWholeWord]);

     SelStart := FoundAt;

     SelLength := 4;

     SelAttributes.Color := clRed;

     SelAttributes.Style := [fsBold,fsUnderLine];

   end;

 end;

 RichE.SelectAll;

 RichE.color := BackC;

 RichE.SelAttributes.color := FontC;

 for i := 0 to 100 do

 begin

   with RichE do

   begin

     StartPos := 0;

     ToEnd := Length(Text) - StartPos;

     FoundAt := FindText(IntToStr(i), StartPos, ToEnd, [stWholeWord]);

     while (FoundAt <> -1) do

     begin

       SelStart := FoundAt;

       SelLength := Length(IntToStr(i));

       SelAttributes.Color := C1;

       SelAttributes.Style := [];

       StartPos := FoundAt + Length(IntToStr(i));

       FoundAt := FindText(IntToStr(i), StartPos, ToEnd, [stWholeWord]);

     end;

   end;

 end;

 for i := 0 to 20 do

 begin

   with RichE do

   begin

     StartPos := 0;

     ToEnd := Length(Text) - StartPos;

     FoundAt := FindText(CodeC1[i], StartPos, ToEnd, []);

     while (FoundAt <> -1) do

     begin

       SelStart := FoundAt;

       SelLength := Length(CodeC1[i]);

       SelAttributes.Color := C2;

       StartPos := FoundAt + Length(CodeC1[i]);

       FoundAt := FindText(CodeC1[i], StartPos, ToEnd, []);

     end;

   end;

 end;

 for i := 0 to 44 do

 begin

   with RichE do

   begin

     StartPos := 0;

     ToEnd := Length(Text) - StartPos;

     FoundAt := FindText(CodeC2[i], StartPos, ToEnd, [stWholeWord]);

     while (FoundAt <> -1) do

     begin

       SelStart := FoundAt;

       SelLength := Length(CodeC2[i]);

       SelAttributes.Color := C3;

       SelAttributes.Style := [fsBold];

       StartPos := FoundAt + Length(CodeC2[i]);

       FoundAt := FindText(CodeC2[i], StartPos, ToEnd, [stWholeWord]);

     end;

   end;

 end;

 Startpos := 0;

 with RichE do

 begin

   FoundAt := FindText('''', StartPos, Length(Text), []);

   while FoundAt <> -1 do

   begin

     SelStart := FoundAt;

     Startpos := FoundAt+1;

     FoundAt := FindText('''', StartPos, Length(Text), []);

     if FoundAt <> -1 then

     begin

       SelLength := (FoundAt - selstart)+1;

       SelAttributes.Style := [];

       SelAttributes.Color := strC;

       StartPos := FoundAt+1;

       FoundAt := FindText('''', StartPos, Length(Text), []);

     end;

   end;

 end;

 Startpos := 0;

 with RichE do

 begin

   FoundAt := FindText('{', StartPos, Length(Text), []);

   while FoundAt <> -1 do

   begin

     SelStart := FoundAt;

     Startpos := FoundAt+1;

     FoundAt := FindText('}', StartPos, Length(Text), []);

     if FoundAt <> -1 then

     begin

       SelLength := (FoundAt - selstart)+1;

       SelAttributes.Style := [];

       SelAttributes.Color := strC1;

       StartPos := FoundAt+1;

       FoundAt := FindText('{', StartPos, Length(Text), []);

     end;

   end;

 end;  

 if InVisible then

 begin

   RichE.Visible := True;

   Form.Caption := OldCap;

 end;

 RichE.SelStart := 0;

end;