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;

 

posted on 2010-01-17 15:01  oKmAn.Org  阅读(565)  评论(0编辑  收藏  举报