Амеба
Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград
Репутация: 109
Всего: 459
|
Было дело сам решал такую задачу. Вот готовый пример со скобками, директивами и т.д. | Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Menus;
const
commentCl = $800000;
commentSt = [fsItalic];
keyWordCl = clBlack;
keyWordSt = [fsBold];
directiveCl = clGreen;
directiveSt = [];
NumberCl = $800000;
NumberSt = [];
StringCl = $800050;
StringSt = [];
type
TForm1 = class(TForm)
RichEdit1: TRichEdit;
Button1: TButton;
OpenDialog1: TOpenDialog;
ScrollBox1: TScrollBox;
PopupMenu1: TPopupMenu;
Copy1: TMenuItem;
procedure HighLight;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Copy1Click(Sender: TObject);
private
{ Private declarations }
public
Procedure HighLightKeyWord(nStr, pos, htype : integer);
Procedure HighLightString(nStr, start, fin : integer);
Procedure HighLightComment(nStr, start, fin : integer);
Procedure HighLightNumber(nStr, start, fin : integer);
Procedure HighLightDirective(nStr, start, fin : integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const TheList : array[1..101] of string =
('absolute',
'abstract',
'and',
'array',
'as',
'asm',
'automated',
'begin',
'case',
'cdecl',
'class',
'const',
'constructor',
'default',
'deprecated',
'destructor',
'dispid',
'dispinterface',
'div',
'do',
'downto',
'dynamic',
'else',
'end',
'except',
'export',
'exports',
'external',
'far',
'file',
'finalization',
'finally',
'for',
'forward',
'function',
'goto',
'if',
'implementation',
'implements',
'in',
'index',
'inherited',
'initialization',
'inline',
'interface',
'is',
'label',
'library',
'local',
'message',
'mod',
'near',
'nil',
'not',
'nondefault',
'object',
'of',
'on',
'or',
'out',
'overload',
'override',
'package',
'packed',
'pascal',
'platform',
'private',
'procedure',
'program',
'property',
'protected',
'public',
'published',
'raise',
'read',
'record',
'register',
'reintroduce',
'repeat',
'resourcestring',
'safecall',
'set',
'shl',
'shr',
'stdcall',
'stored',
'then',
'threadvar',
'to',
'try',
'type',
'unit',
'until',
'uses',
'var',
'varargs',
'virtual',
'while',
'with',
'write',
'xor');
//-----------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
richedit1.Font.Name := 'Courier New';
richedit1.Font.Size := 11;
end;
//--------------------------------------------------------------
Function DefineKeyWord(s : AnsiString) : integer;
var
i, j : integer;
C, W : Integer;
ls, lw : integer;
Begin
C := 1;
W := -1;
ls := Length(s);
For i := 1 to High(theList)
do
Begin
j := 1;
lw := Length(theList[i]);
While (j <= lw) and (j <= ls) and (s[j] = theList[i, j])
do
inc(j);
if (C < j) and
(not (s[j] in ['a'..'z','0'..'9'])) and
(lw = (j - 1))
then
Begin
C := j;
W := i;
end;
end;
Result := W;
end;
//--------------------------------------------------------------
Procedure TForm1.HighLightKeyWord(nStr, pos, htype : integer);
var
p : TPoint;
Begin
p.Y := nStr;
p.X := pos - 1;
RichEdit1.CaretPos := p;
RichEdit1.SelLength := Length(TheList[htype]);
RichEdit1.SelAttributes.Color := KeyWordCl;
RichEdit1.SelAttributes.Style := KeyWordSt;
end;
//--------------------------------------------------------------
Procedure TForm1.HighLightString(nStr, start, fin : integer);
var
p : TPoint;
Begin
p.Y := nStr;
p.X := start - 1;
RichEdit1.CaretPos := p;
RichEdit1.SelLength := fin - start + 1;
RichEdit1.SelAttributes.Color := StringCl;
RichEdit1.SelAttributes.Style := StringSt;
end;
//--------------------------------------------------------------
Procedure TForm1.HighLightComment(nStr, start, fin : integer);
var
p : TPoint;
Begin
p.Y := nStr;
p.X := start - 1;
RichEdit1.CaretPos := p;
RichEdit1.SelLength := fin - start + 1;
RichEdit1.SelAttributes.Color := CommentCl;
RichEdit1.SelAttributes.Style := CommentSt;
end;
//--------------------------------------------------------------
Procedure TForm1.HighLightDirective(nStr, start, fin : integer);
var
p : TPoint;
Begin
p.Y := nStr;
p.X := start - 1;
RichEdit1.CaretPos := p;
RichEdit1.SelLength := fin - start + 1;
RichEdit1.SelAttributes.Color := DirectiveCl;
RichEdit1.SelAttributes.Style := DirectiveSt;
end;
//--------------------------------------------------------------
Procedure TForm1.HighLightNumber(nStr, start, fin : integer);
var
p : TPoint;
Begin
p.Y := nStr;
p.X := start - 1;
RichEdit1.CaretPos := p;
RichEdit1.SelLength := fin - start + 1;
RichEdit1.SelAttributes.Color := NumberCl;
RichEdit1.SelAttributes.Style := NumberSt;
end;
//--------------------------------------------------------------
procedure TForm1.HighLight;
var
WStart, WEnd, WEnd2 : integer;
WorkSpace, SWord : Ansistring;
i, j, k : Integer;
lStr : AnsiString;
l, t : Integer;
p : boolean;
eolnS : boolean;
isdirective: boolean;
begin
i := 0;
While i < RichEdit1.Lines.Count
do
Begin
lStr := lowercase(RichEdit1.Lines.Strings[i]);
l := Length(lStr);
j := 1;
While j <= l
do
Begin
Case lStr[j] of
'{' :
Begin
if lStr[j + 1] = '$'
then
isDirective := true
else
isDirective := false;
p := false;
k := 0;
Repeat
eolnS := false;
Repeat
inc(k);
if (j + k) > l
then
Begin
eolnS := true;
break
end;
until lStr[j + k] = '}';
if not eolnS
then
Begin
t := j + k;
Break
end;
if isDirective
then
HighLightDirective(i, j, l)
else
HighLightComment(i, j, l);
inc(i);
j := 1;
k := -1;
lStr := lowercase(RichEdit1.Lines.Strings[i]);
l := Length(lStr);
until i >= RichEdit1.Lines.Count;
if i < RichEdit1.Lines.Count
then
Begin
if isDirective
then
HighLightDirective(i, j, t)
else
HighLightComment(i, j, t);
j := t + 1;
end;
end;
'*' :
if (j > 1) and (lStr[j - 1] = '(')
then
Begin
k := 0;
p := false;
Repeat
eolnS := false;
Repeat
inc(k);
if (j + k + 1) > l
then
Begin
eolnS := true;
break
end
until (lStr[j + k] = '*') and
(lStr[j + k + 1] = ')');
if not eolnS
then
Begin
t := j + k + 1;
Break
end;
HighLightComment(i, j - 1, l);
inc(i);
j := 2;
k := -2;
lStr := lowercase(RichEdit1.Lines.Strings[i]);
l := Length(lStr);
until i >= RichEdit1.Lines.Count;
if i < RichEdit1.Lines.Count
then
Begin
HighLightComment(i, j - 1, t);
j := t + 1;
end;
end
else
inc(j);
'a'..'z' :
Begin
t := DefineKeyWord(copy(lStr, j, l - j + 1));
if t <> -1
then
Begin
HighLightKeyWord(i, j, t);
j := j + length(theList[t])
end
else
Repeat
inc(j);
if j > l
then
break;
until not (lStr[j] in ['_','a'..'z','0'..'9'])
end;
'''' :
Begin
p := false;
t := j;
repeat
k := 0;
Repeat
inc(k);
if (t + k) > l
then
Begin
p := true;
t := t + k;
break;
end;
until (lstr[t + k] <> '''');
if p
then
Break;
t := t + k;
if odd(k)
then
Begin
k := 0;
Repeat
inc(k);
if (t + k) > l
then
Begin
p := true;
t := t + k;
break;
end
until (lstr[t + k] = '''');
t := t + k - 1;
end
else
p := true
until p;
HighLightString(i, j, t - 1);
j := t + 1;
end;
'0'..'9','$','#' :
Begin
k := 0;
if lStr[j] = '$'
then
Repeat
inc(k);
if (j + k) > l
then
Break;
until not (lStr[j + k] in ['0'..'9', 'a'..'f'])
else
Repeat
inc(k);
if (j + k) > l
then
Break;
until not (lStr[j + k] in ['0'..'9']);
t := j + k - 1;
HighLightNumber(i, j, t);
j := t + 1;
end;
'/' :
if lStr[j + 1] = '/'
then
Begin
HighLightComment(i, j, l);
j := l + 1;
end
else
inc(j);
else
inc(j);
end;
end;
inc(i);
end;
end;
//----------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
HighLight;
end;
end;
procedure TForm1.Copy1Click(Sender: TObject);
begin
RichEdit1.CopyToClipboard;
end;
end.
|
Выбор цвета и стиля задается вверху константами, их запросто можно заменить переменными. --------------------
Vit вечная память.Обсуждение действий администрации форума производятся только в этом форумегениальность идеи состоит в том, что ее невозможно придумать |
Редактор PAS-файлов, Выделение зарезервированных слов цветом 
Загрузка ...
