[kaizer131]

Не могу понять , почему при нажатии кнопки в рич эдите подстрока выделяется только в первой строке, хотя проверенно что цикл проходит все строки текста. Работаю в 2009 Delphi

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    RichEdit1: TRichEdit;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var j:integer;
s:string;
begin
for j:=0 to RichEdit1.Lines.Count-1 do
begin
  s:= RichEdit1.Lines[j] ;
  RichEdit1.SelStart:= pos(Edit1.Text,s)-1;
  RichEdit1.SelLength:=length(Edit1.Text);
  RichEdit1.SelAttributes.Color:= clRed;
end;
end;

end.

[pesi]

Код:

var
  j, l, Count :integer;
  s:string;
  textpos :string;
begin
  Count:=0;
  textpos:=edit1.Text;
  for j:=0 to RichEdit1.Lines.Count-1 do
    begin
      s:= RichEdit1.Lines[j];
      l := Pos(textpos, s);
      if l <> 0 Then
        begin
          RichEdit1.SelStart:= Count+l-1;
          RichEdit1.SelLength:=length(textpos);
          RichEdit1.SelAttributes.Color:= clRed;
        end;
      Count:=Count+LENGTH(S)+2;
    end;
end;

вот еще

Код:

Function TextColor(RE :TrichEdit; const TextPos :string; TextColor :TColor):integer;
var
  j, l, Count :integer;
  s:string;
begin
  Result:=0;
  Count:=0;
  for j:=0 to RE.Lines.Count-1 do
    begin
      s:= RE.Lines[j];
      l := Pos(textpos, s);
      if l <> 0 Then
        begin
          RE.SelStart:= Count+l-1;
          RE.SelLength:=length(textpos);
          RE.SelAttributes.Color:= TextColor;
          inc(result);
        end;
      Count:=Count+LENGTH(S)+2;
    end;
end;

Код:

 ShowMessage('Закрашено '+IntToStr(TextColor(RichEdit1, Edit1.Text, clRed))+' вхождений текста');

проверено на Delphi 7

[kaizer131]

pesi, уже ближе подправил

Код:

 Count:=Count+LENGTH(S)+2;

на

Код:

 Count:=Count+LENGTH(S)+1;

выделяет всё правильно, но только первое вхождение в каждой строке, остальные не выделяет, попробую доработать

[pesi]

Код:

function TextColorReplace( RE :TRichEdit; TextPos :string; TextColor :TColor; Flags: TReplaceFlags ): Integer;
var
  SearchStr : string;
  Offset: Integer;
  i :integer;
  TextLength :integer;
begin
  Result := 0;
  SearchStr := re.Text;
  i := 0;
  Offset := 1;
  TextLength := length(TextPos);

if rfIgnoreCase in Flags then
  begin
    SearchStr := AnsiUpperCase(SearchStr);
    TextPos := AnsiUpperCase(TextPos);
  end;

if not (rfReplaceAll in Flags) then
  begin
   Offset := Pos(TextPos, SearchStr);
   if Offset <> 0 then
   begin
    RE.SelStart := Offset-1;
    RE.SelLength := TextLength;
    RE.SelAttributes.Color := TextColor;
    Inc(Result);
   end;
  end
else
  while Offset <> 0 do
  begin
    Offset := PosEx(TextPos, SearchStr, i);
    if Offset <> 0 then
    begin
      RE.SelStart := Offset-1;
      RE.SelLength := TextLength;
      RE.SelAttributes.Color := TextColor;
      Inc(Result);
      i := Offset+1;
    end;
  end;
end;

Код:

Application.MessageBox(PChar('Закрашено '+IntToStr(TextColorReplace(RichEdit1, 'и', clred, [rfReplaceAll, rfIgnoreCase]))+' вхождений текста'), PChar('Количество вхождений текста'), MB_OK	);

[pesi]

Подправил функцию выше

[kaizer131]

pesi, СПАСИБО !!!!! Дошлифовал, всё работает!!!

PS: а как тут репутацию добавлять ?

[kaizer131]

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

всё работает!!!

Рано порадовался , всё равно в некоторых моментах возникают неправильные сдвиги, может есть какие либо невидимые символы помимо
#10#13 которые портят картину.
Что интересно сдвиги иногда смещаюстя в право на кол-во символов равное кол-ву пройденных строк, но не всегда.