Цветной текст RichEdit

[raxp]

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

function getc(i: integer):tcolor;
begin
 case i of // подставите свои
  0: result:= clblack;
  1: result:= clsilver;
  2: result:= clred;
  3: result:= clolive;
  4: result:= clyellow;
  5: result:= clgreen;
  6: result:= clblue;
  7: result:= clpurple;
  8: result:= clgray
 end
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var ipos, i, count: Integer;
begin
 count:=0;

 for i:= 1 to length(Richedit1.text) do begin
  if Richedit1.text[i]= ' ' then begin

   Richedit1.SelStart := ipos;
   Richedit1.SelLength:= i-1;
   Richedit1.SelAttributes.color:= getc(count);
   ipos:= i-1;
   inc(count); if count>8 then count:= 0;
  end;
 end;
 Richedit1.SelStart := ipos;
 Richedit1.SelLength:= length(Richedit1.text)- ipos;
 Richedit1.SelAttributes.color:= getc(count);
end;

если-же, конкретные фонемы, то тогда используйте posex, как уже было указано выше.

[KoBRaAndrey]

Хм, у меня нету функции posex
Поправил код:

var ipos, i, count: Integer;
begin
for i:= 0 to Richedit1.Lines.count do begin
if pos('^1',Richedit1.Lines[i])<>0  then begin
Richedit1.SelStart := ipos;
Richedit1.SelLength:= i-2;
Richedit1.SelAttributes.color:=clred;
end;
end;
for i:= 0 to Richedit1.Lines.count do begin
if pos('^2',Richedit1.Lines[i])<>0  then begin
Richedit1.SelStart := ipos;
Richedit1.SelLength:= i-2;
Richedit1.SelAttributes.color:=clblue;
end;
end;
Richedit1.SelStart := length(Richedit1.text);
end;

Ввожу ^1Привет^2Ыы^1ггг
Привет красным, ыы синим, а гг тоже синим! В чем проблема?

13:26

Набредокодил:

var ipos, i, count: Integer;
begin
posix:=0;
for i:= 0 to Richedit1.Lines.count do begin
if pos('^1',Richedit1.Lines[i])<>0  then begin
if posix=0 then posix:=pos('^1',Richedit1.Lines[i]);
Richedit1.SelStart := posix;
Richedit1.SelLength :=length(richedit1.Lines[I]);
Richedit1.SelAttributes.color:=clred;
end;
if posex('^1',richedit1.Lines[I],posix+2)<>0 then begin
posix:=posex('^1',richedit1.Lines[I],posix+2);
Richedit1.SelStart := posix;
Richedit1.SelLength :=length(richedit1.Lines[I]);
Richedit1.SelAttributes.color:=clred;
end;
end;
posix:=0;
for i:= 0 to Richedit1.Lines.count do begin
if pos('^2',Richedit1.Lines[i])<>0  then begin
if posix=0 then posix:=pos('^2',Richedit1.Lines[i]);
Richedit1.SelStart := posix;
Richedit1.SelLength:= length(richedit1.Lines[I]);
Richedit1.SelAttributes.color:=clblue;
end;
end;
Richedit1.SelStart := length(Richedit1.text);
end;

^11111^22222^1111111
Почему ^11111-красным,^22222 синим,^1111111-синим???

У нас принято пользоваться кнопочкой "Правка", дабы не плодить посты подряд, друг за другом.
Модератор

[Volt]

Попробуйте так

procedure TForm1.Button1Click(Sender: TObject);
var s:string;   i,n,k:integer;
procedure nextn;
begin
if s[i]='^' then
begin
k:=strtoint(s[i+1]);

RichEdit1.SelStart:=n;
RichEdit1.SelLength:=i-n-1;
case k of
1:RichEdit1.SelAttributes.Color:=clMaroon;
2:RichEdit1.SelAttributes.Color:=clGreen;
3:RichEdit1.SelAttributes.Color:=clOlive;
4:RichEdit1.SelAttributes.Color:=clNavy;
5:RichEdit1.SelAttributes.Color:=clPurple;
6:RichEdit1.SelAttributes.Color:=clTeal;
7:RichEdit1.SelAttributes.Color:=clGray;
8:RichEdit1.SelAttributes.Color:=clSilver;
9:RichEdit1.SelAttributes.Color:=clRed;
end;

RichEdit1.SelStart:=i;
RichEdit1.SelAttributes.Color:=clblack;
inc(i);
n:=i-1;
end else
if s[i]<>'' then
begin
inc(i);
nextn;
end;
end;

begin
i:=1;
n:=0;
s:=Richedit1.Text;
repeat
nextn;
until s[i]='';
end;

У нас принято оформлять код специальным тэгом - кнопочка "#", не цитатой.
Модератор

[KoBRaAndrey]

Спасибо, щас попробую что-то сделать..

[Volt]

выделяет после

procedure TForm1.Button2Click(Sender: TObject);
var s:string; i,n,k:integer;
procedure nextn;
begin
if s[i]='^' then
begin
k:=strtoint(s[i+1]);
inc(i,2);
nextn;
end else
if s[i]<>'' then
begin

RichEdit1.SelStart:=i-1;
RichEdit1.SelLength:=1;
case k of
1:RichEdit1.SelAttributes.Color:=clMaroon;
2:RichEdit1.SelAttributes.Color:=clGreen;
3:RichEdit1.SelAttributes.Color:=clOlive;
4:RichEdit1.SelAttributes.Color:=clNavy;
5:RichEdit1.SelAttributes.Color:=clPurple;
6:RichEdit1.SelAttributes.Color:=clTeal;
7:RichEdit1.SelAttributes.Color:=clGray;
8:RichEdit1.SelAttributes.Color:=clSilver;
9:RichEdit1.SelAttributes.Color:=clRed;
end;


inc(i);
nextn;
end;
end;

begin
i:=1;
n:=0;
s:=Richedit1.Text;
repeat
nextn;
until s[i]='';
end;

[KoBRaAndrey]

Если етот код поставить в событие ричедит чанге, то появляются ошибки

[Volt]

Да вы что совсем не хотите думать? благо вам, что мне делать нечего. Вот должно работать:

procedure TForm1.RichEdit1Change(Sender: TObject);
var s:string; i,n,k, j:integer;
procedure nextn;
begin
j:=RichEdit1.SelStart;
if (s[i]='^') and (s[i+1] in ['0'..'9']) then
begin
k:=strtoint(s[i+1]);
inc(i,2);
nextn;
end else
if s[i]<>'' then
begin

RichEdit1.SelStart:=i-1;
RichEdit1.SelLength:=1;
case k of
1:RichEdit1.SelAttributes.Color:=clMaroon;
2:RichEdit1.SelAttributes.Color:=clGreen;
3:RichEdit1.SelAttributes.Color:=clOlive;
4:RichEdit1.SelAttributes.Color:=clNavy;
5:RichEdit1.SelAttributes.Color:=clPurple;
6:RichEdit1.SelAttributes.Color:=clTeal;
7:RichEdit1.SelAttributes.Color:=clGray;
8:RichEdit1.SelAttributes.Color:=clSilver;
9:RichEdit1.SelAttributes.Color:=clRed;
end;
RichEdit1.SelStart:=j;

inc(i);
nextn;
end;
end;
begin
i:=1;
n:=0;
s:=Richedit1.Text;
repeat
nextn;
until s[i]='';
end;

[KoBRaAndrey]

Спасибо огромное! Я бы вам поставил 3 +(за каждый код), но увы не могу. Так что +1 + Я просто в репиат и унтил не разбираюсь и запутался