Delphi в Интернет, блог Delphi программистов

Сегодня я хотел бы поделиться с Вами ещё одним алгоритмом - подсветкой синтаксиса (или другого текста).

Как Вы, наверное, могли заметить в своем блоге я стараюсь связать теорию с практикой. Например, алгоритм облака тегов на Delphi я сейчас использую в программе "Блевантон" и т.д. Алгоритм подсветки синтаксиса тоже не исключение - он используется в новой версии моего детища.

Итак, пусть перед нами стоит задача - сделать простенький редактор с подсветкой синтаксиса. Для примера возьмем язык SQL. Самым подходящим для этой цели компонентом является TRichEdit - прост в использовании и имеет все возможности для работы с текстом.

Размещаем RichEdit на форме и начинаем заниматься "кодвством". Для того, чтобы наш алгоритм был полезен всем, я разместил его в отдельном модуле (uSyntax).

Наша программа должна уметь:

1. Определять слово, которое необходимо подсветить
2. Автоматически подсвечивать синтаксис при вставке текста из буфера обмена
3. и конечно же - быстро работать :)

Пойдем по пунктам. Функцию определения слова для подсветки я написал следующим образом:

function CheckList(InString: string): boolean;
var X: integer;
begin
Result := false;
X := 0;
InString := StringReplace(InString, ' ', '',[rfReplaceAll]);
InString := StringReplace(InString, #$A, '',[rfReplaceAll]);
InString := StringReplace(InString, #$D, '',[rfReplaceAll]);
while X < BuildStops.Count do
if AnsiLowerCase(BuildStops.Strings[X]) = AnsiLowerCase(InString) then
begin
Result:=true;
X:=BuildStops.Count;
end
else inc(X);
end;

Здесь мы: вначале удаляем из строки все пробелы и управляющие символы, а затем проходим в цикле по списку слов BuildStops в поисках заданной строки InString. Если строка обнаружена, то это слово для подсветки. При этом Вы можете записать в список любое количество слов и конструкция языка для подсветки - наш редактор не прихотлив в использовании и сможет подсветить всё, что пожелаете.

Следующий шаг - подсвечиваем слово в RichEdit. Для того, чтобы дать пользователю самомы выбирать цвет подсветки я определил следующий тип данных:

type
TColorer = record
FontSize: integer;  //размер шрифта для слов с подсветкой
CurrSize: integer;  //размер основного текста
FontColor: TColor; //цвет подсветки
CurrColor: TColor; //цвет основного текста
end;

А вы например можете сделать многоцветную подсветку, но для этого Вам потребуется задать как минимум ещё один список слов для поиска.

Теперь сама процедура. На мой взгляд, наиболее целесообразно вызывать процедуру подсветки в определенный момент, например при отпускании клавиши "Пробел", а не держать её в отдельном потоке.

procedure RichEditKeyUp(REdit:TRichEdit; var Key: Word; Shift: TShiftState);
var WEnd, WStart, BCount: integer;
Mark: string;
begin
{условие при котором начинает работу алгоритм подсветки синтаксиса}
if (Key = VK_Return) or (Key = VK_Back) or (Key = VK_Space) then
begin
if REdit.SelStart > 1 then
begin
WStart := 0;
WEnd := REdit.SelStart;
BCount := WEnd - 1;
while BCount <> 0 do
begin
Mark := copy(REdit.Text, BCount, 1);
if (Mark = ' ') or (Mark = #$A) then
begin
WStart := BCount;
BCount := 1;
end;
dec(BCount);
end;
{выделяем слово}
REdit.SelStart := WEnd - (WEnd - WStart);
REdit.SelLength := WEnd - WStart;
{проверяем его в списке и, если необходимо - подсвечиваем}
if CheckList(REdit.SelText) then
begin
REdit.SelAttributes.Size:=Colorer.FontSize;
REdit.SelAttributes.Color:=Colorer.FontColor;
end
else
begin
REdit.SelAttributes.Size:=Colorer.CurrSize;
REdit.SelAttributes.Color:=Colorer.CurrColor;
end;
{не забываем поставить каретку на место и установить шрифт для основного текста}
REdit.SelStart := WEnd;
REdit.SelAttributes.Size:=Colorer.CurrSize;
REdit.SelAttributes.Color:=Colorer.CurrColor;
end;
end;
end;

Ну, и наконец процедура подсветки синтаксиса при вставлении большого куска текста из буфера обмена:

procedure HighLight(REdit: TRichEdit);
var WStart, WEnd, WEnd2: integer;
WorkSpace, SWord: string;
begin
WStart  :=  1;
WEnd  :=  1;
with  REdit do
begin
WorkSpace  :=  Text + ' ' + #$D#$A;
while WEnd > 0 do
begin
WEnd := SearchFor(WorkSpace, ' ', WStart);
WEnd2 := SearchFor(WorkSpace, #$A, WStart);
if WEnd2 < WEnd then WEnd := WEnd2;
SWord := copy(WorkSpace, WStart, WEnd - 1);
if (SWord <> ' ') and (SWord <>'') then
if CheckList(SWord) then
begin
SelStart  := WStart - 1;
SelLength := length(SWord);
REdit.SelAttributes.Size:=Colorer.FontSize;
REdit.SelAttributes.Color:=Colorer.FontColor;
SelStart := WStart + length(SWord) + 1;
REdit.SelAttributes.Size:=Colorer.CurrSize;
REdit.SelAttributes.Color:=Colorer.CurrColor;
end;
WStart := WStart + WEnd;
end;
SelStart:=length(Text);
SetFocus;
end;
end;

Располагаем процедуру RichEditKeyUp на событие OnKeyUp у Вашего RichEdit, а процедуру HighLight, например на нажатие кнопку Button на форме.

Ну, а для того, чтобы снять подсветку с текста, достаточно написать простенькую процедуру:

procedure RemoveHightLight(REdit: TRichEdit);
var WEnd:integer;
begin
WEnd:=REdit.SelStart;
REdit.SelectAll;
REdit.SelAttributes.Color:=Colorer.CurrColor;
REdit.SelAttributes.Size:=Colorer.CurrSize;
REdit.SelStart:=WEnd;
end;

Алгоритм подсветки синтаксиса на Delphi готов. В прилагаемом в конце статьи архиве Вы найдете модуль uSyntax для использования в своей программе и список зарезервированных слов SQL для того, чтобы сразу проверить модуль в действии. Подписывайтесь на RSS и узнаете ещё больше, а также можете пока прочитать про город Новороссийск - по ссылке находится сайт молодежи Новороссийска.

Скачать исходник:
Модуль подсветки синтаксиса

Мой блог находят по следующим фразам

• delphi границы таблицы excel
• delphi 2010 help update
• idhttp просит капчу
• delphi границы таблицы excel
• &gt delphi
• delphi ole openoffice

Делись!	Загружай!	Плюсуй!
	Отправить PDF на

Комментарии (26)

• Алекcей пишет:
  20 Авг 2009 в 6:06 дп

  А Вы не слышали о таком понятии как стиль оформления кода. Без обид, но читать код, который написан в один столбец не очень удобно. Сложно что ли сделать отступы?!
  А так, по самому алгоритму, проде бы нет замечаний. Молоток! ;-)

• admin пишет:
  20 Авг 2009 в 6:33 дп

  Не поверите, но слышал :) Вот только плагин, который я использую в WP видимо об этом не слышал никогда

• Алекcей пишет:
  20 Авг 2009 в 2:23 пп

  Ну тогда нужно сменить плагин, а то как-то не очень хорошо получается. Вы рассказываете про программирование, а листинг в таком не красивом виде. Думаю, что Вам самим не очень приятно читать такой листинг. Попробуйте один из следующих: SyntaxHighlighter (один из лучших!!!), CodeColorer, WP-SynHighlight… есть конечно ещё плагины, но эти самый нормальные, особенно первый! ;)

• Алексей пишет:
  21 Авг 2009 в 6:54 дп

  И ещё один совет. Это уже относительно блога. Сделайте подписку на комментарии. Для этого воспользуйтесь плагином Subscribe to Comments. А то не удобно следить за новыми комментариями.

• admin пишет:
  21 Авг 2009 в 5:12 дп

  Спасибо за совет. В ближайшее время посмотрю плагины и выберу.

• admin пишет:
  21 Авг 2009 в 8:42 дп

  Плагин поставил, с подсветкой синтаксиса вроде разобрался — теперь отступы есть. Спасибо за советы по улучшению блога ;)

