Подсветка слов при написании в компоненте RichEdit

Ksenya23 · #1 28.05.2013, 22:36

Добрый вечер, в процессе работы над заданием по выделению слов из указанного массива цветом при написании, появились трудности. Цветовое преобразование наступает после прохождения курсора до конца слова и нажатия пробела, как изменить код, для получения результата сразу при написании, исключая необходимость ввода пробела;
по тому алгоритму, что приведен ниже, наблюдаются ошибки такого типа: (загруженная картинка)
подскажите,как усовершенствовать программку? (исходник ниже)
сам код:

Код:

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.

_________________________
ради всех святых, кто-нибудь помогите, готова поощрить.

angvelem · #2 28.05.2013, 23:19

Это давно известный, тормозной и глючный код, править его - себе дороже. Проще взять уже готовое.

Ksenya23 · #3 28.05.2013, 23:20

Цитата:

Сообщение от angvelem

Это давно известный, тормозной и глючный код, править его - себе дороже. Проще взять уже готовое.

можно поподробнее, откуда взять?

angvelem · #4 28.05.2013, 23:38

Хотя бы SynEdit.

Ksenya23 · #5 28.05.2013, 23:43

Цитата:

Сообщение от angvelem

Хотя бы SynEdit.

К сожалению, требуется использовать только существующие возможности компонентов. Не уверена что правильно понимаю, возможно ли добавить возможности SynEdit, без отображения в окне какой-либо информации о нем?

angvelem · #6 29.05.2013, 00:03

Ксения, мы с вами на эту тему некоторое время общались, я предлагал разные варианты решения, но ни один вас не устроил. Неужели за истекший месяц вы так и не поняли, что это учебный код, никак не предназаченный хоть для каких-то серьёзных действий.

Ksenya23 · #7 29.05.2013, 00:09

Цитата:

Сообщение от angvelem

Ксения, мы с вами на эту тему некоторое время общались, я предлагал разные варианты решения, но ни один вас не устроил. Неужели за истекший месяц вы так и не поняли, что это учебный код, никак не предназаченный хоть для каких-то серьёзных действий.

Извините, за истекший период так много всего поменялось, забыла, прошу прощения)
я бы с удовольствием использовала, только требования препода обязательны,
вы не согласились бы мне помочь, за вознаграждение, хоть что-нибудь сдвинуть с места??

angvelem · #8 29.05.2013, 00:17

Цитата:

преподаватель показывал нам вариант такого способа обработки и отображения - этих погрешностей у него не было, только вот помощи от него ждать нечего, как не проси

Такие вещи не пишутся с наскока, используйте уже данные варианты, только учтите, обрабатывать нужно не весь код, а ТОЛЬКО видимый.

Цитата:

вы не согласились бы мне помочь

У меня нет желания, а самое главное - времени. И так несколько проектов висят незаконченными.

Страдалецъ · #9 29.05.2013, 08:12

Когда-то я тоже мучался с этим компонентом. Если не закачивать в него большие тексты, то скорость вполне нормальная. Есть там пара финтов которые существенно ускоряют его работу.
Вот откопал у себя в завалах с примером использования под SQL-синтаксис:

Код:

unit Unit12;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TSynRichEdit = object
   RichEdit: TRichEdit;
   Dic: Array of record Element: String; Color: Integer; end;
   constructor Init(RE: TRichEdit);
   procedure Add(Element: String; Color: Integer);
   procedure Paint;
   procedure CreateSQLDictionary;
   procedure RichEditOnChange(Sender: TObject);
  end;

  TForm12 = class(TForm)
    RichEdit1: TRichEdit;
    procedure FormCreate(Sender: TObject);
  private
    SynRich: TSynRichEdit;
  end;

var
  Form12: TForm12;

implementation

Uses StrUtils;

{$R *.dfm}

