Подсветка слов при написании в компоненте RichEdit
Добрый вечер, в процессе работы над заданием по выделению слов из указанного массива цветом при написании, появились трудности. Цветовое преобразование наступает после прохождения курсора до конца слова и нажатия пробела, как изменить код, для получения результата сразу при написании, исключая необходимость ввода пробела;
по тому алгоритму, что приведен ниже, наблюдаются ошибки такого типа: (загруженная картинка)
подскажите,как усовершенствовать программку? (исходник ниже)
сам код:
Код:
unit Unit123;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm2 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
RichEdit1: TRichEdit;
procedure Button1Click(Sender: TObject);
procedure RichEdit1keyup(sender: tobject; var key: word; shift: tshiftstate);
procedure highlight;
function checklist(instring: string): boolean;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
if opendialog1.execute then
begin
richedit1.lines.loadfromfile(opendialog1.filename);
highlight;
end;
end;
function TForm2.checklist(instring: string): boolean;
const thelist: array[1..9] of string = ('begin', 'or', 'end', 'then', 'var', 'for', 'do', 'if', 'while');
var x: integer;
begin
result := false;
x := 1;
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;
procedure TForm2.RichEdit1keyup(sender: tobject; 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 richedit1.selstart > 1 then //если позиция курсора не нулевая
begin
wstart := 0; //задали начало выделения (нулевая позиция)
wend := richedit1.selstart; //задали конец выделения(текущая позиция курсора)
bcount := wend - 1; //задаём счётчик для следующего цикла
while bcount <> 0 do //данным циклом выделили позиции начала и конца того слова
begin //которое только что ввели
mark := copy(richedit1.text, bcount, 1);
if (mark = ' ') or (mark = #$a) then
begin
wstart := bcount;
bcount := 1;
end;
dec(bcount);
end;
richedit1.selstart := wend - (wend - wstart);
richedit1.sellength := wend - wstart; //выделили слово которое только что ввели
if checklist(richedit1.seltext)
//если при выполнении функции CheckList,
//InString которого = RichEdit1.SelText
//получаем true то:
then
highlight //жирный шрифт, синий цвет
else richedit1.selattributes.style := []; //иначе, переместили курсор в конец
richedit1.selattributes.Color := clBlack; //введённого (проверяемого) слова и
richedit1.selstart := wend; //сделали последующий текст обычным
end;
end;
end;
function searchfor(workspace, search: string; start: integer): integer;
var temp: string;
begin
temp := copy(workspace, start, length(workspace));
result := pos(search, temp);
end;
procedure TForm2.highlight;
var wstart, wend, wend2,wend3: integer;
workspace, sword: string;
begin
wstart := 1;
wend := 1;
with richedit1 do
begin
workspace := text + ' ' + #$d#$a;
while wend > 0 do
begin
wend := searchfor(workspace, ' ', wstart);
wend2 := searchfor(workspace, #$a, wstart);
//wend3 := searchfor(workspace, , 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);
selattributes.style := [fsbold];
selattributes.Color := clHotLight;
selstart := wstart + length(sword) + 1;
selattributes.style := [];
selattributes.Color := clBlack;
end;
wstart := wstart + wend;
end;
selstart := length(text);
setfocus;
end;
end;
end.
_________________________
ради всех святых, кто-нибудь помогите, готова поощрить.
|