• Лавентий пишет:
  18 Сен 2009 в 12:44 пп

  Привет. Сначала о хорощем: спасибо что размещаете такую полезную информацию. :) Ну а теперь о плохом: CodeGear RAD Studio 2009 Architect Edition (во как) ругается на функцию SearchFor. В MSDN я ее так же не нашел. Что подскажете?

• Vlad пишет:
  18 Сен 2009 в 12:54 пп

  Да собственно — не за что :) А по поводу SearchFor Вы абсолютно правы — это функция не из стандартных просто не размещал её в блоге, т.к. ничего особенно нового в себе она не несет. Представлю её в комментарии. Извините, что без подсветки :)

  function SearchFor(WorkSpace, Search: string; Start: integer): integer;

  var Temp: string;

  begin

  Temp := copy(WorkSpace, Start, length(WorkSpace));

  Result := pos(Search, Temp);

  end;

  Вот и всё. Пользуйтесь на здоровье ;)

• Лаврентий пишет:
  18 Сен 2009 в 1:25 пп

  Эмм, спасибо. А что мне делать с BuildStops.

• Лаврентий пишет:
  18 Сен 2009 в 1:45 пп

  Это вопрос вообще то :)

• Vlad пишет:
  18 Сен 2009 в 1:47 пп

  BuildStops — это переменная типа TStringList в которой содержатся зарезервированные слова, которые требуется подсветить. Например для Delphi в BuildStops будут находиться элементы: begin, end, function, var и т.д. Соответственно, если делаете подсветку для другого языка — наполняете BuildStops другими словами. В принципе это я так обозвал переменную — можете изменить на что угодно, лишь бы это был TStringList