procedure TSynRichEdit.CreateSQLDictionary;
begin
 Add('select', clBlue);
 Add('update', clBlue);
 Add('delete', clBlue);
 Add('set', clBlue);
 Add('from', clBlue);
 Add('where', clBlue);
 Add('inner', clBlue);
 Add('left', clBlue);
 Add('right', clBlue);
 Add('union', clBlue);
 Add('order by', clBlue);
 Add('on', clBlue);
 Add('distinct', clBlue);
 Add('top', clBlue);
 Add('having', clBlue);
 Add('group by', clBlue);
 Add('is', clBlue);
 Add('as', clBlue);

 Add('or', clGray);
 Add('and', clGray);
 Add('not', clGray);
 Add('like', clGray);
 Add('join', clGray);
 Add('in', clGray);
 Add('null', clGray);
 Add('(', clGray);
 Add(')', clGray);
 Add('<', clGray);
 Add('>', clGray);
 Add('=', clGray);
 Add('&', clGray);

 Add('count', clRed);
 Add('min', clRed);
 Add('max', clRed);
 Add('datalength', clRed);
 Add('year', clRed);
 Add('getdate', clRed);
 Add('substring', clRed);
 Add('ltrim', clRed);
 Add('rtrim', clRed);

 Add(#39, clGreen);
end;

constructor TSynRichEdit.Init(RE: TRichEdit);
begin
 SetLength(Dic, 0);
 RichEdit := RE;
 RichEdit.OnChange := RichEditOnChange;
end;

procedure TSynRichEdit.Add(Element: String; Color: Integer);
begin
 SetLength(Dic, Length(Dic) + 1);
 Dic[High(Dic)].Element := Element;
 Dic[High(Dic)].Color := Color;
end;

procedure TSynRichEdit.Paint;
var
  i,p,c: Integer;
  e,s: String;
begin
 RichEdit.Lines.BeginUpdate;
 c := RichEdit.SelStart;
 s := AnsiUpperCase(RichEdit.Text);
 s := StringReplace(s,#13#10,'|',[rfReplaceAll]);
 for i := 0 to Length(Dic) - 1
 do begin
    e := AnsiUpperCase(Dic[i].Element);
    if e = #39
    then begin
         p := 1;
         while PosEx(#39, s, p) <> 0
         do begin
            p := PosEx(#39, s, p);
            if PosEx(#39, s, p+1) = 0 then Break;
            RichEdit.SelStart := p;
            p := PosEx(#39, s, p+1)+1;
            RichEdit.SelLength := p-RichEdit.SelStart-2;
            RichEdit.SelAttributes.Color := Dic[i].Color;
            end;
         end
    else begin
         p := 0;
         repeat
          p := PosEx(e, s, p+1);
          if p <> 0
          then if (e[1] in ['(',')','<','=','>','&']) or
                  ((p=1) or not (s[p-1] in ['a'..'z','A'..'Z','0'..'9']) and
                            not (s[p+Length(e)] in ['a'..'z','A'..'Z','0'..'9']))
               then begin
                    RichEdit.SelStart := p-1;
                    RichEdit.SelLength := Length(e);
                    RichEdit.SelAttributes.Color := Dic[i].Color;
                    end;
         until p = 0;
         end;
    end;
 RichEdit.SelStart := c;
 RichEdit.SelAttributes.Color := clBlack;
 RichEdit.Lines.EndUpdate;
end;


procedure TSynRichEdit.RichEditOnChange(Sender: TObject);
begin
 RichEdit.OnChange := nil;
 Paint;
 RichEdit.OnChange := RichEditOnChange;
end;

procedure TForm12.FormCreate(Sender: TObject);
begin
 SynRich.Init(RichEdit1);
 SynRich.CreateSQLDictionary;
end;

end.

Страдалецъ · #10 29.05.2013, 10:26

А это туда-же наборчик уже под паскаль.

Код:

procedure TSynRichEdit.CreatePascalDictionary;
begin
 Add('begin', clBlue);
 Add('end', clBlue);
 Add('procedure', clBlue);
 Add('string', clBlue);
 Add('for', clBlue);
 Add('to', clBlue);
 Add('do', clBlue);
 Add('if', clBlue);
 Add('then', clBlue);
 Add('else', clBlue);
 Add('repeat', clBlue);
 Add('until', clBlue);
 Add('in', clBlue);
 Add('or', clBlue);
 Add('not', clBlue);
 Add('nil', clBlue);
 Add('array', clBlue);
 Add('of', clBlue);
 Add('record', clBlue);
 Add('interface', clBlue);
 Add('uses', clBlue);
 Add('type', clBlue);
 Add('var', clBlue);
 Add('with', clBlue);
 Add('implementation', clBlue);
 Add('object', clBlue);
 Add('case', clBlue);
 Add(#39, clGreen);
end;

Ksenya23 · #11 29.05.2013, 23:53

спасибо большое

, это я так поняла нужно скачать компонент synEdit?
А что если, предположить, что изменения цветом происходит после употребления функции richedit1.DragCursor к примеру, на изменение блока проверки или что-нибудь в этом роде существует?

Страдалецъ · #12 30.05.2013, 01:49

Нет, ничего не надо скачивать. Все уже тут.

Страдалецъ · #13 30.05.2013, 02:02

Цитата:

Сообщение от Ksenya23

спасибо большое

, это я так поняла нужно скачать компонент synEdit?
А что если, предположить, что изменения цветом происходит после употребления функции richedit1.DragCursor к примеру, на изменение блока проверки или что-нибудь в этом роде существует?

1. Нет, не надо скачивать. Тут моя разработка. Просто сходное название объекта. В примере весь необходимый код.
2. Вообще не понял вопроса. Будет ли подсветка работать при перетскивании текста внутри рича? Будет, т.к. при этом будет вызван метод Paint.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты

Этот пользователь сказал Спасибо Страдалецъ за это полезное сообщение:
Ksenya23 (29.05.2013)