|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Подсветка слов при написании в компоненте 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. ради всех святых, кто-нибудь помогите, готова поощрить. Последний раз редактировалось Ksenya23, 28.05.2013 в 23:05. |
#2
|
||||
|
||||
Это давно известный, тормозной и глючный код, править его - себе дороже. Проще взять уже готовое.
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#3
|
|||
|
|||
Цитата:
|
#4
|
||||
|
||||
Хотя бы SynEdit.
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#5
|
|||
|
|||
Цитата:
|
#6
|
||||
|
||||
Ксения, мы с вами на эту тему некоторое время общались, я предлагал разные варианты решения, но ни один вас не устроил. Неужели за истекший месяц вы так и не поняли, что это учебный код, никак не предназаченный хоть для каких-то серьёзных действий.
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#7
|
|||
|
|||
Цитата:
Извините, за истекший период так много всего поменялось, забыла, прошу прощения) я бы с удовольствием использовала, только требования препода обязательны, вы не согласились бы мне помочь, за вознаграждение, хоть что-нибудь сдвинуть с места?? |
#8
|
||||
|
||||
Цитата:
Цитата:
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#9
|
||||
|
||||
Когда-то я тоже мучался с этим компонентом. Если не закачивать в него большие тексты, то скорость вполне нормальная. Есть там пара финтов которые существенно ускоряют его работу.
Вот откопал у себя в завалах с примером использования под 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. Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. Последний раз редактировалось Страдалецъ, 29.05.2013 в 10:24. |
#10
|
||||
|
||||
А это туда-же наборчик уже под паскаль.
Код:
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 (29.05.2013)
|
#11
|
|||
|
|||
спасибо большое , это я так поняла нужно скачать компонент synEdit?
А что если, предположить, что изменения цветом происходит после употребления функции richedit1.DragCursor к примеру, на изменение блока проверки или что-нибудь в этом роде существует? |
#12
|
||||
|
||||
Нет, ничего не надо скачивать. Все уже тут.
Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. |
#13
|
||||
|
||||
Цитата:
2. Вообще не понял вопроса. Будет ли подсветка работать при перетскивании текста внутри рича? Будет, т.к. при этом будет вызван метод Paint. Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. |