• GrigAir пишет:
  18 Янв 2010 в 6:09 пп

  Спасибо за инфо, но в случае записей, вида:   max(x), слово max останется не подсвеченным

• Vlad пишет:
  18 Янв 2010 в 6:16 пп

  Да, есть такое дело. Скажем так — это издержки производства :) Т.к. если проводить анализ подстрок, то можно наломать дров. Как вариант, можно отрезать подстроки которые содержаться в скобках — тогда можно подсвечивать и max

• GrigAir пишет:
  18 Янв 2010 в 6:21 пп

  В принципе, да, но тогда следующая тема: а как подсвечивать комменты? :)

• GrigAir пишет:
  18 Янв 2010 в 6:27 пп

  Кстати, если отрезать подстроку в скобках, а делается, как я понял, это в функции CheckList, то подсвечиваться будет и max, и скобки, и то, что в скобках

• Vlad пишет:
  18 Янв 2010 в 6:37 пп

  точно :) тогда видимо нужны изменения в алгоритме подсветки. Видимо ещё 1 метод нужен будет.

• GrigAir пишет:
  18 Янв 2010 в 6:39 пп

  Да, уж, видимо придется парсить, а так хотелось откосить ))

• Vlad пишет:
  18 Янв 2010 в 7:05 пп

  Ну парсинг оч интересная тема :)) Надеюсь у Вас всё получится. Я этот алгоритм как-то запостил в блоге и особо нигде не применял в чистом виде, но в случае чего — пишите, попробуем разобраться вместе

