Когда я писал Scriptaint в PaintCAD 4Windows, то пришлось сделать подсветку скриптов. За несколько недель я выискал в интернете ряд исходников, но все они не подошли. Пришлось собрать из них своего франкенштейна.
Задача подсветки была такая:
1) Все многострочные комментарии между "<!--" и "-->" пометить зеленым
2) Все однострочные комментарии типа "// текст" пометить зеленым
3) Все многострочные комментарии между "/*" и "*/" пометить зеленым
4) Все многострочные тексты между двойными кавычками пометить синим
5) Все многострочные тексты между одинарными кавычками пометить фиолетовым
6) Все зарезервированные слова языка java script выделить жирным.
![Изображение](http://blackstrip.ru/tmp/pcw124/scripwinru.gif)
Когда я написал эту процедуру, то на подсветку небольшого скрипта размером в 200 строк Windows XP тратил примерно полсекунды. Поэтому после каждого нажатия клавиши или после изменения скрипта нельзя было тут же вызывать подсветку. Я сделал таймер, который обновлялся каждый раз при изменении текста TRichEdit и если в течении 2 секунд никто не менял текст - то запускалась подсветка.
Когда я начал тестировать это в Windows 8 - то увидел, что вместо полсекунды на подсветку того же скрипта стало уходить 5-6 секунд (видимо в win8 что-то намудрили с бедным richeditом)! И нельзя было вообще ничего редактировать, с ужасом ожидая что вот запустится подсветка и все залипнет на пять секунд.
Оказалось, что долго работает trichedit, который лежит на форме, и очень быстро работает trichedit в памяти. Видимо windows 8 делает что-то страшное при каждой перерисовке. И даже после моих блокировок отрисовки компоненты richedit кучей функций WinAPI, понадерганых из чужих исходников подсветки, лежащий на форме richedit все равно продолжал работать очень долго.
Поэтому новая процедура копировала содержимое richedit в невидимый richedit в памяти, в нем делала все обработки и перекидывала полученное содержимое назад, восстанавливая после этого старое положение полос прокрутки и положение курсора.
Но после тестов в Windows 98 оказалось, что вертикальная полоса прокрутки не слушается установки в старое положение. Пришлось добавить посылку сообщения EN_LINESCROLL на richedit и восстанавливать таки его положение в win 98 тоже.
Вот она, процедура подсветки ричедита RichEdit1 и сопутствующие процедуры, работающие мгновенно (наверное 0.1-0.2 сек), хотя на толстых текстах могут и они тормозить (тогда вам придется писать подсветку в пределах показываемого в richedit фрагмента текста, а это уже другая история):
delim - строка символов, которые могут быть с боков зарезервированных слов. Алгоритм их отлавливает по бокам от найденного слова, поэтому ",function," выделится, а "efunction" - нет.
Reswords - массив слов, которые будут жирными в тексте, если с боков от них символы из delim.
var
delim:string = ' ,(){}[]-+*%/="''~!&|<>?:;.'+#$D+#$A;
Reswords : array[0..54] of String = (
'abstract',
'boolean',
'break',
'byte',
'case',
'catch',
'char',
'class',
'const',
'continue',
'default',
'delete',
'do',
'double',
'else',
'extends',
'false',
'final',
'finally',
'float',
'for',
'function',
'goto',
'if',
'implements',
'import',
'in',
'instanceof',
'int',
'interface',
'long',
'native',
'new',
'null',
'package',
'private',
'protected',
'public',
'return',
'short',
'static',
'super',
'switch',
'synchronized',
'this',
'throw',
'throws',
'transient',
'true',
'try',
'typeof',
'var',
'void',
'while',
'with');
procedure TForm37.Podsvet();
var
i:integer;
longcomm:boolean;
ls:integer;
insidestr1:boolean;
is1:integer;
insidestr2:boolean;
is2:integer;
htmlcomm:boolean;
ema,hs:integer;
s:string;
cwork,work:string;
wl,ss,sl:integer;
n:integer;
nd:boolean;
ri:TRichEdit;
ms: TMemoryStream;
tsih:tagSCROLLINFO;
tsiv:tagSCROLLINFO;
st,en:integer;
begin
//запоминаем что было выделено до этого
ss:=RichEdit1.SelStart;
sl:=RichEdit1.SelLength;
//флажки, когда один включается, то остальные не включатся, чтоб не находить в комментариях зарезервированные слова и т.д.
longcomm:=false;
insidestr1:=false;
insidestr2:=false;
htmlcomm:=false;
//запоминаем для win98 какой была первая видимая линия
en:=SendMessage(RichEdit1.Handle,EM_GETFIRSTVISIBLELINE,0,0);
//включаем блокировку перерисовки
RichEdit1.DoubleBuffered:=true;
SendMessage(RichEdit1.Handle,WM_SETREDRAW,0,0);
ema:=SendMessage(RichEdit1.Handle,WM_USER+69,0,0);
//создаем TRichEdit в памяти
ri:=TRichEdit.CreateParented(Form37.Handle);
//копируем из нашего видимого TRichEdit все содержимое в созданный TRichEdit
ms := TMemoryStream.Create;
RichEdit1.PlainText:=true;
ri.PlainText:=true;
try
RichEdit1.Lines.SaveToStream(ms) ;
ms.Seek(0, soFromBeginning) ;
ri.Lines.LoadFromStream(ms) ;
finally
ms.Free;
end;
//готовим две структуры tagScrollInfo для сохранения положения полос прокрутки RichEdit
FillChar(tsiv,sizeof(tsiv),0);
tsiv.cbSize := SizeOf(tsiv);
tsiv.fMask := SIF_POS;
FillChar(tsih,sizeof(tsih),0);
tsih.cbSize := SizeOf(tsih);
tsih.fMask := SIF_POS;
//запоминаем в них положения полос прокрутки
GetScrollInfo(RichEdit1.Handle,SB_VERT,tsiv);
GetScrollInfo(RichEdit1.Handle,SB_HORZ,tsih);
//начинаем городить подсветку в невидимом TRichEdit
try
//чистим всю предыдущую подсветку
ri.SelStart:=0;
ri.SelLength:=length(ri.Text);
ri.SelAttributes:=RichEdit1.DefAttributes;
ri.SelAttributes.Color:=clBlack;
ri.SelAttributes.Style:=[];
i:=0;
//весь текст скидываем в переменную work, добавляя в конце символ разделитель, чтоб искать зарезервированные слова и в конце текста тоже
work:=ri.Text+#$D#$A;
wl:=length(work);
while (i<=wl) do
begin
i:=i+1;
//бежим по тексту
//нашли одинарную кавычку и до этого нашли еще одну (флажок insidestr1 установлен) - красим от первой кавычки до найденной все в фиолетовый
if insidestr1 and (work='''') then
begin
ri.SelStart:=is1;
ri.SelLength:=i-is1;
ri.SelAttributes.Color:=clPurple;
insidestr1:=false;
continue;
end;
//нашли двойную кавычку и до этого нашли еще одну (флажок insidestr2 установлен) - красим от первой кавычки до найденной все в синий
if insidestr2 and (work='"') then
begin
ri.SelStart:=is2;
ri.SelLength:=i-is2;
ri.SelAttributes.Color:=RGB(0,0,128);
insidestr2:=false;
continue;
end;
//если это не последний символ и он со следующим образует */, и до этого находили /* (флажок longcomm установлен) - то красим это все в зеленый
if i<wl then
if longcomm and (work='*') and (work[i+1]='/') then
begin
ri.SelStart:=ls;
ri.SelLength:=i-ls+1;
ri.SelAttributes.Color:=clGreen;
i:=i+1;
longcomm:=false;
continue;
end;
//если впереди три символа, и это закрывающий html-коммент -->, и до этого находили открывающий <!-- (флажок htmlcomm установлен) - то красим в зеленый
if i<wl-1 then
if htmlcomm and (work='-') and (work[i+1]='-') and (work[i+2]='>') then
begin
ri.SelStart:=hs;
ri.SelLength:=i-hs+2;
ri.SelAttributes.Color:=clGreen;
i:=i+2;
htmlcomm:=false;
continue;
end;
//если бежим по тексту и мы не внутри ни одного из выделений - то можно искать начальные символы этих выделений и зарезервированные слова
if (not htmlcomm) and (not longcomm) and (not insidestr1) and (not insidestr2) then
begin
//одинарная кавычка - запоминаем где была и ставим флажок начала покраски
if work='''' then
begin
insidestr1:=true;
is1:=i-1;
continue;
end;
//двойная кавычка - запоминаем где была и ставим флажок начала покраски
if work='"' then
begin
insidestr2:=true;
is2:=i-1;
continue;
end;
//java-коммент - запоминаем где был и ставим флажок начала покраски
if i<wl then
if (work='/') and (work[i+1]='*') then
begin
longcomm:=true;
ls:=i-1;
i:=i+1;
continue;
end;
//html-коммент - запоминаем где был и ставим флажок начала покраски
if i<wl-2 then
if (work='<') and (work[i+1]='!') and (work[i+2]='-') and (work[i+3]='-') then
begin
htmlcomm:=true;
hs:=i-1;
i:=i+3;
continue;
end;
//однострочный java-коммент - закрашиваем все зеленым до конца строки
if i<wl then
if (work='/') and (work[i+1]='/') then
begin
ri.SelStart:=i-1;
ri.SelLength:=PosEx(#$A,work,i)-i;
ri.SelAttributes.Color:=clGreen;
i:=PosEx(#$A,work,i);
Continue;
end;
//ищем зарезервированное слово
//тащим из текста ближайший кусок, по длине равный самому длинному зарезервированному слову (12) плюс еще один, для поиска в конце символа из delim
cwork:=copy(work,i,13);
//если это конец текста - то добавим в конец пробел
if length(cwork)<13 then cwork:=cwork+' ';
//флажок "нужно детектить" резервные слова
nd:=false;
//если начало текста, первый символ - то нужно конечно
if i=1 then nd:=true;
//если не начало, но перед этим символом есть разделитель - то тоже нужно
if (i>1) then if Pos(work[i-1],delim)>0 then nd:=true;
//итак, если нужно, то
if nd then
//бежим по всем резервным словам в массиве
for n:=0 to length(Reswords)-1 do
begin
//если нашли слово
if (Pos(Reswords[n],cwork)=1) and (length(cwork)>length(Reswords[n])) then
//и если за ним идет разделитель
if Pos(cwork[length(Reswords[n])+1],delim)>0 then
begin
//то делаем его жирным
ri.SelStart:=i-1;
ri.SelLength:=length(Reswords[n]);
ri.SelAttributes.Style:=[fsBold];
i:=i+length(Reswords[n]);
Continue;
end;
end;
end;
end;
//закончили пробег по тексту
//смотрим есть ли рваные выделения (неоконченные) - тогда просто красим текст до самого конца
i:=wl-1;
if insidestr1 then
begin
ri.SelStart:=is1;
ri.SelLength:=i-is1;
ri.SelAttributes.Color:=clPurple;
insidestr1:=false;
end;
if insidestr2 then
begin
ri.SelStart:=is2;
ri.SelLength:=i-is2;
ri.SelAttributes.Color:=RGB(0,0,128);
insidestr2:=false;
end;
if longcomm then
begin
ri.SelStart:=ls;
ri.SelLength:=i-ls;
ri.SelAttributes.Color:=clGreen;
longcomm:=false;
end;
if htmlcomm then
begin
ri.SelStart:=hs;
ri.SelLength:=i-hs;
ri.SelAttributes.Color:=clGreen;
htmlcomm:=false;
end;
except
end;
//все покрасили, копируем обратно
ms := TMemoryStream.Create;
ri.PlainText:=false;
RichEdit1.PlainText:=false;
try
ri.Lines.SaveToStream(ms) ;
ms.Seek(0, soFromBeginning) ;
RichEdit1.Lines.LoadFromStream(ms) ;
finally
ms.Free;
end;
//восстанавливаем позиции скроллов
RichEdit1.Perform(WM_VSCROLL,SB_THUMBPOSITION+tsiv.nPos*65536,0);
RichEdit1.Perform(WM_HSCROLL,SB_THUMBPOSITION+tsih.nPos*65536,0);
//для win98 и других случаев - смотрим, если по вертикали скролл не туда попал, то заставляем скроллить туда куда надо
st:=SendMessage(RichEdit1.Handle,EM_GETFIRSTVISIBLELINE,0,0);
if st<>en then SendMessage(RichEdit1.Handle,EM_LINESCROLL,0,en-st);
//richedit в памяти отслужил свое, сносим его
ri.Free;
//ставим курсор и выделение куда надо
RichEdit1.SelStart:=ss;
RichEdit1.SelLength:=sl;
//включаем отключенную перерисовку обратно и перерисовываем компоненту
SendMessage(RichEdit1.Handle,WM_SETREDRAW,1,0);
InvalidateRect(RichEdit1.Handle,0,true);
SendMessage(RichEdit1.Handle,WM_USER+69,0,ema);
RichEdit1.DoubleBuffered:=false;
RichEdit1.Repaint;
//подсветка выполнена
end;
Вызов процедуры подсветки по таймеру
Кидаем на форму таймер, 2000 мс, Enabled=false. В событие OnTimer вписываем проверку, если 2 секунды никто не нажимал ничего и данный момент Shift не нажат (т.е. никто не пытался выделить часть текста, а то посередине этого процесса при зажатом Shift свойства ричэдита SelStart и SelLength дают неправильные координаты и после подсветки выделение сведется к нулевому) - тогда можно остановить таймер и вызвать подсветку. Иначе просто еще 2 сек подождем, пока shift не отпустят и не прекратят процесс выделения текста.
procedure TForm37.Timer1Timer(Sender: TObject);
begin
if not ((Word(GetAsyncKeyState(VK_SHIFT)) and $8000)<>0) then
begin
Timer1.Enabled:=false;
Podsvet();
end;
end;
В сам RichEdit1 на событие OnChange назначаем эту процедуру, чтоб обновить таймер и всегда ждать с момента последнего изменения текста до вызова подсветки ровно 2 секунды:
procedure TForm37.RichEdit1Change(Sender: TObject);
begin
Timer1.Enabled:=false;
Timer1.Enabled:=true;
end;
Вот и все. Получается быстрая подсветка RichEdit через 2 секунды после последнего изменения текста.
Увеличение объема текста в RichEdit
У RichEdit есть свойство MaxLength, которое по умолчанию равно нулю. И тогда максимальное количество символов в RichEdit становится равным 65536.
Как советуют в инете, увеличить это значение можно, если в программу добавить строчку:
RichEdit1.MaxLength:= System.MaxInt-2;
Или прямо на форме при разработке выделить RichEdit и записать в свойство MaxLength число 2147483645 .
p.s. пока писал комментарии к коду, нашел минибаг с покраской неоконченного html-коммента. В коде этого поста наверху я уже поправил этот баг, так что используйте процедуру без страха. А вот в паинткаде он будет поправлен позже, а в 1.2.4.950 рваные html-комменты останутся без покраски.