Delphi Richedit代码语法加亮显示

procedure CodeColors(Form : TForm;Style : String; RichE : TRichedit;InVisible : Boolean); 
const 
  // symbols... 
  CodeC1: array[0..20] of String = ('#','$','(',')','*',',', 
          '.','/',':',';','[',']','{','}','<','>', 
          '-','=','+','''','@'); 
  // reserved words... 
  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;

procedure TFrmain.BitBtn1Click(Sender: TObject);
begin
  CodeColors(Self, 'ss', RichEdit1, True);
end;