• GrigAir пишет:
  19 Янв 2010 в 6:43 пп

  Значит так ))  После доработки все стало боль-мень работать

  function TChildForm.checklist(instring: string): boolean;
  const
  thelist: array[1..47] of string =
  (‘as’, ‘by’, ‘count’, ‘group’, ‘from’, ‘order’, ‘select’,
  ‘outer’, ‘where’, ‘real’, ’round’, ‘max’, ‘min’, ‘asc’, ‘desc’,
  ‘inner’,  ’full’, ‘join’, ‘union’, ‘sum’, ‘avg’, ‘case’, ‘fetch’, ‘first’,
  ‘when’, ‘then’, ‘or’, ‘and’, ‘end’, ‘if’, ‘rows’, ‘only’, ‘in’, ‘begin’,
  ‘on’, ‘having’, ‘drop’, ‘table’, ‘insert’, ‘into’, ‘create’, ‘else’, ‘left’,
  ‘is’, ‘not’, ‘between’, ‘values’);
  var
  x: integer;
  begin
  result := false;
  x := 1;
  instring := stringreplace(instring, ‘ ‘, »,[rfreplaceall]);
  instring := stringreplace(instring, ‘(‘, »,[rfreplaceall]);
  instring := stringreplace(instring, ‘)’, »,[rfreplaceall]);
  instring := stringreplace(instring, ‘=’, »,[rfreplaceall]);
  instring := stringreplace(instring, ‘+’, »,[rfreplaceall]);
  instring := stringreplace(instring, ‘-’, »,[rfreplaceall]);
  instring := stringreplace(instring, ‘*’, »,[rfreplaceall]);
  instring := stringreplace(instring, ‘/’, »,[rfreplaceall]);
  instring := stringreplace(instring, #$a, »,[rfreplaceall]);
  instring := stringreplace(instring, #$d, »,[rfreplaceall]);
  while x < high(thelist) + 1 do
  if thelist[x] = lowercase(instring) then
  begin
  result := true;
  x := high(thelist) + 1;
  end
  else
  inc(x);
  end;

• GrigAir пишет:
  19 Янв 2010 в 6:43 пп

  procedure TChildForm.HighLight;
  var
  wstart, i        : integer;
  wend             : array [1..11] of integer;
  workspace, sword : string;
  begin
  wstart  := 1;
  wend[11]:= 1;
  with Memo1 do
  begin
  workspace := text + ‘ ‘ + ‘(‘ + ‘)’ + ‘=’ + ‘+’ + ‘-’ + ‘*’ + ‘/’ + #$d#$a;
  while wend[11] > 0 do
  begin
  wend[11] := searchfor(workspace, ‘ ‘, wstart);
   
  wend[1] := searchfor(workspace, #$a, wstart);
  wend[2] := searchfor(workspace, #$d, wstart);
  wend[3] := searchfor(workspace, ‘(‘, wstart);
  wend[4] := searchfor(workspace, ‘)’, wstart);
  wend[5] := searchfor(workspace, ‘=’, wstart);
  wend[6] := searchfor(workspace, ‘+’, wstart);
  wend[7] := searchfor(workspace, ‘-’, wstart);
  wend[8] := searchfor(workspace, ‘*’, wstart);
  wend[9] := searchfor(workspace, ‘/’, wstart);
   
   
  for i:=1 to 9 do
  if wend[11]>wend[i] then wend[11]:=wend[i];
   
  sword := copy(workspace, wstart, wend[11] — 1);
  if (sword <> ‘ ‘) and (sword <>») then
  if checklist(sword) then
  begin
  selstart := wstart — 1;
  sellength := length(sword);
  selattributes.style := [fsbold];
  selstart := wstart + length(sword) + 1;
  selattributes.style := [];
  end;
  wstart := wstart + wend[11];
  end;
  selstart := length(text);
  setfocus;
  end;
  end;

• GrigAir пишет:
  19 Янв 2010 в 6:44 пп

  procedure TChildForm.Memo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
  var
  wend, wstart, bcount: integer;
  mark                : string;
  begin
  if key=116 then
  begin
  MainForm.ToolButton11Click(Sender);
  end;
  if not ((key = 33) or (key = 34) or (key = 35) or (key = 36) or
  (key = 37) or (key = 38) or (key = 39) or (key = 40) or (key = 16)) then
  begin
  if Memo1.selstart > 1 then
  begin
  wstart := 0;
  wend := Memo1.selstart;
  bcount := wend — 1;
  while bcount <> 0 do
  begin
  mark := copy(Memo1.text, bcount, 1);
  if (mark = ‘ ‘) or (mark = #$a) or (mark = ‘(‘) or (mark = ‘)’) then
  begin
  wstart := bcount;
  bcount := 1;
  end;
  dec(bcount);
  end;
  Memo1.selstart := wend — (wend — wstart);
  Memo1.sellength := wend — wstart;
  if checklist(Memo1.seltext) then
  Memo1.selattributes.style := [fsbold]
  else
  Memo1.selattributes.style := [];
  Memo1.selstart := wend;
  Memo1.selattributes.style := [];
  end;
  end;
   
  end;

• GrigAir пишет:
  19 Янв 2010 в 6:45 пп

  Можно еще повылизывать, но принцип оптимизации уже понятен :)

• Vlad пишет:
  20 Янв 2010 в 11:55 дп

  Теперь комментарии по объему равны самому посту :) Что весьма радует — сразу два решения. Спасибо за то, что поделились решением в моем блоге.

• GrigAir пишет:
  20 Янв 2010 в 5:28 пп

  Да всегда пожалуйста. Непонятно, только откуда вообще изначальный код и чему так радовались первые комментаторы. :)

• Vlad пишет:
  20 Янв 2010 в 5:31 пп

  Изначальный код был взят с какого-то сайта по Delphi, который благополучно исчез из Сети + немного подправленный под мои нужды. А комментаторы видимо были рады, что и под их нужды код оказался вполне подходящим :)

• Darked пишет:
  29 Сен 2010 в 5:46 пп

  За статью большооое спасибо, но не могли бы вы выкладывать исходники на менее геморойные файлообменники, хотя бы на народ…

Ваш ответ